From c161b7d6fe142231346cc1844e6e27c0ab7718c1 Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Fri, 16 Sep 2022 15:53:42 +0200 Subject: 2022-09-16 14:41:00 --- source/luametatex/CMakeLists.txt | 258 + source/luametatex/CMakeSettings.json | 73 + source/luametatex/build.cmd | 89 + source/luametatex/build.sh | 72 + source/luametatex/build.txt | 43 + source/luametatex/cmake/debug.cmake | 13 + source/luametatex/cmake/lua.cmake | 87 + source/luametatex/cmake/luametatex.cmake | 84 + source/luametatex/cmake/luaoptional.cmake | 30 + source/luametatex/cmake/luarest.cmake | 32 + source/luametatex/cmake/luasocket.cmake | 62 + source/luametatex/cmake/mimalloc.cmake | 44 + source/luametatex/cmake/mingw-32.cmake | 13 + source/luametatex/cmake/mingw-64.cmake | 13 + source/luametatex/cmake/miniz.cmake | 21 + source/luametatex/cmake/mp.cmake | 50 + source/luametatex/cmake/pplib.cmake | 43 + source/luametatex/cmake/tex.cmake | 99 + source/luametatex/source/.gitignore | 1 + source/luametatex/source/README | 39 + source/luametatex/source/libraries/avl/avl.c | 2040 ++ source/luametatex/source/libraries/avl/avl.h | 445 + source/luametatex/source/libraries/avl/readme.txt | 20 + .../source/libraries/decnumber/decContext.c | 437 + .../source/libraries/decnumber/decContext.h | 254 + .../source/libraries/decnumber/decNumber.c | 8145 +++++ .../source/libraries/decnumber/decNumber.h | 182 + .../source/libraries/decnumber/decNumberLocal.h | 757 + source/luametatex/source/libraries/hnj/hnjhyphen.c | 627 + source/luametatex/source/libraries/hnj/hnjhyphen.h | 123 + .../luametatex/source/libraries/libcerf/CHANGELOG | 118 + source/luametatex/source/libraries/libcerf/LICENSE | 22 + .../luametatex/source/libraries/libcerf/README.md | 109 + source/luametatex/source/libraries/libcerf/cerf.h | 93 + source/luametatex/source/libraries/libcerf/defs.h | 97 + source/luametatex/source/libraries/libcerf/erfcx.c | 528 + .../luametatex/source/libraries/libcerf/err_fcts.c | 438 + .../source/libraries/libcerf/experimental.c | 178 + .../source/libraries/libcerf/im_w_of_x.c | 519 + .../source/libraries/libcerf/readme-luametatex.txt | 26 + .../luametatex/source/libraries/libcerf/w_of_z.c | 393 + source/luametatex/source/libraries/libcerf/width.c | 100 + .../source/libraries/mimalloc/CMakeLists.txt | 413 + .../luametatex/source/libraries/mimalloc/LICENSE | 21 + .../mimalloc/cmake/mimalloc-config-version.cmake | 19 + .../libraries/mimalloc/cmake/mimalloc-config.cmake | 14 + .../libraries/mimalloc/include/mimalloc-atomic.h | 338 + .../libraries/mimalloc/include/mimalloc-internal.h | 1049 + .../mimalloc/include/mimalloc-new-delete.h | 57 + .../libraries/mimalloc/include/mimalloc-override.h | 67 + .../libraries/mimalloc/include/mimalloc-types.h | 598 + .../source/libraries/mimalloc/include/mimalloc.h | 453 + .../luametatex/source/libraries/mimalloc/readme.md | 716 + .../source/libraries/mimalloc/src/alloc-aligned.c | 261 + .../libraries/mimalloc/src/alloc-override-osx.c | 458 + .../source/libraries/mimalloc/src/alloc-override.c | 281 + .../source/libraries/mimalloc/src/alloc-posix.c | 181 + .../source/libraries/mimalloc/src/alloc.c | 934 + .../source/libraries/mimalloc/src/arena.c | 446 + .../source/libraries/mimalloc/src/bitmap.c | 395 + .../source/libraries/mimalloc/src/bitmap.h | 107 + .../source/libraries/mimalloc/src/heap.c | 580 + .../source/libraries/mimalloc/src/init.c | 693 + .../source/libraries/mimalloc/src/options.c | 627 + .../luametatex/source/libraries/mimalloc/src/os.c | 1443 + .../source/libraries/mimalloc/src/page-queue.c | 331 + .../source/libraries/mimalloc/src/page.c | 869 + .../source/libraries/mimalloc/src/random.c | 367 + .../source/libraries/mimalloc/src/region.c | 505 + .../source/libraries/mimalloc/src/segment-cache.c | 360 + .../source/libraries/mimalloc/src/segment.c | 1544 + .../source/libraries/mimalloc/src/static.c | 39 + .../source/libraries/mimalloc/src/stats.c | 584 + .../luametatex/source/libraries/miniz/ChangeLog.md | 196 + source/luametatex/source/libraries/miniz/LICENSE | 22 + source/luametatex/source/libraries/miniz/miniz.c | 7733 +++++ source/luametatex/source/libraries/miniz/miniz.h | 1350 + source/luametatex/source/libraries/miniz/readme.md | 34 + .../luametatex/source/libraries/miniz/readme.txt | 8 + source/luametatex/source/libraries/pplib/html.zip | Bin 0 -> 280070 bytes source/luametatex/source/libraries/pplib/ppapi.h | 404 + source/luametatex/source/libraries/pplib/pparray.c | 145 + source/luametatex/source/libraries/pplib/pparray.h | 7 + source/luametatex/source/libraries/pplib/ppconf.h | 76 + source/luametatex/source/libraries/pplib/ppcrypt.c | 748 + source/luametatex/source/libraries/pplib/ppcrypt.h | 70 + source/luametatex/source/libraries/pplib/ppdict.c | 166 + source/luametatex/source/libraries/pplib/ppdict.h | 7 + .../luametatex/source/libraries/pplib/ppfilter.h | 10 + source/luametatex/source/libraries/pplib/ppheap.c | 40 + source/luametatex/source/libraries/pplib/ppheap.h | 46 + source/luametatex/source/libraries/pplib/pplib.h | 22 + source/luametatex/source/libraries/pplib/ppload.c | 2769 ++ source/luametatex/source/libraries/pplib/ppload.h | 58 + .../luametatex/source/libraries/pplib/ppstream.c | 491 + .../luametatex/source/libraries/pplib/ppstream.h | 10 + source/luametatex/source/libraries/pplib/pptest1.c | 104 + source/luametatex/source/libraries/pplib/pptest2.c | 170 + source/luametatex/source/libraries/pplib/pptest3.c | 123 + source/luametatex/source/libraries/pplib/ppxref.c | 215 + source/luametatex/source/libraries/pplib/ppxref.h | 35 + .../luametatex/source/libraries/pplib/readme.txt | 3 + .../source/libraries/pplib/util/README.md | 8 + .../source/libraries/pplib/util/utilbasexx.c | 1742 ++ .../source/libraries/pplib/util/utilbasexx.h | 111 + .../source/libraries/pplib/util/utilcrypt.c | 1190 + .../source/libraries/pplib/util/utilcrypt.h | 90 + .../source/libraries/pplib/util/utilcryptdef.h | 32 + .../source/libraries/pplib/util/utildecl.h | 28 + .../source/libraries/pplib/util/utilflate.c | 322 + .../source/libraries/pplib/util/utilflate.h | 21 + .../source/libraries/pplib/util/utilfpred.c | 778 + .../source/libraries/pplib/util/utilfpred.h | 23 + .../source/libraries/pplib/util/utiliof.c | 2993 ++ .../source/libraries/pplib/util/utiliof.h | 673 + .../source/libraries/pplib/util/utillog.c | 60 + .../source/libraries/pplib/util/utillog.h | 10 + .../source/libraries/pplib/util/utillzw.c | 705 + .../source/libraries/pplib/util/utillzw.h | 30 + .../source/libraries/pplib/util/utilmd5.c | 447 + .../source/libraries/pplib/util/utilmd5.h | 49 + .../source/libraries/pplib/util/utilmem.c | 67 + .../source/libraries/pplib/util/utilmem.h | 16 + .../source/libraries/pplib/util/utilmemallc.h | 569 + .../source/libraries/pplib/util/utilmemallh.h | 36 + .../source/libraries/pplib/util/utilmemheap.c | 1078 + .../source/libraries/pplib/util/utilmemheap.h | 188 + .../source/libraries/pplib/util/utilmemheapiof.c | 142 + .../source/libraries/pplib/util/utilmemheapiof.h | 43 + .../source/libraries/pplib/util/utilmeminfo.c | 38 + .../source/libraries/pplib/util/utilmeminfo.h | 9 + .../source/libraries/pplib/util/utilnumber.c | 1177 + .../source/libraries/pplib/util/utilnumber.h | 428 + .../source/libraries/pplib/util/utilplat.h | 31 + .../source/libraries/pplib/util/utilsha.c | 1065 + .../source/libraries/pplib/util/utilsha.h | 79 + source/luametatex/source/libraries/readme.txt | 25 + source/luametatex/source/license.txt | 181 + source/luametatex/source/lua/lmtcallbacklib.c | 615 + source/luametatex/source/lua/lmtcallbacklib.h | 105 + source/luametatex/source/lua/lmtenginelib.c | 1146 + source/luametatex/source/lua/lmtenginelib.h | 41 + source/luametatex/source/lua/lmtfontlib.c | 1020 + source/luametatex/source/lua/lmtfontlib.h | 10 + source/luametatex/source/lua/lmtinterface.c | 544 + source/luametatex/source/lua/lmtinterface.h | 1754 ++ source/luametatex/source/lua/lmtlanguagelib.c | 439 + source/luametatex/source/lua/lmtlanguagelib.h | 20 + source/luametatex/source/lua/lmtlibrary.c | 106 + source/luametatex/source/lua/lmtlibrary.h | 60 + source/luametatex/source/lua/lmtluaclib.c | 660 + source/luametatex/source/lua/lmtluaclib.h | 10 + source/luametatex/source/lua/lmtlualib.c | 627 + source/luametatex/source/lua/lmtlualib.h | 25 + source/luametatex/source/lua/lmtmplib.c | 3137 ++ source/luametatex/source/lua/lmtnodelib.c | 10324 ++++++ source/luametatex/source/lua/lmtnodelib.h | 114 + source/luametatex/source/lua/lmtstatuslib.c | 526 + source/luametatex/source/lua/lmttexiolib.c | 307 + source/luametatex/source/lua/lmttexiolib.h | 13 + source/luametatex/source/lua/lmttexlib.c | 5580 ++++ source/luametatex/source/lua/lmttexlib.h | 29 + source/luametatex/source/lua/lmttokenlib.c | 3894 +++ source/luametatex/source/lua/lmttokenlib.h | 52 + .../source/luacore/lua54/originals/lctype.h | 98 + .../source/luacore/lua54/originals/patches.txt | 11 + source/luametatex/source/luacore/lua54/readme.txt | 8 + .../luametatex/source/luacore/lua54/src/Makefile | 206 + source/luametatex/source/luacore/lua54/src/lapi.c | 1460 + source/luametatex/source/luacore/lua54/src/lapi.h | 49 + .../luametatex/source/luacore/lua54/src/lauxlib.c | 1112 + .../luametatex/source/luacore/lua54/src/lauxlib.h | 301 + .../luametatex/source/luacore/lua54/src/lbaselib.c | 549 + source/luametatex/source/luacore/lua54/src/lcode.c | 1844 ++ source/luametatex/source/luacore/lua54/src/lcode.h | 104 + .../luametatex/source/luacore/lua54/src/lcorolib.c | 210 + .../luametatex/source/luacore/lua54/src/lctype.c | 64 + .../luametatex/source/luacore/lua54/src/lctype.h | 101 + .../luametatex/source/luacore/lua54/src/ldblib.c | 483 + .../luametatex/source/luacore/lua54/src/ldebug.c | 921 + .../luametatex/source/luacore/lua54/src/ldebug.h | 63 + source/luametatex/source/luacore/lua54/src/ldo.c | 1005 + source/luametatex/source/luacore/lua54/src/ldo.h | 87 + source/luametatex/source/luacore/lua54/src/ldump.c | 226 + source/luametatex/source/luacore/lua54/src/lfunc.c | 295 + source/luametatex/source/luacore/lua54/src/lfunc.h | 64 + source/luametatex/source/luacore/lua54/src/lgc.c | 1730 ++ source/luametatex/source/luacore/lua54/src/lgc.h | 199 + source/luametatex/source/luacore/lua54/src/linit.c | 65 + .../luametatex/source/luacore/lua54/src/liolib.c | 828 + .../luametatex/source/luacore/lua54/src/ljumptab.h | 112 + source/luametatex/source/luacore/lua54/src/llex.c | 581 + source/luametatex/source/luacore/lua54/src/llex.h | 91 + .../luametatex/source/luacore/lua54/src/llimits.h | 367 + .../luametatex/source/luacore/lua54/src/lmathlib.c | 764 + source/luametatex/source/luacore/lua54/src/lmem.c | 201 + source/luametatex/source/luacore/lua54/src/lmem.h | 93 + .../luametatex/source/luacore/lua54/src/loadlib.c | 767 + .../luametatex/source/luacore/lua54/src/lobject.c | 602 + .../luametatex/source/luacore/lua54/src/lobject.h | 802 + .../luametatex/source/luacore/lua54/src/lopcodes.c | 104 + .../luametatex/source/luacore/lua54/src/lopcodes.h | 405 + .../luametatex/source/luacore/lua54/src/lopnames.h | 103 + .../luametatex/source/luacore/lua54/src/loslib.c | 430 + .../luametatex/source/luacore/lua54/src/lparser.c | 1967 ++ .../luametatex/source/luacore/lua54/src/lparser.h | 171 + .../luametatex/source/luacore/lua54/src/lprefix.h | 45 + .../luametatex/source/luacore/lua54/src/lstate.c | 440 + .../luametatex/source/luacore/lua54/src/lstate.h | 404 + .../luametatex/source/luacore/lua54/src/lstring.c | 273 + .../luametatex/source/luacore/lua54/src/lstring.h | 57 + .../luametatex/source/luacore/lua54/src/lstrlib.c | 1874 ++ .../luametatex/source/luacore/lua54/src/ltable.c | 980 + .../luametatex/source/luacore/lua54/src/ltable.h | 66 + .../luametatex/source/luacore/lua54/src/ltablib.c | 430 + source/luametatex/source/luacore/lua54/src/ltm.c | 271 + source/luametatex/source/luacore/lua54/src/ltm.h | 103 + source/luametatex/source/luacore/lua54/src/lua.c | 677 + source/luametatex/source/luacore/lua54/src/lua.h | 518 + .../luametatex/source/luacore/lua54/src/luaconf.h | 787 + .../luametatex/source/luacore/lua54/src/lualib.h | 52 + .../luametatex/source/luacore/lua54/src/lundump.c | 333 + .../luametatex/source/luacore/lua54/src/lundump.h | 36 + .../luametatex/source/luacore/lua54/src/lutf8lib.c | 286 + source/luametatex/source/luacore/lua54/src/lvm.c | 1899 ++ source/luametatex/source/luacore/lua54/src/lvm.h | 136 + source/luametatex/source/luacore/lua54/src/lzio.c | 68 + source/luametatex/source/luacore/lua54/src/lzio.h | 66 + source/luametatex/source/luacore/luac/luac.c | 724 + source/luametatex/source/luacore/luapeg/lpcap.c | 555 + source/luametatex/source/luacore/luapeg/lpcap.h | 57 + source/luametatex/source/luacore/luapeg/lpcode.c | 1014 + source/luametatex/source/luacore/luapeg/lpcode.h | 40 + source/luametatex/source/luacore/luapeg/lpprint.c | 244 + source/luametatex/source/luacore/luapeg/lpprint.h | 36 + source/luametatex/source/luacore/luapeg/lptree.c | 1305 + source/luametatex/source/luacore/luapeg/lptree.h | 82 + source/luametatex/source/luacore/luapeg/lptypes.h | 146 + source/luametatex/source/luacore/luapeg/lpvm.c | 406 + source/luametatex/source/luacore/luapeg/lpvm.h | 58 + source/luametatex/source/luacore/luapeg/readme.txt | 9 + source/luametatex/source/luacore/luasocket/LICENSE | 20 + source/luametatex/source/luacore/luasocket/NEW | 44 + source/luametatex/source/luacore/luasocket/README | 11 + source/luametatex/source/luacore/luasocket/doc.zip | Bin 0 -> 64647 bytes source/luametatex/source/luacore/luasocket/etc.zip | Bin 0 -> 19317 bytes source/luametatex/source/luacore/luasocket/lua.zip | Bin 0 -> 16888 bytes .../source/luacore/luasocket/samples.zip | Bin 0 -> 8355 bytes .../source/luacore/luasocket/src/auxiliar.c | 154 + .../source/luacore/luasocket/src/auxiliar.h | 54 + .../source/luacore/luasocket/src/buffer.c | 273 + .../source/luacore/luasocket/src/buffer.h | 52 + .../source/luacore/luasocket/src/compat.c | 39 + .../source/luacore/luasocket/src/compat.h | 22 + .../source/luacore/luasocket/src/except.c | 129 + .../source/luacore/luasocket/src/except.h | 46 + .../luametatex/source/luacore/luasocket/src/inet.c | 537 + .../luametatex/source/luacore/luasocket/src/inet.h | 56 + .../luametatex/source/luacore/luasocket/src/io.c | 28 + .../luametatex/source/luacore/luasocket/src/io.h | 70 + .../source/luacore/luasocket/src/luasocket.c | 104 + .../source/luacore/luasocket/src/luasocket.h | 36 + .../luametatex/source/luacore/luasocket/src/mime.c | 852 + .../luametatex/source/luacore/luasocket/src/mime.h | 22 + .../source/luacore/luasocket/src/options.c | 455 + .../source/luacore/luasocket/src/options.h | 102 + .../source/luacore/luasocket/src/pierror.h | 28 + .../source/luacore/luasocket/src/select.c | 214 + .../source/luacore/luasocket/src/select.h | 23 + .../source/luacore/luasocket/src/serial.c | 171 + .../source/luacore/luasocket/src/socket.c | 5 + .../source/luacore/luasocket/src/socket.h | 73 + .../luametatex/source/luacore/luasocket/src/tcp.c | 471 + .../luametatex/source/luacore/luasocket/src/tcp.h | 43 + .../source/luacore/luasocket/src/timeout.c | 226 + .../source/luacore/luasocket/src/timeout.h | 40 + .../luametatex/source/luacore/luasocket/src/udp.c | 488 + .../luametatex/source/luacore/luasocket/src/udp.h | 39 + .../luametatex/source/luacore/luasocket/src/unix.c | 69 + .../luametatex/source/luacore/luasocket/src/unix.h | 26 + .../source/luacore/luasocket/src/unixdgram.c | 405 + .../source/luacore/luasocket/src/unixdgram.h | 28 + .../source/luacore/luasocket/src/unixstream.c | 355 + .../source/luacore/luasocket/src/unixstream.h | 29 + .../source/luacore/luasocket/src/usocket.c | 454 + .../source/luacore/luasocket/src/usocket.h | 59 + .../source/luacore/luasocket/src/wsocket.c | 434 + .../source/luacore/luasocket/src/wsocket.h | 33 + .../luametatex/source/luacore/luasocket/test.zip | Bin 0 -> 50491 bytes source/luametatex/source/luacore/readme.txt | 34 + source/luametatex/source/luametatex.c | 61 + source/luametatex/source/luametatex.h | 345 + .../source/luaoptional/cmake/mujs/CMakeLists.txt | 107 + .../luaoptional/cmake/mujs/CMakeSettings.json | 28 + source/luametatex/source/luaoptional/lmtcerflib.c | 133 + source/luametatex/source/luaoptional/lmtcurl.c | 506 + source/luametatex/source/luaoptional/lmtforeign.c | 1191 + .../luametatex/source/luaoptional/lmtghostscript.c | 175 + .../source/luaoptional/lmtgraphicsmagick.c | 199 + source/luametatex/source/luaoptional/lmthb.c | 761 + .../luametatex/source/luaoptional/lmtimagemagick.c | 144 + source/luametatex/source/luaoptional/lmtkpse.c | 311 + source/luametatex/source/luaoptional/lmtlz4.c | 193 + source/luametatex/source/luaoptional/lmtlzma.c | 228 + source/luametatex/source/luaoptional/lmtlzo.c | 108 + source/luametatex/source/luaoptional/lmtmujs.c | 609 + source/luametatex/source/luaoptional/lmtmysql.c | 325 + source/luametatex/source/luaoptional/lmtoptional.c | 50 + source/luametatex/source/luaoptional/lmtoptional.h | 34 + .../luametatex/source/luaoptional/lmtpostgress.c | 306 + source/luametatex/source/luaoptional/lmtsqlite.c | 228 + source/luametatex/source/luaoptional/lmtzint.c | 518 + source/luametatex/source/luaoptional/lmtzstd.c | 118 + source/luametatex/source/luaoptional/readme.txt | 30 + source/luametatex/source/luarest/lmtaeslib.c | 115 + source/luametatex/source/luarest/lmtbasexxlib.c | 193 + source/luametatex/source/luarest/lmtdecodelib.c | 600 + source/luametatex/source/luarest/lmtfilelib.c | 877 + source/luametatex/source/luarest/lmtiolibext.c | 1608 + source/luametatex/source/luarest/lmtmd5lib.c | 88 + source/luametatex/source/luarest/lmtoslibext.c | 430 + source/luametatex/source/luarest/lmtpdfelib.c | 1850 ++ source/luametatex/source/luarest/lmtsha2lib.c | 57 + source/luametatex/source/luarest/lmtsparselib.c | 305 + source/luametatex/source/luarest/lmtstrlibext.c | 927 + source/luametatex/source/luarest/lmtxcomplexlib.c | 403 + source/luametatex/source/luarest/lmtxdecimallib.c | 503 + source/luametatex/source/luarest/lmtxmathlib.c | 500 + source/luametatex/source/luarest/lmtziplib.c | 206 + source/luametatex/source/mp/mpc/mp.c | 22101 +++++++++++++ source/luametatex/source/mp/mpc/mp.h | 1514 + source/luametatex/source/mp/mpc/mpconfig.h | 26 + source/luametatex/source/mp/mpc/mpmath.c | 1501 + source/luametatex/source/mp/mpc/mpmath.h | 12 + source/luametatex/source/mp/mpc/mpmathbinary.c | 16 + source/luametatex/source/mp/mpc/mpmathbinary.h | 12 + source/luametatex/source/mp/mpc/mpmathdecimal.c | 1603 + source/luametatex/source/mp/mpc/mpmathdecimal.h | 12 + source/luametatex/source/mp/mpc/mpmathdouble.c | 1160 + source/luametatex/source/mp/mpc/mpmathdouble.h | 12 + source/luametatex/source/mp/mpc/mpstrings.c | 291 + source/luametatex/source/mp/mpc/mpstrings.h | 42 + source/luametatex/source/mp/mpw/mp.w | 31138 +++++++++++++++++++ source/luametatex/source/mp/mpw/mpmath.w | 1949 ++ source/luametatex/source/mp/mpw/mpmathbinary.w | 27 + source/luametatex/source/mp/mpw/mpmathdecimal.w | 1971 ++ source/luametatex/source/mp/mpw/mpmathdouble.w | 1523 + source/luametatex/source/mp/mpw/mpstrings.w | 452 + source/luametatex/source/mp/readme.txt | 14 + source/luametatex/source/readme.txt | 563 + source/luametatex/source/tex/texadjust.c | 393 + source/luametatex/source/tex/texadjust.h | 36 + source/luametatex/source/tex/texalign.c | 1854 ++ source/luametatex/source/tex/texalign.h | 24 + source/luametatex/source/tex/texarithmetic.c | 433 + source/luametatex/source/tex/texarithmetic.h | 42 + source/luametatex/source/tex/texbuildpage.c | 1271 + source/luametatex/source/tex/texbuildpage.h | 104 + source/luametatex/source/tex/texcommands.c | 1318 + source/luametatex/source/tex/texcommands.h | 1184 + source/luametatex/source/tex/texconditional.c | 1386 + source/luametatex/source/tex/texconditional.h | 131 + source/luametatex/source/tex/texdirections.c | 172 + source/luametatex/source/tex/texdirections.h | 123 + source/luametatex/source/tex/texdumpdata.c | 331 + source/luametatex/source/tex/texdumpdata.h | 105 + source/luametatex/source/tex/texequivalents.c | 1964 ++ source/luametatex/source/tex/texequivalents.h | 1776 ++ source/luametatex/source/tex/texerrors.c | 704 + source/luametatex/source/tex/texerrors.h | 117 + source/luametatex/source/tex/texexpand.c | 1411 + source/luametatex/source/tex/texexpand.h | 35 + source/luametatex/source/tex/texfileio.c | 939 + source/luametatex/source/tex/texfileio.h | 81 + source/luametatex/source/tex/texfont.c | 2062 ++ source/luametatex/source/tex/texfont.h | 667 + source/luametatex/source/tex/texinputstack.c | 1159 + source/luametatex/source/tex/texinputstack.h | 452 + source/luametatex/source/tex/texinserts.c | 517 + source/luametatex/source/tex/texinserts.h | 101 + source/luametatex/source/tex/texlanguage.c | 1774 ++ source/luametatex/source/tex/texlanguage.h | 94 + source/luametatex/source/tex/texlegacy.c | 11 + source/luametatex/source/tex/texlinebreak.c | 3531 +++ source/luametatex/source/tex/texlinebreak.h | 206 + source/luametatex/source/tex/texlocalboxes.c | 313 + source/luametatex/source/tex/texlocalboxes.h | 35 + source/luametatex/source/tex/texmainbody.c | 590 + source/luametatex/source/tex/texmainbody.h | 43 + source/luametatex/source/tex/texmaincontrol.c | 6412 ++++ source/luametatex/source/tex/texmaincontrol.h | 76 + source/luametatex/source/tex/texmarks.c | 346 + source/luametatex/source/tex/texmarks.h | 65 + source/luametatex/source/tex/texmath.c | 5593 ++++ source/luametatex/source/tex/texmath.h | 758 + source/luametatex/source/tex/texmathcodes.c | 347 + source/luametatex/source/tex/texmathcodes.h | 77 + source/luametatex/source/tex/texmlist.c | 7668 +++++ source/luametatex/source/tex/texmlist.h | 30 + source/luametatex/source/tex/texnesting.c | 432 + source/luametatex/source/tex/texnesting.h | 71 + source/luametatex/source/tex/texnodes.c | 4794 +++ source/luametatex/source/tex/texnodes.h | 2728 ++ source/luametatex/source/tex/texpackaging.c | 3409 ++ source/luametatex/source/tex/texpackaging.h | 205 + source/luametatex/source/tex/texprimitive.c | 913 + source/luametatex/source/tex/texprimitive.h | 95 + source/luametatex/source/tex/texprinting.c | 1460 + source/luametatex/source/tex/texprinting.h | 133 + source/luametatex/source/tex/texrules.c | 248 + source/luametatex/source/tex/texrules.h | 27 + source/luametatex/source/tex/texscanning.c | 5760 ++++ source/luametatex/source/tex/texscanning.h | 210 + source/luametatex/source/tex/texstringpool.c | 607 + source/luametatex/source/tex/texstringpool.h | 110 + source/luametatex/source/tex/textextcodes.c | 607 + source/luametatex/source/tex/textextcodes.h | 49 + source/luametatex/source/tex/textoken.c | 3511 +++ source/luametatex/source/tex/textoken.h | 399 + source/luametatex/source/tex/textypes.c | 46 + source/luametatex/source/tex/textypes.h | 699 + source/luametatex/source/utilities/auxarithmetic.h | 61 + source/luametatex/source/utilities/auxfile.c | 294 + source/luametatex/source/utilities/auxfile.h | 166 + source/luametatex/source/utilities/auxmemory.c | 25 + source/luametatex/source/utilities/auxmemory.h | 54 + .../luametatex/source/utilities/auxsparsearray.c | 623 + .../luametatex/source/utilities/auxsparsearray.h | 212 + source/luametatex/source/utilities/auxsystem.c | 155 + source/luametatex/source/utilities/auxsystem.h | 17 + source/luametatex/source/utilities/auxunistring.c | 158 + source/luametatex/source/utilities/auxunistring.h | 19 + source/luametatex/source/utilities/auxzlib.c | 18 + source/luametatex/source/utilities/auxzlib.h | 24 + source/luametatex/tools/mp.patch.lua | 66 + source/luametatex/tools/mtx-wtoc.lua | 667 + 436 files changed, 292486 insertions(+) create mode 100644 source/luametatex/CMakeLists.txt create mode 100644 source/luametatex/CMakeSettings.json create mode 100644 source/luametatex/build.cmd create mode 100644 source/luametatex/build.sh create mode 100644 source/luametatex/build.txt create mode 100644 source/luametatex/cmake/debug.cmake create mode 100644 source/luametatex/cmake/lua.cmake create mode 100644 source/luametatex/cmake/luametatex.cmake create mode 100644 source/luametatex/cmake/luaoptional.cmake create mode 100644 source/luametatex/cmake/luarest.cmake create mode 100644 source/luametatex/cmake/luasocket.cmake create mode 100644 source/luametatex/cmake/mimalloc.cmake create mode 100644 source/luametatex/cmake/mingw-32.cmake create mode 100644 source/luametatex/cmake/mingw-64.cmake create mode 100644 source/luametatex/cmake/miniz.cmake create mode 100644 source/luametatex/cmake/mp.cmake create mode 100644 source/luametatex/cmake/pplib.cmake create mode 100644 source/luametatex/cmake/tex.cmake create mode 100644 source/luametatex/source/.gitignore create mode 100644 source/luametatex/source/README create mode 100644 source/luametatex/source/libraries/avl/avl.c create mode 100644 source/luametatex/source/libraries/avl/avl.h create mode 100644 source/luametatex/source/libraries/avl/readme.txt create mode 100644 source/luametatex/source/libraries/decnumber/decContext.c create mode 100644 source/luametatex/source/libraries/decnumber/decContext.h create mode 100644 source/luametatex/source/libraries/decnumber/decNumber.c create mode 100644 source/luametatex/source/libraries/decnumber/decNumber.h create mode 100644 source/luametatex/source/libraries/decnumber/decNumberLocal.h create mode 100644 source/luametatex/source/libraries/hnj/hnjhyphen.c create mode 100644 source/luametatex/source/libraries/hnj/hnjhyphen.h create mode 100644 source/luametatex/source/libraries/libcerf/CHANGELOG create mode 100644 source/luametatex/source/libraries/libcerf/LICENSE create mode 100644 source/luametatex/source/libraries/libcerf/README.md create mode 100644 source/luametatex/source/libraries/libcerf/cerf.h create mode 100644 source/luametatex/source/libraries/libcerf/defs.h create mode 100644 source/luametatex/source/libraries/libcerf/erfcx.c create mode 100644 source/luametatex/source/libraries/libcerf/err_fcts.c create mode 100644 source/luametatex/source/libraries/libcerf/experimental.c create mode 100644 source/luametatex/source/libraries/libcerf/im_w_of_x.c create mode 100644 source/luametatex/source/libraries/libcerf/readme-luametatex.txt create mode 100644 source/luametatex/source/libraries/libcerf/w_of_z.c create mode 100644 source/luametatex/source/libraries/libcerf/width.c create mode 100644 source/luametatex/source/libraries/mimalloc/CMakeLists.txt create mode 100644 source/luametatex/source/libraries/mimalloc/LICENSE create mode 100644 source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config-version.cmake create mode 100644 source/luametatex/source/libraries/mimalloc/cmake/mimalloc-config.cmake create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc-atomic.h create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc-internal.h create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc-new-delete.h create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc-override.h create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc-types.h create mode 100644 source/luametatex/source/libraries/mimalloc/include/mimalloc.h create mode 100644 source/luametatex/source/libraries/mimalloc/readme.md create mode 100644 source/luametatex/source/libraries/mimalloc/src/alloc-aligned.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/alloc-override-osx.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/alloc-override.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/alloc-posix.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/alloc.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/arena.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/bitmap.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/bitmap.h create mode 100644 source/luametatex/source/libraries/mimalloc/src/heap.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/init.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/options.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/os.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/page-queue.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/page.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/random.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/region.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/segment-cache.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/segment.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/static.c create mode 100644 source/luametatex/source/libraries/mimalloc/src/stats.c create mode 100644 source/luametatex/source/libraries/miniz/ChangeLog.md create mode 100644 source/luametatex/source/libraries/miniz/LICENSE create mode 100644 source/luametatex/source/libraries/miniz/miniz.c create mode 100644 source/luametatex/source/libraries/miniz/miniz.h create mode 100644 source/luametatex/source/libraries/miniz/readme.md create mode 100644 source/luametatex/source/libraries/miniz/readme.txt create mode 100644 source/luametatex/source/libraries/pplib/html.zip create mode 100644 source/luametatex/source/libraries/pplib/ppapi.h create mode 100644 source/luametatex/source/libraries/pplib/pparray.c create mode 100644 source/luametatex/source/libraries/pplib/pparray.h create mode 100644 source/luametatex/source/libraries/pplib/ppconf.h create mode 100644 source/luametatex/source/libraries/pplib/ppcrypt.c create mode 100644 source/luametatex/source/libraries/pplib/ppcrypt.h create mode 100644 source/luametatex/source/libraries/pplib/ppdict.c create mode 100644 source/luametatex/source/libraries/pplib/ppdict.h create mode 100644 source/luametatex/source/libraries/pplib/ppfilter.h create mode 100644 source/luametatex/source/libraries/pplib/ppheap.c create mode 100644 source/luametatex/source/libraries/pplib/ppheap.h create mode 100644 source/luametatex/source/libraries/pplib/pplib.h create mode 100644 source/luametatex/source/libraries/pplib/ppload.c create mode 100644 source/luametatex/source/libraries/pplib/ppload.h create mode 100644 source/luametatex/source/libraries/pplib/ppstream.c create mode 100644 source/luametatex/source/libraries/pplib/ppstream.h create mode 100644 source/luametatex/source/libraries/pplib/pptest1.c create mode 100644 source/luametatex/source/libraries/pplib/pptest2.c create mode 100644 source/luametatex/source/libraries/pplib/pptest3.c create mode 100644 source/luametatex/source/libraries/pplib/ppxref.c create mode 100644 source/luametatex/source/libraries/pplib/ppxref.h create mode 100644 source/luametatex/source/libraries/pplib/readme.txt create mode 100644 source/luametatex/source/libraries/pplib/util/README.md create mode 100644 source/luametatex/source/libraries/pplib/util/utilbasexx.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilbasexx.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilcrypt.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilcrypt.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilcryptdef.h create mode 100644 source/luametatex/source/libraries/pplib/util/utildecl.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilflate.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilflate.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilfpred.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilfpred.h create mode 100644 source/luametatex/source/libraries/pplib/util/utiliof.c create mode 100644 source/luametatex/source/libraries/pplib/util/utiliof.h create mode 100644 source/luametatex/source/libraries/pplib/util/utillog.c create mode 100644 source/luametatex/source/libraries/pplib/util/utillog.h create mode 100644 source/luametatex/source/libraries/pplib/util/utillzw.c create mode 100644 source/luametatex/source/libraries/pplib/util/utillzw.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmd5.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilmd5.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmem.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilmem.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemallc.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemallh.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemheap.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemheap.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemheapiof.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilmemheapiof.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilmeminfo.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilmeminfo.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilnumber.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilnumber.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilplat.h create mode 100644 source/luametatex/source/libraries/pplib/util/utilsha.c create mode 100644 source/luametatex/source/libraries/pplib/util/utilsha.h create mode 100644 source/luametatex/source/libraries/readme.txt create mode 100644 source/luametatex/source/license.txt create mode 100644 source/luametatex/source/lua/lmtcallbacklib.c create mode 100644 source/luametatex/source/lua/lmtcallbacklib.h create mode 100644 source/luametatex/source/lua/lmtenginelib.c create mode 100644 source/luametatex/source/lua/lmtenginelib.h create mode 100644 source/luametatex/source/lua/lmtfontlib.c create mode 100644 source/luametatex/source/lua/lmtfontlib.h create mode 100644 source/luametatex/source/lua/lmtinterface.c create mode 100644 source/luametatex/source/lua/lmtinterface.h create mode 100644 source/luametatex/source/lua/lmtlanguagelib.c create mode 100644 source/luametatex/source/lua/lmtlanguagelib.h create mode 100644 source/luametatex/source/lua/lmtlibrary.c create mode 100644 source/luametatex/source/lua/lmtlibrary.h create mode 100644 source/luametatex/source/lua/lmtluaclib.c create mode 100644 source/luametatex/source/lua/lmtluaclib.h create mode 100644 source/luametatex/source/lua/lmtlualib.c create mode 100644 source/luametatex/source/lua/lmtlualib.h create mode 100644 source/luametatex/source/lua/lmtmplib.c create mode 100644 source/luametatex/source/lua/lmtnodelib.c create mode 100644 source/luametatex/source/lua/lmtnodelib.h create mode 100644 source/luametatex/source/lua/lmtstatuslib.c create mode 100644 source/luametatex/source/lua/lmttexiolib.c create mode 100644 source/luametatex/source/lua/lmttexiolib.h create mode 100644 source/luametatex/source/lua/lmttexlib.c create mode 100644 source/luametatex/source/lua/lmttexlib.h create mode 100644 source/luametatex/source/lua/lmttokenlib.c create mode 100644 source/luametatex/source/lua/lmttokenlib.h create mode 100644 source/luametatex/source/luacore/lua54/originals/lctype.h create mode 100644 source/luametatex/source/luacore/lua54/originals/patches.txt create mode 100644 source/luametatex/source/luacore/lua54/readme.txt create mode 100644 source/luametatex/source/luacore/lua54/src/Makefile create mode 100644 source/luametatex/source/luacore/lua54/src/lapi.c create mode 100644 source/luametatex/source/luacore/lua54/src/lapi.h create mode 100644 source/luametatex/source/luacore/lua54/src/lauxlib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lauxlib.h create mode 100644 source/luametatex/source/luacore/lua54/src/lbaselib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lcode.c create mode 100644 source/luametatex/source/luacore/lua54/src/lcode.h create mode 100644 source/luametatex/source/luacore/lua54/src/lcorolib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lctype.c create mode 100644 source/luametatex/source/luacore/lua54/src/lctype.h create mode 100644 source/luametatex/source/luacore/lua54/src/ldblib.c create mode 100644 source/luametatex/source/luacore/lua54/src/ldebug.c create mode 100644 source/luametatex/source/luacore/lua54/src/ldebug.h create mode 100644 source/luametatex/source/luacore/lua54/src/ldo.c create mode 100644 source/luametatex/source/luacore/lua54/src/ldo.h create mode 100644 source/luametatex/source/luacore/lua54/src/ldump.c create mode 100644 source/luametatex/source/luacore/lua54/src/lfunc.c create mode 100644 source/luametatex/source/luacore/lua54/src/lfunc.h create mode 100644 source/luametatex/source/luacore/lua54/src/lgc.c create mode 100644 source/luametatex/source/luacore/lua54/src/lgc.h create mode 100644 source/luametatex/source/luacore/lua54/src/linit.c create mode 100644 source/luametatex/source/luacore/lua54/src/liolib.c create mode 100644 source/luametatex/source/luacore/lua54/src/ljumptab.h create mode 100644 source/luametatex/source/luacore/lua54/src/llex.c create mode 100644 source/luametatex/source/luacore/lua54/src/llex.h create mode 100644 source/luametatex/source/luacore/lua54/src/llimits.h create mode 100644 source/luametatex/source/luacore/lua54/src/lmathlib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lmem.c create mode 100644 source/luametatex/source/luacore/lua54/src/lmem.h create mode 100644 source/luametatex/source/luacore/lua54/src/loadlib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lobject.c create mode 100644 source/luametatex/source/luacore/lua54/src/lobject.h create mode 100644 source/luametatex/source/luacore/lua54/src/lopcodes.c create mode 100644 source/luametatex/source/luacore/lua54/src/lopcodes.h create mode 100644 source/luametatex/source/luacore/lua54/src/lopnames.h create mode 100644 source/luametatex/source/luacore/lua54/src/loslib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lparser.c create mode 100644 source/luametatex/source/luacore/lua54/src/lparser.h create mode 100644 source/luametatex/source/luacore/lua54/src/lprefix.h create mode 100644 source/luametatex/source/luacore/lua54/src/lstate.c create mode 100644 source/luametatex/source/luacore/lua54/src/lstate.h create mode 100644 source/luametatex/source/luacore/lua54/src/lstring.c create mode 100644 source/luametatex/source/luacore/lua54/src/lstring.h create mode 100644 source/luametatex/source/luacore/lua54/src/lstrlib.c create mode 100644 source/luametatex/source/luacore/lua54/src/ltable.c create mode 100644 source/luametatex/source/luacore/lua54/src/ltable.h create mode 100644 source/luametatex/source/luacore/lua54/src/ltablib.c create mode 100644 source/luametatex/source/luacore/lua54/src/ltm.c create mode 100644 source/luametatex/source/luacore/lua54/src/ltm.h create mode 100644 source/luametatex/source/luacore/lua54/src/lua.c create mode 100644 source/luametatex/source/luacore/lua54/src/lua.h create mode 100644 source/luametatex/source/luacore/lua54/src/luaconf.h create mode 100644 source/luametatex/source/luacore/lua54/src/lualib.h create mode 100644 source/luametatex/source/luacore/lua54/src/lundump.c create mode 100644 source/luametatex/source/luacore/lua54/src/lundump.h create mode 100644 source/luametatex/source/luacore/lua54/src/lutf8lib.c create mode 100644 source/luametatex/source/luacore/lua54/src/lvm.c create mode 100644 source/luametatex/source/luacore/lua54/src/lvm.h create mode 100644 source/luametatex/source/luacore/lua54/src/lzio.c create mode 100644 source/luametatex/source/luacore/lua54/src/lzio.h create mode 100644 source/luametatex/source/luacore/luac/luac.c create mode 100644 source/luametatex/source/luacore/luapeg/lpcap.c create mode 100644 source/luametatex/source/luacore/luapeg/lpcap.h create mode 100644 source/luametatex/source/luacore/luapeg/lpcode.c create mode 100644 source/luametatex/source/luacore/luapeg/lpcode.h create mode 100644 source/luametatex/source/luacore/luapeg/lpprint.c create mode 100644 source/luametatex/source/luacore/luapeg/lpprint.h create mode 100644 source/luametatex/source/luacore/luapeg/lptree.c create mode 100644 source/luametatex/source/luacore/luapeg/lptree.h create mode 100644 source/luametatex/source/luacore/luapeg/lptypes.h create mode 100644 source/luametatex/source/luacore/luapeg/lpvm.c create mode 100644 source/luametatex/source/luacore/luapeg/lpvm.h create mode 100644 source/luametatex/source/luacore/luapeg/readme.txt create mode 100644 source/luametatex/source/luacore/luasocket/LICENSE create mode 100644 source/luametatex/source/luacore/luasocket/NEW create mode 100644 source/luametatex/source/luacore/luasocket/README create mode 100644 source/luametatex/source/luacore/luasocket/doc.zip create mode 100644 source/luametatex/source/luacore/luasocket/etc.zip create mode 100644 source/luametatex/source/luacore/luasocket/lua.zip create mode 100644 source/luametatex/source/luacore/luasocket/samples.zip create mode 100644 source/luametatex/source/luacore/luasocket/src/auxiliar.c create mode 100644 source/luametatex/source/luacore/luasocket/src/auxiliar.h create mode 100644 source/luametatex/source/luacore/luasocket/src/buffer.c create mode 100644 source/luametatex/source/luacore/luasocket/src/buffer.h create mode 100644 source/luametatex/source/luacore/luasocket/src/compat.c create mode 100644 source/luametatex/source/luacore/luasocket/src/compat.h create mode 100644 source/luametatex/source/luacore/luasocket/src/except.c create mode 100644 source/luametatex/source/luacore/luasocket/src/except.h create mode 100644 source/luametatex/source/luacore/luasocket/src/inet.c create mode 100644 source/luametatex/source/luacore/luasocket/src/inet.h create mode 100644 source/luametatex/source/luacore/luasocket/src/io.c create mode 100644 source/luametatex/source/luacore/luasocket/src/io.h create mode 100644 source/luametatex/source/luacore/luasocket/src/luasocket.c create mode 100644 source/luametatex/source/luacore/luasocket/src/luasocket.h create mode 100644 source/luametatex/source/luacore/luasocket/src/mime.c create mode 100644 source/luametatex/source/luacore/luasocket/src/mime.h create mode 100644 source/luametatex/source/luacore/luasocket/src/options.c create mode 100644 source/luametatex/source/luacore/luasocket/src/options.h create mode 100644 source/luametatex/source/luacore/luasocket/src/pierror.h create mode 100644 source/luametatex/source/luacore/luasocket/src/select.c create mode 100644 source/luametatex/source/luacore/luasocket/src/select.h create mode 100644 source/luametatex/source/luacore/luasocket/src/serial.c create mode 100644 source/luametatex/source/luacore/luasocket/src/socket.c create mode 100644 source/luametatex/source/luacore/luasocket/src/socket.h create mode 100644 source/luametatex/source/luacore/luasocket/src/tcp.c create mode 100644 source/luametatex/source/luacore/luasocket/src/tcp.h create mode 100644 source/luametatex/source/luacore/luasocket/src/timeout.c create mode 100644 source/luametatex/source/luacore/luasocket/src/timeout.h create mode 100644 source/luametatex/source/luacore/luasocket/src/udp.c create mode 100644 source/luametatex/source/luacore/luasocket/src/udp.h create mode 100644 source/luametatex/source/luacore/luasocket/src/unix.c create mode 100644 source/luametatex/source/luacore/luasocket/src/unix.h create mode 100644 source/luametatex/source/luacore/luasocket/src/unixdgram.c create mode 100644 source/luametatex/source/luacore/luasocket/src/unixdgram.h create mode 100644 source/luametatex/source/luacore/luasocket/src/unixstream.c create mode 100644 source/luametatex/source/luacore/luasocket/src/unixstream.h create mode 100644 source/luametatex/source/luacore/luasocket/src/usocket.c create mode 100644 source/luametatex/source/luacore/luasocket/src/usocket.h create mode 100644 source/luametatex/source/luacore/luasocket/src/wsocket.c create mode 100644 source/luametatex/source/luacore/luasocket/src/wsocket.h create mode 100644 source/luametatex/source/luacore/luasocket/test.zip create mode 100644 source/luametatex/source/luacore/readme.txt create mode 100644 source/luametatex/source/luametatex.c create mode 100644 source/luametatex/source/luametatex.h create mode 100644 source/luametatex/source/luaoptional/cmake/mujs/CMakeLists.txt create mode 100644 source/luametatex/source/luaoptional/cmake/mujs/CMakeSettings.json create mode 100644 source/luametatex/source/luaoptional/lmtcerflib.c create mode 100644 source/luametatex/source/luaoptional/lmtcurl.c create mode 100644 source/luametatex/source/luaoptional/lmtforeign.c create mode 100644 source/luametatex/source/luaoptional/lmtghostscript.c create mode 100644 source/luametatex/source/luaoptional/lmtgraphicsmagick.c create mode 100644 source/luametatex/source/luaoptional/lmthb.c create mode 100644 source/luametatex/source/luaoptional/lmtimagemagick.c create mode 100644 source/luametatex/source/luaoptional/lmtkpse.c create mode 100644 source/luametatex/source/luaoptional/lmtlz4.c create mode 100644 source/luametatex/source/luaoptional/lmtlzma.c create mode 100644 source/luametatex/source/luaoptional/lmtlzo.c create mode 100644 source/luametatex/source/luaoptional/lmtmujs.c create mode 100644 source/luametatex/source/luaoptional/lmtmysql.c create mode 100644 source/luametatex/source/luaoptional/lmtoptional.c create mode 100644 source/luametatex/source/luaoptional/lmtoptional.h create mode 100644 source/luametatex/source/luaoptional/lmtpostgress.c create mode 100644 source/luametatex/source/luaoptional/lmtsqlite.c create mode 100644 source/luametatex/source/luaoptional/lmtzint.c create mode 100644 source/luametatex/source/luaoptional/lmtzstd.c create mode 100644 source/luametatex/source/luaoptional/readme.txt create mode 100644 source/luametatex/source/luarest/lmtaeslib.c create mode 100644 source/luametatex/source/luarest/lmtbasexxlib.c create mode 100644 source/luametatex/source/luarest/lmtdecodelib.c create mode 100644 source/luametatex/source/luarest/lmtfilelib.c create mode 100644 source/luametatex/source/luarest/lmtiolibext.c create mode 100644 source/luametatex/source/luarest/lmtmd5lib.c create mode 100644 source/luametatex/source/luarest/lmtoslibext.c create mode 100644 source/luametatex/source/luarest/lmtpdfelib.c create mode 100644 source/luametatex/source/luarest/lmtsha2lib.c create mode 100644 source/luametatex/source/luarest/lmtsparselib.c create mode 100644 source/luametatex/source/luarest/lmtstrlibext.c create mode 100644 source/luametatex/source/luarest/lmtxcomplexlib.c create mode 100644 source/luametatex/source/luarest/lmtxdecimallib.c create mode 100644 source/luametatex/source/luarest/lmtxmathlib.c create mode 100644 source/luametatex/source/luarest/lmtziplib.c create mode 100644 source/luametatex/source/mp/mpc/mp.c create mode 100644 source/luametatex/source/mp/mpc/mp.h create mode 100644 source/luametatex/source/mp/mpc/mpconfig.h create mode 100644 source/luametatex/source/mp/mpc/mpmath.c create mode 100644 source/luametatex/source/mp/mpc/mpmath.h create mode 100644 source/luametatex/source/mp/mpc/mpmathbinary.c create mode 100644 source/luametatex/source/mp/mpc/mpmathbinary.h create mode 100644 source/luametatex/source/mp/mpc/mpmathdecimal.c create mode 100644 source/luametatex/source/mp/mpc/mpmathdecimal.h create mode 100644 source/luametatex/source/mp/mpc/mpmathdouble.c create mode 100644 source/luametatex/source/mp/mpc/mpmathdouble.h create mode 100644 source/luametatex/source/mp/mpc/mpstrings.c create mode 100644 source/luametatex/source/mp/mpc/mpstrings.h create mode 100644 source/luametatex/source/mp/mpw/mp.w create mode 100644 source/luametatex/source/mp/mpw/mpmath.w create mode 100644 source/luametatex/source/mp/mpw/mpmathbinary.w create mode 100644 source/luametatex/source/mp/mpw/mpmathdecimal.w create mode 100644 source/luametatex/source/mp/mpw/mpmathdouble.w create mode 100644 source/luametatex/source/mp/mpw/mpstrings.w create mode 100644 source/luametatex/source/mp/readme.txt create mode 100644 source/luametatex/source/readme.txt create mode 100644 source/luametatex/source/tex/texadjust.c create mode 100644 source/luametatex/source/tex/texadjust.h create mode 100644 source/luametatex/source/tex/texalign.c create mode 100644 source/luametatex/source/tex/texalign.h create mode 100644 source/luametatex/source/tex/texarithmetic.c create mode 100644 source/luametatex/source/tex/texarithmetic.h create mode 100644 source/luametatex/source/tex/texbuildpage.c create mode 100644 source/luametatex/source/tex/texbuildpage.h create mode 100644 source/luametatex/source/tex/texcommands.c create mode 100644 source/luametatex/source/tex/texcommands.h create mode 100644 source/luametatex/source/tex/texconditional.c create mode 100644 source/luametatex/source/tex/texconditional.h create mode 100644 source/luametatex/source/tex/texdirections.c create mode 100644 source/luametatex/source/tex/texdirections.h create mode 100644 source/luametatex/source/tex/texdumpdata.c create mode 100644 source/luametatex/source/tex/texdumpdata.h create mode 100644 source/luametatex/source/tex/texequivalents.c create mode 100644 source/luametatex/source/tex/texequivalents.h create mode 100644 source/luametatex/source/tex/texerrors.c create mode 100644 source/luametatex/source/tex/texerrors.h create mode 100644 source/luametatex/source/tex/texexpand.c create mode 100644 source/luametatex/source/tex/texexpand.h create mode 100644 source/luametatex/source/tex/texfileio.c create mode 100644 source/luametatex/source/tex/texfileio.h create mode 100644 source/luametatex/source/tex/texfont.c create mode 100644 source/luametatex/source/tex/texfont.h create mode 100644 source/luametatex/source/tex/texinputstack.c create mode 100644 source/luametatex/source/tex/texinputstack.h create mode 100644 source/luametatex/source/tex/texinserts.c create mode 100644 source/luametatex/source/tex/texinserts.h create mode 100644 source/luametatex/source/tex/texlanguage.c create mode 100644 source/luametatex/source/tex/texlanguage.h create mode 100644 source/luametatex/source/tex/texlegacy.c create mode 100644 source/luametatex/source/tex/texlinebreak.c create mode 100644 source/luametatex/source/tex/texlinebreak.h create mode 100644 source/luametatex/source/tex/texlocalboxes.c create mode 100644 source/luametatex/source/tex/texlocalboxes.h create mode 100644 source/luametatex/source/tex/texmainbody.c create mode 100644 source/luametatex/source/tex/texmainbody.h create mode 100644 source/luametatex/source/tex/texmaincontrol.c create mode 100644 source/luametatex/source/tex/texmaincontrol.h create mode 100644 source/luametatex/source/tex/texmarks.c create mode 100644 source/luametatex/source/tex/texmarks.h create mode 100644 source/luametatex/source/tex/texmath.c create mode 100644 source/luametatex/source/tex/texmath.h create mode 100644 source/luametatex/source/tex/texmathcodes.c create mode 100644 source/luametatex/source/tex/texmathcodes.h create mode 100644 source/luametatex/source/tex/texmlist.c create mode 100644 source/luametatex/source/tex/texmlist.h create mode 100644 source/luametatex/source/tex/texnesting.c create mode 100644 source/luametatex/source/tex/texnesting.h create mode 100644 source/luametatex/source/tex/texnodes.c create mode 100644 source/luametatex/source/tex/texnodes.h create mode 100644 source/luametatex/source/tex/texpackaging.c create mode 100644 source/luametatex/source/tex/texpackaging.h create mode 100644 source/luametatex/source/tex/texprimitive.c create mode 100644 source/luametatex/source/tex/texprimitive.h create mode 100644 source/luametatex/source/tex/texprinting.c create mode 100644 source/luametatex/source/tex/texprinting.h create mode 100644 source/luametatex/source/tex/texrules.c create mode 100644 source/luametatex/source/tex/texrules.h create mode 100644 source/luametatex/source/tex/texscanning.c create mode 100644 source/luametatex/source/tex/texscanning.h create mode 100644 source/luametatex/source/tex/texstringpool.c create mode 100644 source/luametatex/source/tex/texstringpool.h create mode 100644 source/luametatex/source/tex/textextcodes.c create mode 100644 source/luametatex/source/tex/textextcodes.h create mode 100644 source/luametatex/source/tex/textoken.c create mode 100644 source/luametatex/source/tex/textoken.h create mode 100644 source/luametatex/source/tex/textypes.c create mode 100644 source/luametatex/source/tex/textypes.h create mode 100644 source/luametatex/source/utilities/auxarithmetic.h create mode 100644 source/luametatex/source/utilities/auxfile.c create mode 100644 source/luametatex/source/utilities/auxfile.h create mode 100644 source/luametatex/source/utilities/auxmemory.c create mode 100644 source/luametatex/source/utilities/auxmemory.h create mode 100644 source/luametatex/source/utilities/auxsparsearray.c create mode 100644 source/luametatex/source/utilities/auxsparsearray.h create mode 100644 source/luametatex/source/utilities/auxsystem.c create mode 100644 source/luametatex/source/utilities/auxsystem.h create mode 100644 source/luametatex/source/utilities/auxunistring.c create mode 100644 source/luametatex/source/utilities/auxunistring.h create mode 100644 source/luametatex/source/utilities/auxzlib.c create mode 100644 source/luametatex/source/utilities/auxzlib.h create mode 100644 source/luametatex/tools/mp.patch.lua create mode 100644 source/luametatex/tools/mtx-wtoc.lua (limited to 'source') 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: +# +# 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-/bin/luametatex$SUFFIX : the compiled binary (some 2-3MB)" +echo "tex/texmf-/bin/mtxrun$SUFFIX : copy of or link to luametatex" +echo "tex/texmf-/bin/context$SUFFIX : copy of or link to luametatex" +echo "tex/texmf-/bin/mtxrun.lua : copy of tex/texmf-context/scripts/context/lua/mtxrun.lua" +echo "tex/texmf-/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 +*/ + +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 +# include +# include + +// # 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 + +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 // for strcmp +#include // 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 /* C99 standard integers */ + #endif + #include /* for printf, etc. */ + #include /* 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 // for malloc, free, etc. +#include // for printf [if needed] +#include // for strcpy +#include // 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; ddigits; 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; ddigits; 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; cextended) { + decNumberZero(dn); // clean result + break; // [could be return] + } + #endif + } // at least one leading 0 + + // Handle decimal point... + if (dotchar!=NULL && dotchardigits) 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-1emin-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; i1) { + 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; i1) { + 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, ©stat); // 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) { // lhsbits&(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; i1) { + 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<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.digitsexponent+=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 (dropped0) { // 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; i1) { + 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; sdigits 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=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 (aeemin) 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 exponent+dn->digits-1; // adjusted exponent + if (aeemin) 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 (ndigits) { // 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->digitsdigits))=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->digitsdigits=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 (exponentexponent) 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 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 (*pv1v2. 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->exponentexponent; + 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 (var1initpadexponent; // exponent is smaller of lhs & rhs + if (rhs->exponentexponent; + + // 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; up0 || (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->digitsdigits) { // 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; p0; + 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; p0; + p+=DECDPUN, cup++, count-=DECDPUN) + *rip+=*cup*powers[p]; + rmsi=rip-1; // save -> msi + + // zero the accumulator + for (lp=zacc; lp0 && rip!=rmsi) continue; + lazy=FASTLAZY; // reset delay count + // spin up the accumulator resolving overflows + for (lp=zacc; lp 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; merlsu, 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 .. + || (reqexpset->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->exponentexponent) 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->exponentexponent) 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 AB, 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 AB, 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=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+1sizeof(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=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 (; cmaxC) { // 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=0) { + est=(((ueInt)carry>>11)*53687)>>18; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder + carry=est; // likely quotient [89%] + if (*c>11)*53687)>>18; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); + carry=est-(DECDPUNMAX+1); // correctly negative + if (*c=0) { + est=(((ueInt)carry>>3)*16777)>>21; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder + carry=est; // likely quotient [99%] + if (*c>3)*16777)>>21; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); + carry=est-(DECDPUNMAX+1); // correctly negative + if (*c=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 (cDECDPUNMAX + #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>11)*53687)>>18; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); + carry=est-(DECDPUNMAX+1); // correctly negative + if (*c=0) { + est=(((ueInt)carry>>3)*16777)>>21; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); // remainder + carry=est; // likely quotient [99%] + if (*c>3)*16777)>>21; + *c=(Unit)(carry-est*(DECDPUNMAX+1)); + carry=est-(DECDPUNMAX+1); // correctly negative + if (*c=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 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; ddigits-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=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 (; updigits 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 { // 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->exponentemin; + 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 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->exponentexponent=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 (; got1999999997) 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; urdigits=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 && *upmaxuint) { + #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+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 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; b0 */ + /* 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 /* for abs */ + #include /* 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, not ; + 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 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 + +# 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 + +# 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 +#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 +#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 + +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; jiterDone[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 +#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 +#include +#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 +#include +#include + +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 + $ + $ + ) + 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" $ + COMMENT "Copy mimalloc-redirect${MIMALLOC_REDIRECT_SUFFIX}.dll to output directory") + install(FILES "$/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 + $ + $ + ) + 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 + $ + $ + ) + + # 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: $ + # 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 `*` 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 +#define _Atomic(tp) std::atomic +#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 +#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, ¤t, 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 +#include +#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 +static inline void mi_atomic_yield(void) { + std::this_thread::yield(); +} +#elif defined(_WIN32) +#define WIN32_LEAN_AND_MEAN +#include +static inline void mi_atomic_yield(void) { + YieldProcessor(); +} +#elif defined(__SSE2__) +#include +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 +static inline void mi_atomic_yield(void) { + smt_pause(); +} +#elif defined(__wasi__) +#include +static inline void mi_atomic_yield(void) { + sched_yield(); +} +#else +#include +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 +#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: + +----------------------------------------------------------- */ +#include +#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 // 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 +#elif defined(__OpenBSD__) +// use end bytes of a name; goes wrong if anyone uses names > 23 characters (ptrhread specifies 16) +// see +#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?) +#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)<<> (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: + x ^= x >> 30; + x *= 0xbf58476d1ce4e5b9UL; + x ^= x >> 27; + x *= 0x94d049bb133111ebUL; + x ^= x >> 31; +#elif (MI_INTPTR_SIZE==4) + // by Chris Wellons, see: + 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 +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 // 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 // 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 + 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 + 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 +#include +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 +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 +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 +// --------------------------------------------------------------------------- +#if defined(__cplusplus) + #include + #include + + 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(al)); } + void operator delete[](void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast(al)); } + void operator delete (void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast(al)); }; + void operator delete[](void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast(al)); }; + void operator delete (void* p, std::align_val_t al, const std::nothrow_t& tag) noexcept { mi_free_aligned(p, static_cast(al)); } + void operator delete[](void* p, std::align_val_t al, const std::nothrow_t& tag) noexcept { mi_free_aligned(p, static_cast(al)); } + + void* operator new (std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast(al)); } + void* operator new[](std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast(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(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(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 + +// 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 // ptrdiff_t +#include // 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< 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)<= 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 // size_t +#include // 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 +// -------------------------------------------------------------------------------- + +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 // std::size_t +#include // PTRDIFF_MAX +#if (__cplusplus >= 201103L) || (_MSC_VER > 1900) // C++11 +#include // std::true_type +#include // std::forward +#endif + +template 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 struct rebind { typedef mi_stl_allocator other; }; + + mi_stl_allocator() mi_attr_noexcept = default; + mi_stl_allocator(const mi_stl_allocator&) mi_attr_noexcept = default; + template mi_stl_allocator(const mi_stl_allocator&) 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(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(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 void construct(U* p, Args&& ...args) { ::new(p) U(std::forward(args)...); } + template 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 bool operator==(const mi_stl_allocator& , const mi_stl_allocator& ) mi_attr_noexcept { return true; } +template bool operator!=(const mi_stl_allocator& , const mi_stl_allocator& ) 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 @@ + + + +[](https://dev.azure.com/Daan0324/mimalloc/_build?definitionId=1&_a=summary) + +# mimalloc + +  + +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: + + + + + + + + +# 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)1 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`2 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 ``, 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=` 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_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 + +Overriding on Windows 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_). + + + + +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× 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× 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× 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× 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×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. + + + + + +## Peak Working Set + +The following figure shows the peak working set (rss) of the allocators +on the benchmarks (on the c5.18xlarge instance). + + + + +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). + + + + +# 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 + +- \[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. + + + +# 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 // 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 ) + #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 ) + #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 +#include +#include // memset +#include + +#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 +// ------------------------------------------------------ + +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 ) + } + 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: +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 +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: + 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 ) + 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 + // ------------------------------------------------------ + #include + + #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(al)); } + void operator delete[](void* p, std::align_val_t al) noexcept { mi_free_aligned(p, static_cast(al)); } + void operator delete (void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast(al)); }; + void operator delete[](void* p, std::size_t n, std::align_val_t al) noexcept { mi_free_size_aligned(p, n, static_cast(al)); }; + void operator delete (void* p, std::align_val_t al, const std::nothrow_t&) noexcept { mi_free_aligned(p, static_cast(al)); } + void operator delete[](void* p, std::align_val_t al, const std::nothrow_t&) noexcept { mi_free_aligned(p, static_cast(al)); } + + void* operator new( std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast(al)); } + void* operator new[]( std::size_t n, std::align_val_t al) noexcept(false) { return mi_new_aligned(n, static_cast(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(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(al)); } + #endif + +#elif (defined(__GNUC__) || defined(__clang__)) + // ------------------------------------------------------ + // Override by defining the mangled C++ names of the operators (as + // used by GCC and CLang). + // See + // ------------------------------------------------------ + + 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 +#include // memset +#include // 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) + // + 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 + #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 // memset, strlen +#include // 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 +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 // 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 +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 // memset +#include // 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 // 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 // memcpy, memset +#include // 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 + #include + #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 +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 +} +#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 + 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 +#include // strtol +#include // strncpy, strncat, strlen, strstr +#include // toupper +#include + +#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 +#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 +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() +#include +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 // strerror + +#ifdef _MSC_VER +#pragma warning(disable:4996) // strerror +#endif + +#if defined(__wasi__) +#define MI_USE_SBRK +#endif + +#if defined(_WIN32) +#include +#elif defined(__wasi__) +#include // sbrk +#else +#include // mmap +#include // sysconf +#if defined(__linux__) +#include +#include +#if defined(__GLIBC__) +#include // linux mmap flags +#else +#include +#endif +#endif +#if defined(__APPLE__) +#include +#if !TARGET_IOS_IPHONE && !TARGET_IOS_SIMULATOR +#include +#endif +#endif +#if defined(__FreeBSD__) || defined(__DragonFly__) +#include +#if __FreeBSD_version >= 1200000 +#include +#include +#endif +#include +#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 +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 + // + 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); + // + // 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, ¶m, 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 +#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: + 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 // getcpu +#include // 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 ) + _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 // 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 +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 +#if defined(MAC_OS_X_VERSION_10_10) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_10 +#include +#include +#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 + 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 +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 +#endif +#include +#include +#include +#include +#include +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 ) + // 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 +#elif defined(__APPLE__) +#include +#else +#include +#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 +----------------------------------------------------------- */ +/* +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 // 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(®ions_count); + for (size_t i = 0; i < count; i++) { + uint8_t* start = (uint8_t*)mi_atomic_load_ptr_relaxed(uint8_t, ®ions[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(®ions[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 = ®ions[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(®ions_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, ®ion_commit, ®ion_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(®ions_count); + if (idx >= MI_REGION_MAX) { + mi_atomic_decrement_acq_rel(®ions_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 = ®ions[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(®ions_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 = ®ions[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, ®ion, &bit_idx, tld)) { + // otherwise try to allocate a fresh region and claim in there + if (!mi_region_try_alloc_os(blocks, *commit, *large, ®ion, &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(®ion->in_use, 1, blocks, bit_idx)); + + mi_region_info_t info; + info.value = mi_atomic_load_acquire(®ion->info); + uint8_t* start = (uint8_t*)mi_atomic_load_ptr_acquire(uint8_t,®ion->start); + mi_assert_internal(!(info.x.is_large && !*large)); + mi_assert_internal(start != NULL); + + *is_zero = _mi_bitmap_claim(®ion->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(®ion->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(®ion->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(®ion->commit, 1, blocks, bit_idx); + } + mi_assert_internal(!*commit || _mi_bitmap_is_claimed(®ion->commit, 1, blocks, bit_idx)); + + // unreset reset blocks + if (_mi_bitmap_is_any_claimed(®ion->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(®ion->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(®ion->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,®ion,&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(®ion->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(®ion->commit, 1, blocks, bit_idx, NULL); + } + + if (any_reset) { + // set the is_reset bits if any pages were reset + _mi_bitmap_claim(®ion->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(®ion->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(®ion->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(®ions_count); + for (size_t i = 0; i < rcount; i++) { + mem_region_t* region = ®ions[i]; + if (mi_atomic_load_relaxed(®ion->info) != 0) { + // if no segments used, try to claim the whole region + size_t m = mi_atomic_load_relaxed(®ion->in_use); + while (m == 0 && !mi_atomic_cas_weak_release(®ion->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,®ions[i].start); + size_t arena_memid = mi_atomic_load_relaxed(®ions[i].arena_memid); + size_t commit = mi_atomic_load_relaxed(®ions[i].commit); + memset((void*)®ions[i], 0, sizeof(mem_region_t)); // cast to void* to avoid atomic warning + // and release the whole region + mi_atomic_store_release(®ion->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 // memset +#include + +#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: +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 // fputs, stderr +#include // 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, ¤t_rss, &peak_rss, ¤t_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 +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 +#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 +#include +#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 +#include +#include + +#if defined(__APPLE__) +#include +#endif + +#if defined(__HAIKU__) +#include +#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, ¤t_rss0, &peak_rss0, ¤t_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 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 (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 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 +*/ +/************************************************************************** + * + * 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 + +#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 +#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 +#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 +#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 +#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 +#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 +#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(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, ¢ral_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 , 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 + +#if !defined(MINIZ_NO_TIME) && !defined(MINIZ_NO_ARCHIVE_APIS) +#include +#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 +#include +#include +#include + + + +/* ------------------- 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 +#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 Binary files /dev/null and b/source/luametatex/source/libraries/pplib/html.zip 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 +#include +#include + +#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 +#include +#include +#include + +#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 IDEI + + 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", §ionmock[1].integer)) + sectionmock[1].integer = 0; + sectionfirst = §ionmock[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 ... +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: <> */ + 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 +#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 +#include +#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 +//#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 +#include +#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 = + z->avail_in = + do { + z->next_out = + z->avail_out = + 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 = + z->avail_in = + do { + z->next_out = + z->avail_out = + 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 +#include +#include + +#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 // for FILE * +#include // for errno +#include // for strerror() +#include // 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 +#include // strlen +#include +#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 + . 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 + 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 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 // memcpy +#include // 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 +#include // 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 // 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 // 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 // memset() +#include // 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 // size_t +#include + +#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 + +#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 /* for log10() and floor() */ +#include /* 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 // 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 +#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 /* FILE */ +#include /* memcpy()/memset() or bcopy()/bzero() */ +//#include /* 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 (which in turn includes + * 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 +#include +#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 . + +------------------------------------------------------------------------------------------ +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 + || 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 |[{},"dimen"]| */ + lua_newtable(L); /*tex |[{},"dimen",{}]| */ + lua_settable(L, -3); /*tex |[{}]| */ + lua_pushstring(L, tab); /*tex |[{},"dimen"]| */ + lua_gettable(L, -2); /*tex |[{},{}]| */ + luaL_newmetatable(L, mttab); /*tex |[{},{},{}]| */ + lua_pushstring(L, "__index"); /*tex |[{},{},{},"__index"]| */ + lua_pushcfunction(L, getfunc); /*tex |[{},{},{},"__index","getdimen"]| */ + lua_settable(L, -3); /*tex |[{},{},{}]| */ + lua_pushstring(L, "__newindex"); /*tex |[{},{},{},"__newindex"]| */ + lua_pushcfunction(L, setfunc); /*tex |[{},{},{},"__newindex","setdimen"]| */ + lua_settable(L, -3); /*tex |[{},{},{}]| */ + lua_setmetatable(L, -2); /*tex |[{},{}]| : assign the metatable */ + lua_pop(L, 1); /*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 : "", 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 + +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 + + 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 + + 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 +# 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, ""); + } else if (ar.namewhat) { + lua_pushstring(L, ar.namewhat); + } else if (ar.what) { + lua_pushstring(L, ar.what); + } else { + lua_pushliteral(L, ""); + } + 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 : ""))); + 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 expected", detail); +} + +static void mplib_aux_invalid_object_error(const char * detail) +{ + tex_formatted_error("mp lib","lua 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); + } 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, "", *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, "", *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 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 + + + + + \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) +{ /* */ + 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) +{ /* */ + 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) +{ + /* */ + 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); + /* */ + lua_replace(L, -3); + /* */ + lua_rawseti(L, -2, n); /* actually it is a hash */ + } + return 0; +} + +static int nodelib_direct_setproperty(lua_State *L) +{ + /* */ + 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); + /* */ + lua_replace(L, 1); + /* */ + 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) +{ /* */ + 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) +{ /* */ + 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) +{ /* */ + halfword n = lmt_check_isnode(L, 2); + if (n) { + lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id); + /*
*/ + lua_rawgeti(L, -1, n); + } else { + lua_pushnil(L); + } + return 1; +} + +static int nodelib_set_property_t(lua_State *L) +{ + /*
*/ + halfword n = lmt_check_isnode(L, 2); + if (n) { + lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id); + /*
*/ + lua_insert(L, -2); + /*
*/ + 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); + } + /* */ + lmt_node_memory_state.node_properties_id = luaL_ref(L, LUA_REGISTRYINDEX); + /* not needed, so unofficial */ + lua_pushstring(L, NODE_PROPERTIES_DIRECT); + /* */ + lua_rawgeti(L, LUA_REGISTRYINDEX, lmt_node_memory_state.node_properties_id); + /* */ + lua_settable(L, LUA_REGISTRYINDEX); + /* */ + lua_pushstring(L, NODE_PROPERTIES_INDIRECT); + /* */ + lua_newtable(L); + /* */ + luaL_newmetatable(L, NODE_PROPERTIES_INSTANCE); + /* */ + luaL_setfuncs(L, nodelib_p, 0); + /* */ + lua_setmetatable(L, -2); + /* */ + 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 +# include + +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 */ + 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(|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(|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 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 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, "", n->cs, n->cmd, n->chr, get_token_reference(n->chr)); + } else { + lua_pushfstring(L, "", 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 |{}| |\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 + +#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 + + +#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 +#include +#include + +#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 +#include +#include +#include +#include + + +/* +** 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 */ + 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 + +/* +** 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 +#include + +#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 + #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 +#include +#include +#include + +#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 ; 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 +#include +#include +#include + +#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 " 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 ). +** (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 + +#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 + + +#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 + +#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 + + +#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 +#include +#include + +#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 +#include +#include + +#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 +#include +#include + +#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 + +#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 + +#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; isizelocvars && 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 +#include + + +#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 + +#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 +#include +#include +#include +#include +#include + +#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 + +#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 +#include + +#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", + "//", "..", "...", "==", ">=", "<=", "~=", + "<<", ">>", "::", "", + "", "", "", "" +}; + + +#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; iextra = 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 + +#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 +#include + + +#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 +#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 +#include +#include +#include +#include + +#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 + +#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 + +#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 +#include +#include + +#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 + +/* +** 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 + + +/* +** 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 +#include +#include +#include +#include +#include + +#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 + + +#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<

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<>1) /* 'sBx' is signed */ + + +#if L_INTHASBITS(SIZE_Ax) +#define MAXARG_Ax ((1<> 1) + + +#define MAXARG_A ((1<> 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)) & MASK1(size,0))) +#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \ + ((cast(Instruction, v)<> 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 ; + 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 + + +/* 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 +#include +#include +#include +#include + +#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 + +#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 +#include + +#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 = " 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 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, " 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 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 +#include + +#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 + +/* +** 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, ®istry->array[LUA_RIDX_MAINTHREAD - 1], L); + /* registry[LUA_RIDX_GLOBALS] = new table (table of globals) */ + sethvalue(L, ®istry->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 +#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 + +#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 +#include +#include +#include +#include +#include +#include +#include +#include + +#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 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; iinit) { + 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 +#include + +#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 +#include +#include + +#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 + +/* 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 + +#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; itmname[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<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 rtop, 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 +#include +#include + +#include + +#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 +#define lua_stdin_is_tty() isatty(0) + +#elif defined(LUA_USE_WINDOWS) /* }{ */ + +#include +#include + +#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 +#include +#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 "" +#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 ;'; 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 +#include + + +#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 ('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 +#include + + +/* +** =================================================================== +** 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 +#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 +#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 +#include + +#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 +#include +#include +#include + +#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 +#include +#include +#include +#include +#include + +#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 + +#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 +#include +#include +#include +#include + +#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; itop+(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; ip[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; i1); + 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; ik[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; pc0) 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; isizelocvars; + printf("locals (%d) for %p:\n",n,VOID(f)); + for (i=0; ilocvars[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; iupvalues[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; ip[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 + + +#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 n;

(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)))) { + /* == 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 { + /* == + test(first(p1)) -> L1; choice L1; ; commit L2; L1: ; 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> ==

; 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;

; 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:

; partialcommit L1; L2: */ + /* or (if 'opt'): partialcommit L1; L1:

; 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;

; 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 +#include +#include + + +#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 +#include +#include + + +#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 +# define assert(condition) ((void)0) + +#include + +#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 +#include + + +#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 + +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 Binary files /dev/null and b/source/luametatex/source/luacore/luasocket/doc.zip 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 Binary files /dev/null and b/source/luametatex/source/luacore/luasocket/etc.zip 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 Binary files /dev/null and b/source/luametatex/source/luacore/luasocket/lua.zip 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 Binary files /dev/null and b/source/luametatex/source/luacore/luasocket/samples.zip 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 +#include + +/*-------------------------------------------------------------------------*\ +* 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 {}. 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 + +#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 +#include +#include + +/*=========================================================================*\ +* 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 +#include + +/*=========================================================================*\ +* 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 + +/*=========================================================================*\ +* 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 + +/*=========================================================================*\ +* 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 +#include + +/* +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 + +/*=========================================================================*\ +* 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 +#include +#include + +#ifdef _WIN32 +#include +#else +#include +#include +#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 +#include + +/* 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 +#include + +#include + +#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 +#include + +/*=========================================================================*\ +* 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 +#include + +/*-------------------------------------------------------------------------*\ +* Wait for readable/writable/connected socket with timeout +\*-------------------------------------------------------------------------*/ +#ifndef SOCKET_SELECT +#include + +#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 +/* close function */ +#include +/* fnctnl function and associated constants */ +#include +/* struct sockaddr */ +#include +/* socket function */ +#include +/* struct timeval */ +#include +/* gethostbyname and gethostbyaddr functions */ +#include +/* sigpipe handling */ +#include +/* IP stuff*/ +#include +#include +/* TCP options (nagle algorithm disable) */ +#include +#include + +#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 + +#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 +#include + +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 Binary files /dev/null and b/source/luametatex/source/luacore/luasocket/test.zip 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 +# include +# include +# include +# include +# include +# include +# include +# include +# include +# include +# include +# include + +# ifdef _WIN32 + # include + # include + # include + # include +# else + # include + # include +# 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 + # 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 +# include + +/*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, "", 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, "", 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 ? "" : "", 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, + +}; + +/* = 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; +} + +/* = 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; + } +} + +/* = 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; + } +} + +/*

= 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; + } +} + +/*
= 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; +} + +/* = 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, "", 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 + +# 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 + +# 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 + +# 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); +} + +/* = 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, "", 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 + +/*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); +} + +/* = 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, "", 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); +} + +/* = 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, "", 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 + +// 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 +# include +# include + +/*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 +# include +# include +# include +# include +# include + +// # ifdef _MSC_VER +// # ifndef MAX_PATH +// # define MAX_PATH 256 +// # endif +// # endif + +# ifdef _WIN32 + + # include + # include + # include + # include + # include + # include + + # define MY_MAXPATHLEN MAX_PATH + +# else + + /* the next one is sensitive for c99 */ + + # include + # include + # include + # include + # include + # include + + # 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 +# include +# include + +/* + 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 + +# include +# include +# include + +# 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 +# include +# 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 /*tex for |gettimeofday()| */ +# include /*tex for |times()| */ +# include +# 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 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() + \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, "", 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, "", 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, "", 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, "", 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, "", 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 + = getstring (array|dict|ref,index|key) + = getinteger (array|dict|ref,index|key) + = getnumber (array|dict|ref,index|key) + = getboolean (array|dict|ref,index|key) + = getname (array|dict|ref,index|key) + = getdictionary(array|dict|ref,index|key) + = getarray (array|dict|ref,index|key) + , = 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 expected"); + break; + case LUA_TNUMBER: + tex_normal_warning("pdfe lib", "lua 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 or "); + 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 + +# 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 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, "", 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 + 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 + +# 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 + +# include +# include + +# 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 + 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 + +# 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_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; kpath_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; ibisect_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; ibisect_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, "", 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, " -> "); + break; + case mp_of_macro: + mp_print_str(mp, " of -> "); + break; + case mp_suffix_macro: + mp_print_str(mp, " -> "); + break; + case mp_text_macro: + mp_print_str(mp, " -> "); + 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; kdelta_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, <); + } + 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, <, &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, "'); + } else if (terminal_input) { + if (mp->file_ptr == 0) { + mp_print_nl(mp, ""); + } else { + mp_print_nl(mp, ""); + } + } else if (name == is_scantok) { + mp_print_nl(mp, ""); + } else { + mp_print_nl(mp, ""); + } + 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, " "); + break; + case mp_loop_text: + { + mp_node pp = mp->param_stack[param_start]; + mp_print_nl(mp, " "); + } + break; + case mp_parameter_text: + mp_print_nl(mp, " "); + break; + case mp_backed_up_text: + mp_print_nl(mp, nloc == NULL ? " " : " "); + break; + case mp_inserted_text: + mp_print_nl(mp, " "); + break; + case mp_macro_text: + mp_print_nl(mp, " "); + + 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 ' 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, " "); + 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 := '." + ); + }; + 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 := '." + ); + }; + 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 '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_post_script_code: + hlp = + "Next time say 'withpostscript '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_stacking_code: + hlp = + "Next time say 'withstacking '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_dashed_code: + hlp = + "Next time say 'dashed '; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_uninitialized_model_code: + hlp = + "Next time say 'withcolor '; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_rgb_model_code: + hlp = + "Next time say 'withrgbcolor '; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_cmyk_model_code: + hlp = + "Next time say 'withcmykcolor '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_grey_model_code: + hlp = + "Next time say 'withgreyscale '; I'll ignore the bad\n" + " with' clause and look for another."; + break; + case mp_with_linecap_code: + hlp = + "Next time say 'withlinecap '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_linejoin_code: + hlp = + "Next time say 'withlinejoin '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_miterlimit_code: + hlp = + "Next time say 'miterlimit '; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + default: + hlp = + "Next time say 'withpen '; 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 '"); + 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 +# include + +# 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 +# include +# include +# include +# include +# include +# include +# include +# include + +# ifdef _WIN32 + + # include + # include + # include + +# else + + # include + +# 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 + +# 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" + +@= +# 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 +# include + +@ +typedef struct MP_instance *MP; +@ +typedef struct MP_options { + @