AI_Slop/calog
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

TCL added.

Browse source
This commit is contained in:
Scott Duensing 2026-07-04 23:22:22 -05:00
parent f8fb607cb6
commit efc1c17d4a
919 changed files with 468969 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -7,6 +7,7 @@
# trees (generated .c/.h, the mrbc tool, CMake cache) under their own build/ dirs.
/vendor/mruby/build/
/vendor/libssh2/build/
/vendor/tcl/build/
# ...and mruby's Rake drops a transient per-config lock next to the config (src/mruby/).
/src/mruby/*.lock

4
API.md
View file

@ -84,7 +84,7 @@ Share a function by name across contexts and engines.
|---|---|
| `calogExport(name: string, fn: fn)` | Publish function `fn` under a global `name`. |
| `calogUnexport(name: string)` | Remove an exported name. |
| `calogCall(name: string, ...args: any) -> any` | Call an exported function by name -- works in **every** engine. (An export is also reachable by its bare name -- `exportedFn(args)` -- on Lua/JS/Squirrel/s7, on Ruby at top level (via `method_missing`), and on my-basic case-insensitively (it uppercases identifiers); Wren and Berry always need `calogCall`.) |
| `calogCall(name: string, ...args: any) -> any` | Call an exported function by name -- works in **every** engine. (An export is also reachable by its bare name -- `exportedFn(args)` -- on Lua/JS/Squirrel/s7, on Ruby at top level (via `method_missing`), on Tcl (via its `unknown` handler), and on my-basic case-insensitively (it uppercases identifiers); Wren and Berry always need `calogCall`.) |
## fs
@ -208,7 +208,7 @@ out, or the close blocks until the task next returns to the runtime.
| Function | Description |
|---|---|
| `taskSpawn(engine: string, code: string) -> handle` | Run a code string on a named engine (`"lua"`, `"js"`, `"squirrel"`, `"mybasic"`, `"berry"`, `"s7"`, `"wren"`, `"mruby"`). |
| `taskSpawn(engine: string, code: string) -> handle` | Run a code string on a named engine (`"lua"`, `"js"`, `"squirrel"`, `"mybasic"`, `"berry"`, `"s7"`, `"wren"`, `"mruby"`, `"tcl"`). |
| `taskLoad(baseName: string) -> handle` | Launch a script *file* (engine chosen by extension). |
| `taskEval(handle: handle, code: string)` | Feed more code into a running task (runs on its thread). |
| `taskClose(handle: handle)` | Ask a task to stop (cooperative: sets its shutdown flag, then waits for its thread to exit). |

6
LICENSE.md
View file

@ -70,6 +70,12 @@ libraries below.
`vendor/mruby/` (unmodified upstream; license in `vendor/mruby/LICENSE`, contributors
in `vendor/mruby/AUTHORS`). `libmruby.a` is generated by mruby's own Rake build (needs a
host Ruby + bison at build time); calog links the resulting static archive.
- **Tcl 9.0.4** (Tool Command Language) -- Tcl/Tk License (BSD-style, permissive; allows
binary-only redistribution, no copyleft). Copyright (c) the Tcl Core Team and contributors.
`vendor/tcl/` (unmodified upstream, trimmed to the core: `generic`/`unix`/`compat`/
`libtommath`/`library`; license in `vendor/tcl/license.terms`). `libtcl9.0.a` is produced by
Tcl's own autoconf build (`configure --disable-shared`, out of tree into `vendor/tcl/build/`);
calog links the resulting static archive (`-ldl -lz -lpthread -lm`).
### Database, network, and cryptography libraries

59
Makefile
View file

@ -27,8 +27,8 @@ LDFLAGS = $(SAN)
# Our headers: src/ plus the per-language subdirs. VPATH lets the object rules find
# a source by name without spelling out its directory.
INC = -Isrc -Isrc/lua -Isrc/mybasic -Isrc/squirrel -Isrc/js -Isrc/berry -Isrc/s7 -Isrc/wren -Isrc/mruby -Ilibs
VPATH = src:src/lua:src/mybasic:src/squirrel:src/js:src/berry:src/s7:src/wren:src/mruby:libs:tests
INC = -Isrc -Isrc/lua -Isrc/mybasic -Isrc/squirrel -Isrc/js -Isrc/berry -Isrc/s7 -Isrc/wren -Isrc/mruby -Isrc/tcl -Ilibs
VPATH = src:src/lua:src/mybasic:src/squirrel:src/js:src/berry:src/s7:src/wren:src/mruby:src/tcl:libs:tests
# --- vendored our-basic: calog's fork of MY-BASIC (see vendor/ourbasic/NOTICE) ---
MBDIR = vendor/ourbasic
@ -135,6 +135,20 @@ MRUBYLIBS = -lm
$(MRUBYLIB): $(MRUBYCONF)
cd $(MRUBYDIR) && MRUBY_CONFIG=$(MRUBYCONF) ruby ./minirake -j4
# --- vendored Tcl 9.0.4 (Tool Command Language). Like libssh2/mruby, libtcl is produced by the
# engine's own build (autoconf): configure --disable-shared + make the static-lib target, OUT of
# tree into vendor/tcl/build/ (so the vendored source stays pristine). No host deps beyond a C
# toolchain; Tcl bundles zlib fallback + libtommath. Apartment threading (one Tcl_Interp per
# thread, no GIL) is mandatory in 9.0. Links -ldl -lz -lpthread -lm. tcl.h needs no generated
# header (config is compiled in via -D), so the adapter builds against generic/ + unix/. ---
TCLDIR = vendor/tcl
TCLINC = -I$(TCLDIR)/generic -I$(TCLDIR)/unix
TCLLIB = $(TCLDIR)/build/libtcl9.0.a
TCLLIBS = -ldl -lz -lpthread -lm
$(TCLLIB):
mkdir -p $(TCLDIR)/build && cd $(TCLDIR)/build && ../unix/configure --disable-shared >/dev/null && $(MAKE) libtcl9.0.a
# --- vendored SQLite (C amalgamation, single file). THREADSAFE=1 (serialized) because
# the DB natives run inline on many context threads. Links -lm -lpthread. ---
SQLITEDIR = vendor/sqlite
@ -152,19 +166,19 @@ ENETOBJ = $(foreach n,$(ENETNAMES),obj/enet_$(n).o)
BINS = bin/testBroker bin/testLua bin/testMyBasic bin/testPolyglot bin/testActor \
bin/testEngineLua bin/testEngineMyBasic bin/testSquirrel bin/testEngineSquirrel bin/testJs bin/testEngineJs \
bin/testEngineBerry bin/testEngineS7 bin/testEngineWren bin/testEngineMruby bin/testLoad bin/testDb bin/testNet bin/testTask bin/testExport bin/testJson bin/testTime bin/testFs bin/testCrypto bin/testKv bin/testTimer bin/testPubsub bin/testHttp bin/testHttps bin/embed bin/calog
bin/testEngineBerry bin/testEngineS7 bin/testEngineWren bin/testEngineMruby bin/testEngineTcl bin/testLoad bin/testDb bin/testNet bin/testTask bin/testExport bin/testJson bin/testTime bin/testFs bin/testCrypto bin/testKv bin/testTimer bin/testPubsub bin/testHttp bin/testHttps bin/embed bin/calog
all: $(BINS)
# ---- object rules, grouped by flag set (sources resolved via VPATH) ----
# strict C, no threads
STRICTOBJ = obj/broker.o obj/value.o obj/luaEngine.o obj/squirrelEngine.o obj/jsEngine.o obj/berryEngine.o obj/s7Engine.o obj/wrenEngine.o obj/mrubyEngine.o obj/testBroker.o
STRICTOBJ = obj/broker.o obj/value.o obj/luaEngine.o obj/squirrelEngine.o obj/jsEngine.o obj/berryEngine.o obj/s7Engine.o obj/wrenEngine.o obj/mrubyEngine.o obj/tclEngine.o obj/testBroker.o
$(STRICTOBJ): obj/%.o: %.c | obj
$(CC) $(COREFLAGS) $(INC) -c -o $@ $<
# strict C, threaded
THREADOBJ = obj/context.o obj/mybasicEngine.o obj/testActor.o obj/testEngineLua.o obj/testEngineSquirrel.o obj/testEngineJs.o obj/testEngineMyBasic.o obj/testEngineBerry.o obj/testEngineS7.o obj/testEngineWren.o obj/testEngineMruby.o obj/calogHandle.o obj/testDb.o obj/testNet.o obj/testTask.o obj/calogExport.o obj/testExport.o obj/calogJson.o obj/testJson.o obj/calogFs.o obj/testFs.o obj/calogTime.o obj/testTime.o obj/calogKv.o obj/testKv.o obj/testCrypto.o obj/calogTimer.o obj/testTimer.o obj/calogPubsub.o obj/testPubsub.o obj/testHttp.o obj/testSsh.o
THREADOBJ = obj/context.o obj/mybasicEngine.o obj/testActor.o obj/testEngineLua.o obj/testEngineSquirrel.o obj/testEngineJs.o obj/testEngineMyBasic.o obj/testEngineBerry.o obj/testEngineS7.o obj/testEngineWren.o obj/testEngineMruby.o obj/testEngineTcl.o obj/calogHandle.o obj/testDb.o obj/testNet.o obj/testTask.o obj/calogExport.o obj/testExport.o obj/calogJson.o obj/testJson.o obj/calogFs.o obj/testFs.o obj/calogTime.o obj/testTime.o obj/calogKv.o obj/testKv.o obj/testCrypto.o obj/calogTimer.o obj/testTimer.o obj/calogPubsub.o obj/testPubsub.o obj/testHttp.o obj/testSsh.o
$(THREADOBJ): obj/%.o: %.c | obj
$(CC) $(COREFLAGS) $(INC) -pthread -c -o $@ $<
@ -228,6 +242,11 @@ MRUBYADP = obj/mrubyAdapter.o
$(MRUBYADP): obj/%.o: %.c | obj $(MRUBYLIB)
$(CC) $(ADPFLAGS) $(INC) $(MRUBYINC) -c -o $@ $<
# relaxed C + Tcl headers (tcl.h needs no generated header, so no $(TCLLIB) order dependency).
TCLADP = obj/tclAdapter.o
$(TCLADP): obj/%.o: %.c | obj
$(CC) $(ADPFLAGS) $(INC) $(TCLINC) -c -o $@ $<
# DB library adapter: relaxed C + SQLite headers, sqlite backend compiled in
DBADP = obj/calogDb.o
$(DBADP): obj/%.o: %.c | obj
@ -241,7 +260,7 @@ $(NETADP): obj/%.o: %.c | obj
# task library: strict C with every engine name compiled in (it references each engine
# vtable under its CALOG_WITH_* guard), so a task-using binary links all engine archives.
ENGINEDEFS = -DCALOG_WITH_LUA -DCALOG_WITH_JS -DCALOG_WITH_SQUIRREL -DCALOG_WITH_MYBASIC -DCALOG_WITH_BERRY -DCALOG_WITH_S7 -DCALOG_WITH_WREN -DCALOG_WITH_MRUBY
ENGINEDEFS = -DCALOG_WITH_LUA -DCALOG_WITH_JS -DCALOG_WITH_SQUIRREL -DCALOG_WITH_MYBASIC -DCALOG_WITH_BERRY -DCALOG_WITH_S7 -DCALOG_WITH_WREN -DCALOG_WITH_MRUBY -DCALOG_WITH_TCL
TASKADP = obj/calogTask.o
$(TASKADP): obj/%.o: %.c | obj
$(CC) $(COREFLAGS) $(INC) $(ENGINEDEFS) -pthread -c -o $@ $<
@ -295,7 +314,7 @@ CALOGLIB = obj/value.o obj/broker.o obj/context.o \
obj/luaAdapter.o obj/luaEngine.o obj/jsAdapter.o obj/jsEngine.o \
obj/squirrelAdapter.o obj/squirrelEngine.o obj/mybasicAdapter.o obj/mybasicEngine.o \
obj/berryAdapter.o obj/berryEngine.o obj/s7Adapter.o obj/s7Engine.o obj/wrenAdapter.o obj/wrenEngine.o \
obj/mrubyAdapter.o obj/mrubyEngine.o
obj/mrubyAdapter.o obj/mrubyEngine.o obj/tclAdapter.o obj/tclEngine.o
lib/libcalog.a: $(CALOGLIB) | lib
ar rcs $@ $^
@ -402,6 +421,9 @@ bin/testEngineWren: obj/testEngineWren.o lib/libcalog.a lib/libwren.a | bin
bin/testEngineMruby: obj/testEngineMruby.o lib/libcalog.a $(MRUBYLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(MRUBYLIBS)
bin/testEngineTcl: obj/testEngineTcl.o lib/libcalog.a $(TCLLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(TCLLIBS)
# example host: embeds calog + JS via calog.h only, linking the two archives.
obj/embed.o: examples/embed.c src/calog.h | obj
$(CC) $(COREFLAGS) -Isrc -pthread -c -o $@ $<
@ -417,7 +439,7 @@ bin/embed: obj/embed.o lib/libcalog.a lib/libquickjs.a | bin
# it); SSLARCH follows the archives that reference it.
bin/calog: obj/calogMain.o \
obj/calogCrypto.o obj/calogDbFull.o obj/calogExport.o obj/calogFs.o obj/calogHttp.o obj/calogJson.o obj/calogKv.o obj/calogNet.o obj/calogPubsub.o obj/calogSsh.o obj/calogTask.o obj/calogTime.o obj/calogTimer.o obj/calogHandle.o \
lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) \
lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) $(TCLLIB) \
lib/libsqlite3.a lib/libenet.a $(LIBSSH2LIB) $(DBARCH) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $(filter-out $(DBARCH),$^) -Wl,--start-group $(PGARCHIVES) -Wl,--end-group $(MYSQLARCH) $(SSLARCH) -lstdc++ -ldl -lm -lpthread
@ -456,12 +478,12 @@ static: bin/calogStatic
obj/testLoad.o: tests/testLoad.c src/calog.h | obj
$(CC) $(COREFLAGS) -Isrc -pthread $(ENGINEDEFS) -c -o $@ $<
bin/testLoad: obj/testLoad.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) -lstdc++ -lm $(MRUBYLIBS)
bin/testLoad: obj/testLoad.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) $(TCLLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) -lstdc++ -lm $(MRUBYLIBS) $(TCLLIBS)
# task library test: the task lib names every engine, so (like testLoad) it links them all.
bin/testTask: obj/testTask.o $(TASKADP) obj/calogHandle.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) -lstdc++ -lm $(MRUBYLIBS)
bin/testTask: obj/testTask.o $(TASKADP) obj/calogHandle.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a $(MRUBYLIB) $(TCLLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) -lstdc++ -lm $(MRUBYLIBS) $(TCLLIBS)
# export library test: publish from Lua, call by bare name from Lua + via callExport from JS.
bin/testExport: obj/testExport.o obj/calogExport.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libs7.a lib/libmybasic.a | bin
@ -510,7 +532,7 @@ obj bin lib:
test: all
./bin/testBroker && ./bin/testLua && ./bin/testMyBasic && ./bin/testPolyglot && \
./bin/testActor && ./bin/testEngineLua && ./bin/testEngineMyBasic && ./bin/testSquirrel && ./bin/testEngineSquirrel && \
./bin/testJs && ./bin/testEngineJs && ./bin/testEngineBerry && ./bin/testEngineS7 && ./bin/testEngineWren && ./bin/testEngineMruby && ./bin/testLoad && ./bin/testDb && ./bin/testNet && ./bin/testTask && ./bin/testExport && ./bin/testJson && ./bin/testTime && ./bin/testFs && ./bin/testCrypto && ./bin/testKv && ./bin/testTimer && ./bin/testPubsub && ./bin/testHttp && ./bin/testHttps
./bin/testJs && ./bin/testEngineJs && ./bin/testEngineBerry && ./bin/testEngineS7 && ./bin/testEngineWren && ./bin/testEngineMruby && ./bin/testEngineTcl && ./bin/testLoad && ./bin/testDb && ./bin/testNet && ./bin/testTask && ./bin/testExport && ./bin/testJson && ./bin/testTime && ./bin/testFs && ./bin/testCrypto && ./bin/testKv && ./bin/testTimer && ./bin/testPubsub && ./bin/testHttp && ./bin/testHttps
# ThreadSanitizer build of the actor core and the Lua engine path (cannot combine
# with ASan). Recompiled from source under TSan; the vendored Lua objects are
@ -603,6 +625,15 @@ tsanmruby: $(MRUBYLIB) | bin obj
$(MRUBYLIB) $(MRUBYLIBS)
setarch -R ./bin/testEngineMrubyTsan
# ThreadSanitizer build of the Tcl engine path. Like tsanmruby, libtcl is a separately-built
# archive linked UN-sanitized; TSan instruments the calog adapter/engine/actor code, where the
# cross-context risk lives. Tcl's apartment model gives each thread its own interpreter.
tsantcl: $(TCLLIB) | bin obj
$(CC) $(TSANFLAGS) $(INC) $(TCLINC) -o bin/testEngineTclTsan \
tests/testEngineTcl.c src/tcl/tclEngine.c src/tcl/tclAdapter.c $(TSANCORE) \
$(TCLLIB) $(TCLLIBS)
setarch -R ./bin/testEngineTclTsan
# ThreadSanitizer build of the concurrent libraries (timer's background thread, pubsub's
# callback fan-out, kv's shared store), each over a Lua context so callbacks marshal across
# threads. The unsanitized liblua.a links in fine (TSan instruments only the calog code).
@ -620,4 +651,4 @@ clean:
-include $(wildcard obj/*.d)
-include $(wildcard obj/rel/*.d)
.PHONY: all test tsan tsansq tsanjs tsanmb tsanberry tsans7 tsanwren tsanmruby tsanlibs clean
.PHONY: all test tsan tsansq tsanjs tsanmb tsanberry tsans7 tsanwren tsanmruby tsantcl tsanlibs clean

45
README.md
View file

@ -3,8 +3,8 @@
**C: Any Language, One Gateway.**
calog embeds scripting into a C or C++ program. You register your native C functions
**once**, and they become callable from **any** embedded engine — Lua, JavaScript, Scheme,
Squirrel, Wren, Berry, Ruby, or MY-BASIC — with values passed through a single canonical type. Add a new
**once**, and they become callable from **any** embedded engine -- Lua, JavaScript, Scheme,
Squirrel, Wren, Berry, Ruby, Tcl, or MY-BASIC -- with values passed through a single canonical type. Add a new
scripting language to your app by linking one more archive; your native functions don't
change.
@ -19,7 +19,7 @@ calogContextEval(ctx, "hostLog('hello from JavaScript, ' + 6 * 7)");
```
Swap `&calogJsEngine` for `&calogLuaEngine`, `&calogSquirrelEngine`,
`&calogS7Engine`, `&calogWrenEngine`, `&calogBerryEngine`, `&calogMrubyEngine`, or `&calogMyBasicEngine` — nothing else changes.
`&calogS7Engine`, `&calogWrenEngine`, `&calogBerryEngine`, `&calogMrubyEngine`, `&calogTclEngine`, or `&calogMyBasicEngine` -- nothing else changes.
---
@ -27,11 +27,11 @@ Swap `&calogJsEngine` for `&calogLuaEngine`, `&calogSquirrelEngine`,
- **One API, many languages.** Register a native once; call it from every engine.
`calog.h` is the entire public surface.
- **One value type.** Everything crosses the boundary as a `CalogValueT` — nil, bool,
- **One value type.** Everything crosses the boundary as a `CalogValueT` -- nil, bool,
int, real, binary-safe string, a hybrid list/map aggregate, or a script function
value. No per-engine glue in your code.
- **Natives run on your thread, serialized.** A script calling a native is marshalled to
the host thread and run there during `calogPump()`, one at a time — so your C code is
the host thread and run there during `calogPump()`, one at a time -- so your C code is
never called concurrently and needs **no locking**. (An opt-in escape hatch runs a
native inline on the script's thread when you want it.)
- **Fire-and-forget scripts.** Scripts run on their own context threads; the host stays
@ -50,16 +50,17 @@ Swap `&calogJsEngine` for `&calogLuaEngine`, `&calogSquirrelEngine`,
## Engines
| Engine | Vtable | Extension | Notes |
|---------------|------------------------|-----------|-----------------------------------------|
| Lua 5.4 | `calogLuaEngine` | `.lua` | |
| JavaScript | `calogJsEngine` | `.js` | QuickJS-ng (ES2023+, BigInt → int64) |
| Squirrel 3.2 | `calogSquirrelEngine` | `.nut` | C++ VM |
| MY-BASIC | `calogMyBasicEngine` | `.bas` | interpreters serialize at load |
| Scheme | `calogS7Engine` | `.scm` | s7; 64-bit ints |
| Wren | `calogWrenEngine` | `.wren` | doubles only; call via `Calog.call(…)` |
| Berry | `calogBerryEngine` | `.be` | scalars + callbacks |
| Engine | Vtable | Extension | Notes |
|---------------|------------------------|-----------|-------------------------------------------|
| Lua 5.4 | `calogLuaEngine` | `.lua` | |
| JavaScript | `calogJsEngine` | `.js` | QuickJS-ng (ES2023+, BigInt -> int64) |
| Squirrel 3.2 | `calogSquirrelEngine` | `.nut` | C++ VM |
| MY-BASIC | `calogMyBasicEngine` | `.bas` | interpreters serialize at load |
| Scheme | `calogS7Engine` | `.scm` | s7; 64-bit ints |
| Wren | `calogWrenEngine` | `.wren` | doubles only; call via `Calog.call(...)` |
| Berry | `calogBerryEngine` | `.be` | scalars + callbacks |
| Ruby | `calogMrubyEngine` | `.rb` | mruby; 64-bit ints; built by mruby's Rake |
| Tcl | `calogTclEngine` | `.tcl` | Tcl 9; 64-bit ints; string-typed values |
A native can return a keyed `CalogValueT` record and **every** engine reads its fields with
native syntax (`user.name`, `user["name"]`, `(user "name")`), and a script can hand a
@ -87,7 +88,7 @@ self-contained.
### Linking your program
Link against `lib/libcalog.a` plus the archive for **each engine you actually use** —
Link against `lib/libcalog.a` plus the archive for **each engine you actually use** --
unused engines (and their vendored runtimes) stay out of your binary.
```sh
@ -251,7 +252,7 @@ for (;;) {
}
```
Script results come back by **calling natives** — `calogContextEval` doesn't return a
Script results come back by **calling natives** -- `calogContextEval` doesn't return a
value. Script errors are delivered to an optional handler on the host thread during
`calogPump`:
@ -264,7 +265,7 @@ calogSetErrorHandler(calog, onError, NULL); // default logs to stderr
### Callbacks: script functions as values
A script can pass you a function. Keep it (retain), call it later, release it when done —
A script can pass you a function. Keep it (retain), call it later, release it when done --
calog runs the call on the engine that owns it and returns the result to you:
```c
@ -318,7 +319,7 @@ CalogContextT *ctx = calogContextLoad(calog, "config"); // tries config.lua, th
```
Or let the build decide which engines exist. Compile the calling file with
`-DCALOG_WITH_LUA -DCALOG_WITH_JS …` and call the header-inline helper — it registers
`-DCALOG_WITH_LUA -DCALOG_WITH_JS ...` and call the header-inline helper -- it registers
exactly the engines you linked, and references no others:
```c
@ -330,7 +331,7 @@ CalogContextT *ctx = calogContextLoad(calog, "config");
A `CalogT` is a self-contained runtime; you can create several in one process. Each is
driven by a host thread, and one thread may drive several by pumping each in turn. Keep
values and callbacks within a single runtime — they don't cross between runtimes.
values and callbacks within a single runtime -- they don't cross between runtimes.
---
@ -381,7 +382,7 @@ uint64_t calogCurrentId(void); // 0 on the host thread
CalogT *calogCurrent(void);
```
Statuses are `CalogStatusE` (`calogOkE`, `calogErrArgE`, `calogErrOomE`, …); `calogOkE`
Statuses are `CalogStatusE` (`calogOkE`, `calogErrArgE`, `calogErrOomE`, ...); `calogOkE`
is 0.
---
@ -405,7 +406,7 @@ is happy on all kernels.
src/ core (broker, values, actor) + one subdir per engine (lua, js, squirrel, mybasic)
calog.h the entire public API
tests/ the test programs
examples/ embed.c — a minimal host
examples/ embed.c -- a minimal host
vendor/ vendored engine sources, built from source
design.md the full design rationale and internals
```
@ -419,5 +420,5 @@ build system.
## License
calog is released under the [MIT License](LICENSE.md). The vendored engines (Lua,
Duktape, Squirrel, MY-BASIC) each retain their own MIT licenses — see
Duktape, Squirrel, MY-BASIC) each retain their own MIT licenses -- see
[`LICENSE.md`](LICENSE.md) for the third-party notices.

45
design.md
View file

@ -1078,3 +1078,48 @@ adapter/engine/actor code (like `tsanlibs` with Lua); each VM is single-threaded
cross-thread lambda callback, the error handler, three concurrent `mrb_state`s), ASan-clean;
`tsanmruby` clean; cross-engine both ways (Ruby calling a Lua export, Lua invoking a Ruby lambda
export); `make test` 29/29.
## 20. Tcl -- the ninth engine (Tool Command Language)
**Tcl** (`.tcl`, `calogTclEngine`) is the second engine whose static library is produced by the
engine's own build rather than compiled from vendored `.c`: Tcl 9.0.4's autoconf (`configure
--disable-shared`, out of tree into `vendor/tcl/build/`) emits `libtcl9.0.a` with no host deps beyond
a C toolchain -- Tcl bundles its own zlib fallback and libtommath. Two build facts mattered: `make
libtcl9.0.a` pulls in the zipfs library-embed step, so `vendor/tcl/library/` must be present
(over-trimming it broke the build); and calog never calls `Tcl_Init`, because the whole core language
(`proc`/`if`/`expr`/`string`/`list`/`dict`/...) is C built-ins registered by `Tcl_CreateInterp` -- so
the on-disk script library (init.tcl) is not needed. Linked footprint is ~2 MB.
Concurrency is the reason Tcl was chosen: its apartment model -- one `Tcl_Interp` per thread, no
global interpreter lock -- IS calog's actor model. Each context creates its interp on its own thread
and never shares it; the one process-global init (`Tcl_FindExecutable` + caching the internal-rep type
pointers) runs once under `pthread_once`, and each context thread runs `Tcl_FinalizeThread` at
teardown. Natives are Tcl commands bound to one trampoline (the name is `objv[0]`, the context rides
on per-interp assoc data), so `cryptoUuid` is callable bare.
The value model is the interesting part. Tcl is "everything is a string", so egress cannot read the
canonical type off a bare value: `tclToValue` dispatches on the `Tcl_Obj` internal representation
(`typePtr`, cached by minting a sample of each -- `Tcl_GetObjType` returns NULL for "int"/"bytearray"
in 9.0) for int64 (`Tcl_WideInt`), double, Tcl list <-> list, and Tcl dict <-> map. For a value with a
string (or no) rep it applies Tcl's own coercion -- a pure integer/real string becomes a number, so
`enetHost 8080` works -- otherwise a string. The documented EIAS losses: nil has no Tcl analogue and
round-trips to the empty string, and bool round-trips to 0/1. Binary-safe strings map to byte-array
objects (`Tcl_NewByteArrayObj`), since Tcl's string rep is UTF-8, not NUL-safe.
Callbacks cross both ways on commands, with no custom `Tcl_ObjType`. A foreign `CalogFnT` (in
`tclFromValue`) or a Tcl command prefix wrapped by the adapter's `calogCallback` command both become a
`calogFn<N>` command whose objProc is `tclForeignCmd` and whose clientData is the `CalogFnT` (released
by the command's delete proc -- Tcl commands carry per-registration data, unlike mruby's `mrb_func_t`).
The command NAME is the value the script holds -- it calls `$fn a b` -- and `tclToValue` recognizes
such a name (`Tcl_GetCommandInfo` -> objProc == `tclForeignCmd`) to marshal it back OUT as a function
value, so a Tcl callback reaches `psSubscribe`/`timerAfter`/`calogExport`. Bare-name exports work via
Tcl's own `unknown` handler (also normally from init.tcl): the adapter defines it to resolve an
undefined command against the export registry and invoke it -- and because Tcl has no receiver-method
syntax, `unknown` firing always means a genuinely-missing command, so no guard is needed (unlike Ruby's
`method_missing`). puts/print write to stdout directly (Tcl's channel `puts` needs the IO subsystem
calog does not init); there is no file/socket IO -- scripts use calog's `fs*`/`net*` natives.
**Verified**: `testEngineTcl` (13 checks -- natives, dict egress/ingress with a nested list, a foreign
command callable, a cross-thread Tcl callback via `calogCallback`, the error handler, three concurrent
interpreters), ASan-clean; `tsantcl` clean; bare-name exports and cross-engine both ways; `make test`
30/30.

1
examples/scripts/README.md
View file

@ -34,6 +34,7 @@ Conventions every example follows:
| `mybasic.bas` | my-basic: variables, a `FOR..NEXT` sum, `IF..THEN..ELSE`, plus crypto + kv |
| `berry.be` | Berry (Python-like): a `def`, a list built with a `for`, a map, then json + uuid |
| `ruby.rb` | Ruby (mruby): a Range, `reduce` with a block, `select(&:even?)`, a Hash, then json + sha256 |
| `tcl.tcl` | Tcl 9: `set`/`expr`, a `foreach`, a list and a `dict`, then json + sha256 |
| `scheme.scm` | s7 Scheme: a recursive factorial, list build + map, string ops (all in one `(begin ...)`) |
| `wren.wren` | Wren: a class, a `List`, and every native reached via `Calog.call(name, [args])` |

20
examples/scripts/languages/tcl.tcl Normal file
View file

@ -0,0 +1,20 @@
# A guided tour of Tcl (9.0) running on calog.
# Demonstrates: set/expr, a foreach loop, a list and a dict, then the jsonStringify/jsonParse and
# cryptoHashSha256 natives. puts works; real file/socket IO is provided by calog's fs*/net* natives
# (not Tcl channels), so scripts stay uniform. Tcl values are strings, so a numeric literal handed
# to a native is coerced to an int.
# run: bin/calog examples/scripts/languages/tcl.tcl
set nums {1 2 3 4 5}
set total 0
foreach n $nums { set total [expr {$total + $n}] }
puts "nums = $nums, total = $total"
set user [dict create name ada age 36]
puts "user as JSON: [jsonStringify $user]"
set parsed [jsonParse {{"lang":"tcl","ints":[10,20,30]}}]
puts "parsed lang = [dict get $parsed lang], second int = [lindex [dict get $parsed ints] 1]"
puts "sha256(calog) = [cryptoHashSha256 calog]"
calogExit 0

7
libs/calogExport.h
View file

@ -13,9 +13,10 @@
// the same way via Kernel#method_missing, but only at TOP LEVEL (self is the main object, so a
// missing method on some other receiver -- obj.foo -- is never hijacked). my-basic likewise
// bare-resolves a name called like a function, but CASE-INSENSITIVELY (it uppercases identifiers
// at parse time), so `luaExample(1, 2)` there matches the export ignoring case. Wren and Berry
// resolve names statically and use calogCall('luaExample', ...). Resolution is dynamic: a name
// exported at any time becomes callable immediately, and calogUnexport takes effect at once.
// at parse time), so `luaExample(1, 2)` there matches the export ignoring case. Tcl resolves a bare
// command the same way via its `unknown` handler (`luaExample 1 2`). Wren and Berry resolve names
// statically and use calogCall('luaExample', ...). Resolution is dynamic: a name exported at any
// time becomes callable immediately, and calogUnexport takes effect at once.
//
// An exported function is an ordinary calog function value, so a call runs in the exporter's
// own context/thread (marshalled like any callable), and a call after the exporter is gone

3
libs/calogTask.c
View file

@ -72,6 +72,9 @@ static const TaskEngineT gTaskEngines[] = {
#endif
#ifdef CALOG_WITH_MRUBY
{ "mruby", &calogMrubyEngine },
#endif
#ifdef CALOG_WITH_TCL
{ "tcl", &calogTclEngine },
#endif
{ NULL, NULL }
};

4
src/calog.h
View file

@ -204,6 +204,7 @@ extern const CalogEngineT calogBerryEngine;
extern const CalogEngineT calogS7Engine;
extern const CalogEngineT calogWrenEngine;
extern const CalogEngineT calogMrubyEngine;
extern const CalogEngineT calogTclEngine;
// Register the built-in engines selected at build time, so calogContextLoad works
// without hand-registering each. Define CALOG_WITH_LUA / _JS / _SQUIRREL / _MYBASIC (in
@ -235,6 +236,9 @@ static inline void calogRegisterBuiltinEngines(CalogT *calog) {
#endif
#ifdef CALOG_WITH_MRUBY
calogRegisterEngine(calog, &calogMrubyEngine);
#endif
#ifdef CALOG_WITH_TCL
calogRegisterEngine(calog, &calogTclEngine);
#endif
(void)calog; // no-op if the build selected no engines
}

3
src/calogMain.c
View file

@ -94,7 +94,8 @@ static const CalogEngineT *const gEngines[] = {
&calogBerryEngine,
&calogS7Engine,
&calogWrenEngine,
&calogMrubyEngine
&calogMrubyEngine,
&calogTclEngine
};
// The built-in libraries, in registration order. One source of truth: main() registers every

718
src/tcl/tclAdapter.c Normal file
View file

@ -0,0 +1,718 @@
// tclAdapter.c -- Tcl (Tool Command Language) engine adapter for the broker.
//
// Each exposed native is a Tcl command bound to one shared trampoline (tclTrampoline): the command
// name is objv[0], the owning context rides on per-interp assoc data (tclOf), and the arguments
// dispatch through calogCall. Marshalling covers scalars and BINARY-SAFE strings (via byte-array
// objects); aggregates cross both ways (Tcl list<->list, Tcl dict<->map). Because Tcl is
// "everything is a string", egress (tclToValue) recovers the canonical type from the Tcl_Obj
// internal representation (typePtr, cached at first use), coercing an untyped pure-numeric string
// to int/real and otherwise keeping it a string; nil has no Tcl analogue and round-trips to the
// empty string, bool to 0/1 (documented EIAS losses).
//
// Callbacks both ways ride on commands. A foreign CalogFnT (in tclFromValue, or a Tcl command
// prefix wrapped by the `calogCallback` command) becomes a "calogFn<N>" command whose objProc is
// tclForeignCmd and whose clientData is the CalogFnT (released by its delete proc). The command
// NAME is the value the script holds -- call it `$fn a b` -- and tclToValue recognizes such a name
// (Tcl_GetCommandInfo -> objProc == tclForeignCmd) to marshal it back OUT as a function value, so a
// Tcl callback reaches natives like psSubscribe/timerAfter/calogExport. There is no file/socket IO;
// scripts use calog's fs*/net* natives, and the adapter provides puts/print.
//
// Error model: a failed native/marshal sets the interp result and returns TCL_ERROR (Tcl unwinds).
// Concurrency: Tcl's apartment model gives one Tcl_Interp per thread with no global lock; the one
// process-global init (Tcl_FindExecutable + caching the type pointers) is done once via pthread_once,
// and each context thread runs Tcl_FinalizeThread at teardown.
#define _POSIX_C_SOURCE 200809L
#include "tclAdapter.h"
#include <tcl.h>
#include <pthread.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
struct CalogTclT {
Tcl_Interp *interp;
CalogT *broker;
uint64_t ctxId;
int32_t nextFn; // mints unique "calogFn<N>" command names for function values
};
// Backs a CalogFnT that invokes a Tcl command prefix (a script callback captured as a value).
typedef struct TclScriptT {
CalogTclT *context;
Tcl_Obj *prefix;
} TclScriptT;
// Internal-rep type pointers, cached once (they are process-global static ObjTypes in libtcl).
// Tcl_GetObjType returns NULL for "int"/"bytearray" in 9.0, so we mint a sample of each instead.
static pthread_once_t gInitOnce = PTHREAD_ONCE_INIT;
static const Tcl_ObjType *gIntType = NULL;
static const Tcl_ObjType *gDoubleType = NULL;
static const Tcl_ObjType *gByteArrayType = NULL;
static const Tcl_ObjType *gListType = NULL;
static const Tcl_ObjType *gDictType = NULL;
static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclForeignCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static void tclForeignDelete(void *cd);
static int32_t tclFromValue(CalogTclT *context, const CalogValueT *value, Tcl_Obj **out, int32_t depth);
static void tclInitOnce(void);
static int32_t tclMakeFnCommand(CalogTclT *context, CalogFnT *fn, Tcl_Obj **out);
static int32_t tclMarshalArgs(CalogTclT *context, int objc, Tcl_Obj *const objv[], int from, CalogValueT **out, int32_t *outCount);
static CalogTclT *tclOf(Tcl_Interp *ip);
static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int32_t tclScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void tclScriptRelease(CalogFnT *callable);
static int tclSetResult(CalogTclT *context, Tcl_Interp *ip, int32_t status, CalogValueT *result);
static int32_t tclToValue(CalogTclT *context, Tcl_Obj *obj, CalogValueT *out, int32_t depth);
static int tclTrampoline(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclUnknownCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int32_t tclWrapCommand(CalogTclT *context, Tcl_Obj *prefix, CalogFnT **out);
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId) {
CalogTclT *context;
*out = NULL;
pthread_once(&gInitOnce, tclInitOnce);
context = (CalogTclT *)calloc(1, sizeof(*context));
if (context == NULL) {
return calogErrOomE;
}
context->interp = Tcl_CreateInterp();
if (context->interp == NULL) {
free(context);
return calogErrOomE;
}
context->broker = broker;
context->ctxId = ctxId;
Tcl_SetAssocData(context->interp, "calogCtx", NULL, context); // recovered by tclOf
// puts/print write to stdout directly: Tcl's channel-based puts needs the IO subsystem calog
// does not initialize. calogCallback wraps a command prefix into a callable function value.
Tcl_CreateObjCommand(context->interp, "puts", tclPutsCmd, NULL, NULL);
Tcl_CreateObjCommand(context->interp, "print", tclPrintCmd, NULL, NULL);
Tcl_CreateObjCommand(context->interp, "calogCallback", tclCallbackCmd, NULL, NULL);
// Bare-name export resolution: an undefined command resolves to a broker export (like the hook
// engines). Tcl's `unknown` command-not-found handler normally lives in the skipped init.tcl.
Tcl_CreateObjCommand(context->interp, "unknown", tclUnknownCmd, NULL, NULL);
*out = context;
return calogOkE;
}
// calogCallback command ?arg ...? -- wrap a Tcl command prefix as a calog function value (its name).
static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
Tcl_Obj *prefix;
Tcl_Obj *nameObj;
CalogFnT *fn;
(void)cd;
context = tclOf(ip);
if (objc < 2) {
Tcl_WrongNumArgs(ip, 1, objv, "command ?arg ...?");
return TCL_ERROR;
}
prefix = Tcl_NewListObj(objc - 1, objv + 1);
if (tclWrapCommand(context, prefix, &fn) != calogOkE) {
Tcl_BounceRefCount(prefix);
Tcl_SetObjResult(ip, Tcl_NewStringObj("calogCallback: out of memory", -1));
return TCL_ERROR;
}
if (tclMakeFnCommand(context, fn, &nameObj) != calogOkE) {
calogFnRelease(fn);
Tcl_SetObjResult(ip, Tcl_NewStringObj("calogCallback: out of memory", -1));
return TCL_ERROR;
}
calogFnRelease(fn); // tclMakeFnCommand retained its own reference for the command
Tcl_SetObjResult(ip, nameObj);
return TCL_OK;
}
void calogTclDestroy(CalogTclT *context) {
if (context == NULL) {
return;
}
if (context->interp != NULL) {
Tcl_DeleteInterp(context->interp); // fires every function-value command's delete proc
}
// Each calog context owns its thread, so this is thread teardown: release Tcl's per-thread
// notifier / thread storage.
Tcl_FinalizeThread();
free(context);
}
int32_t calogTclExport(CalogTclT *context, const char *name, CalogFnT **out) {
Tcl_CmdInfo info;
Tcl_Obj *nameObj;
Tcl_Obj *prefix;
*out = NULL;
if (!Tcl_GetCommandInfo(context->interp, name, &info)) {
return calogErrNotFoundE;
}
nameObj = Tcl_NewStringObj(name, -1);
prefix = Tcl_NewListObj(1, &nameObj);
return tclWrapCommand(context, prefix, out);
}
int32_t calogTclExpose(CalogTclT *context, const char *name) {
if (calogLookup(context->broker, name) == NULL) {
return calogErrNotFoundE;
}
Tcl_CreateObjCommand(context->interp, name, tclTrampoline, NULL, NULL);
return calogOkE;
}
// Call target for a function value (a foreign CalogFnT, or a Tcl callback wrapped by calogCallback).
static int tclForeignCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
CalogValueT *args;
CalogValueT result;
int32_t argc;
int32_t index;
int32_t status;
context = tclOf(ip);
args = NULL;
argc = 0;
if (tclMarshalArgs(context, objc, objv, 1, &args, &argc) != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal a function-value argument", -1));
return TCL_ERROR;
}
status = calogFnInvoke((CalogFnT *)cd, args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
return tclSetResult(context, ip, status, &result);
}
static void tclForeignDelete(void *cd) {
calogFnRelease((CalogFnT *)cd);
}
static int32_t tclFromValue(CalogTclT *context, const CalogValueT *value, Tcl_Obj **out, int32_t depth) {
*out = NULL;
if (depth >= CALOG_MAX_DEPTH) {
*out = Tcl_NewObj();
return calogErrDepthE;
}
switch (value->type) {
case calogNilE:
*out = Tcl_NewObj(); // Tcl has no nil; empty string
return calogOkE;
case calogBoolE:
*out = Tcl_NewWideIntObj(value->as.b ? 1 : 0);
return calogOkE;
case calogIntE:
*out = Tcl_NewWideIntObj((Tcl_WideInt)value->as.i);
return calogOkE;
case calogRealE:
*out = Tcl_NewDoubleObj((double)value->as.r);
return calogOkE;
case calogStringE:
// byte array -> binary-safe (Tcl string reps are UTF-8, not NUL-safe)
*out = Tcl_NewByteArrayObj((const unsigned char *)value->as.s.bytes, (Tcl_Size)value->as.s.length);
return calogOkE;
case calogAggE: {
CalogAggT *aggregate;
int64_t index;
int32_t status;
Tcl_Obj *child;
aggregate = value->as.agg;
if (calogAggIsKeyed(aggregate)) {
Tcl_Obj *dict;
dict = Tcl_NewDictObj();
for (index = 0; index < aggregate->arrayCount; index++) {
status = tclFromValue(context, &aggregate->array[index], &child, depth + 1);
if (status != calogOkE) {
Tcl_BounceRefCount(dict);
*out = Tcl_NewObj();
return status;
}
Tcl_DictObjPut(NULL, dict, Tcl_NewWideIntObj((Tcl_WideInt)index), child);
}
for (index = 0; index < aggregate->pairCount; index++) {
Tcl_Obj *key;
status = tclFromValue(context, &aggregate->pairs[index].key, &key, depth + 1);
if (status != calogOkE) {
Tcl_BounceRefCount(dict);
*out = Tcl_NewObj();
return status;
}
status = tclFromValue(context, &aggregate->pairs[index].value, &child, depth + 1);
if (status != calogOkE) {
Tcl_BounceRefCount(key);
Tcl_BounceRefCount(dict);
*out = Tcl_NewObj();
return status;
}
Tcl_DictObjPut(NULL, dict, key, child);
}
*out = dict;
return calogOkE;
}
Tcl_Obj *list;
list = Tcl_NewListObj(0, NULL);
for (index = 0; index < aggregate->arrayCount; index++) {
status = tclFromValue(context, &aggregate->array[index], &child, depth + 1);
if (status != calogOkE) {
Tcl_BounceRefCount(list);
*out = Tcl_NewObj();
return status;
}
Tcl_ListObjAppendElement(NULL, list, child);
}
*out = list;
return calogOkE;
}
case calogFnE:
return tclMakeFnCommand(context, value->as.fn, out);
}
*out = Tcl_NewObj();
return calogErrTypeE;
}
static void tclInitOnce(void) {
Tcl_Obj *sample;
Tcl_FindExecutable(NULL); // one-time subsystem (encoding/stub) init
sample = Tcl_NewWideIntObj(0);
Tcl_IncrRefCount(sample); gIntType = sample->typePtr; Tcl_DecrRefCount(sample);
sample = Tcl_NewDoubleObj(0.0);
Tcl_IncrRefCount(sample); gDoubleType = sample->typePtr; Tcl_DecrRefCount(sample);
sample = Tcl_NewByteArrayObj((const unsigned char *)"\0", 1);
Tcl_IncrRefCount(sample); gByteArrayType = sample->typePtr; Tcl_DecrRefCount(sample);
sample = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, sample, Tcl_NewWideIntObj(0));
Tcl_IncrRefCount(sample); gListType = sample->typePtr; Tcl_DecrRefCount(sample);
sample = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, sample, Tcl_NewStringObj("k", 1), Tcl_NewWideIntObj(0));
Tcl_IncrRefCount(sample); gDictType = sample->typePtr; Tcl_DecrRefCount(sample);
}
// Register a "calogFn<N>" command backed by `fn` (retained; released by tclForeignDelete). The
// command NAME is returned as the script-visible function value.
static int32_t tclMakeFnCommand(CalogTclT *context, CalogFnT *fn, Tcl_Obj **out) {
char name[32];
snprintf(name, sizeof(name), "calogFn%d", context->nextFn++);
calogFnRetain(fn);
Tcl_CreateObjCommand(context->interp, name, tclForeignCmd, fn, tclForeignDelete);
*out = Tcl_NewStringObj(name, -1);
return calogOkE;
}
static int32_t tclMarshalArgs(CalogTclT *context, int objc, Tcl_Obj *const objv[], int from, CalogValueT **out, int32_t *outCount) {
CalogValueT *args;
int32_t argc;
int32_t index;
int32_t status;
*out = NULL;
*outCount = 0;
argc = (int32_t)objc - from;
if (argc <= 0) {
return calogOkE;
}
args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
if (args == NULL) {
return calogErrOomE;
}
for (index = 0; index < argc; index++) {
status = tclToValue(context, objv[from + index], &args[index], 0);
if (status != calogOkE) {
int32_t cleanup;
for (cleanup = 0; cleanup < index; cleanup++) {
calogValueFree(&args[cleanup]);
}
free(args);
return status;
}
}
*out = args;
*outCount = argc;
return calogOkE;
}
static CalogTclT *tclOf(Tcl_Interp *ip) {
return (CalogTclT *)Tcl_GetAssocData(ip, "calogCtx", NULL);
}
static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
int index;
(void)cd;
(void)ip;
for (index = 1; index < objc; index++) {
Tcl_Size len;
const char *bytes;
bytes = Tcl_GetStringFromObj(objv[index], &len);
fwrite(bytes, 1, (size_t)len, stdout);
}
return TCL_OK;
}
static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
int nonewline;
int first;
Tcl_Size len;
const char *bytes;
(void)cd;
(void)ip;
nonewline = (objc >= 2 && strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0);
first = nonewline ? 2 : 1;
// The string is the last argument; a channel argument (e.g. stdout) before it is ignored.
if (objc > first) {
bytes = Tcl_GetStringFromObj(objv[objc - 1], &len);
fwrite(bytes, 1, (size_t)len, stdout);
}
if (!nonewline) {
fputc('\n', stdout);
}
return TCL_OK;
}
static int32_t tclScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
TclScriptT *holder;
CalogTclT *context;
Tcl_Interp *ip;
Tcl_Size prefixCount;
Tcl_Obj **prefixElems;
Tcl_Obj **objv;
int32_t total;
int32_t index;
int32_t status;
int code;
holder = (TclScriptT *)userData;
context = holder->context;
ip = context->interp;
calogValueNil(result);
if (Tcl_ListObjGetElements(ip, holder->prefix, &prefixCount, &prefixElems) != TCL_OK) {
return calogFail(result, calogErrArgE, "invalid tcl callback prefix");
}
total = (int32_t)prefixCount + argCount;
objv = (Tcl_Obj **)calloc((size_t)(total > 0 ? total : 1), sizeof(Tcl_Obj *));
if (objv == NULL) {
return calogFail(result, calogErrOomE, "out of memory invoking tcl callback");
}
for (index = 0; index < (int32_t)prefixCount; index++) {
objv[index] = prefixElems[index];
Tcl_IncrRefCount(objv[index]);
}
for (index = 0; index < argCount; index++) {
Tcl_Obj *arg;
status = tclFromValue(context, &args[index], &arg, 0);
if (status != calogOkE) {
int32_t cleanup;
Tcl_BounceRefCount(arg);
for (cleanup = 0; cleanup < (int32_t)prefixCount + index; cleanup++) {
Tcl_DecrRefCount(objv[cleanup]);
}
free(objv);
return calogFail(result, status, "failed to marshal a tcl callback argument");
}
objv[(int32_t)prefixCount + index] = arg;
Tcl_IncrRefCount(arg);
}
code = Tcl_EvalObjv(ip, total, objv, 0);
for (index = 0; index < total; index++) {
Tcl_DecrRefCount(objv[index]);
}
free(objv);
if (code != TCL_OK) {
return calogFail(result, calogErrArgE, Tcl_GetString(Tcl_GetObjResult(ip)));
}
return tclToValue(context, Tcl_GetObjResult(ip), result, 0);
}
static void tclScriptRelease(CalogFnT *callable) {
TclScriptT *holder;
holder = (TclScriptT *)calogFnUserData(callable);
Tcl_DecrRefCount(holder->prefix);
free(holder);
}
static int tclSetResult(CalogTclT *context, Tcl_Interp *ip, int32_t status, CalogValueT *result) {
Tcl_Obj *obj;
int32_t marshal;
if (status != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj((result->type == calogStringE) ? result->as.s.bytes : "native call failed", -1));
calogValueFree(result);
return TCL_ERROR;
}
marshal = tclFromValue(context, result, &obj, 0);
calogValueFree(result);
if (marshal != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal the native result", -1));
return TCL_ERROR;
}
Tcl_SetObjResult(ip, obj);
return TCL_OK;
}
static int32_t tclToValue(CalogTclT *context, Tcl_Obj *obj, CalogValueT *out, int32_t depth) {
const Tcl_ObjType *type;
calogValueNil(out);
if (depth >= CALOG_MAX_DEPTH) {
return calogErrDepthE;
}
type = obj->typePtr;
if (type == gDictType) {
CalogAggT *aggregate;
Tcl_DictSearch search;
Tcl_Obj *key;
Tcl_Obj *val;
int done;
int32_t status;
status = calogAggCreate(&aggregate, calogMapE);
if (status != calogOkE) {
return status;
}
if (Tcl_DictObjFirst(NULL, obj, &search, &key, &val, &done) != TCL_OK) {
calogAggFree(aggregate);
return calogErrArgE;
}
for (; !done; Tcl_DictObjNext(&search, &key, &val, &done)) {
CalogValueT ckey;
CalogValueT cval;
status = tclToValue(context, key, &ckey, depth + 1);
if (status != calogOkE) {
Tcl_DictObjDone(&search);
calogAggFree(aggregate);
return status;
}
status = tclToValue(context, val, &cval, depth + 1);
if (status != calogOkE) {
calogValueFree(&ckey);
Tcl_DictObjDone(&search);
calogAggFree(aggregate);
return status;
}
status = calogAggSet(aggregate, &ckey, &cval);
if (status != calogOkE) {
calogValueFree(&ckey);
calogValueFree(&cval);
Tcl_DictObjDone(&search);
calogAggFree(aggregate);
return status;
}
}
Tcl_DictObjDone(&search);
calogValueAgg(out, aggregate);
return calogOkE;
}
if (type == gListType) {
CalogAggT *aggregate;
Tcl_Size count;
Tcl_Obj **elems;
Tcl_Size index;
int32_t status;
if (Tcl_ListObjGetElements(NULL, obj, &count, &elems) != TCL_OK) {
return calogErrArgE;
}
status = calogAggCreate(&aggregate, calogListE);
if (status != calogOkE) {
return status;
}
for (index = 0; index < count; index++) {
CalogValueT element;
status = tclToValue(context, elems[index], &element, depth + 1);
if (status != calogOkE) {
calogAggFree(aggregate);
return status;
}
status = calogAggPush(aggregate, &element);
if (status != calogOkE) {
calogValueFree(&element);
calogAggFree(aggregate);
return status;
}
}
calogValueAgg(out, aggregate);
return calogOkE;
}
if (type == gIntType) {
Tcl_WideInt wide;
Tcl_GetWideIntFromObj(NULL, obj, &wide);
calogValueInt(out, (int64_t)wide);
return calogOkE;
}
if (type == gDoubleType) {
double real;
Tcl_GetDoubleFromObj(NULL, obj, &real);
calogValueReal(out, real);
return calogOkE;
}
if (type == gByteArrayType) {
Tcl_Size length;
unsigned char *bytes;
bytes = Tcl_GetByteArrayFromObj(obj, &length);
return calogValueString(out, (const char *)bytes, (int64_t)length);
}
// String or no internal representation.
{
Tcl_Size length;
const char *bytes;
Tcl_WideInt wide;
double real;
bytes = Tcl_GetStringFromObj(obj, &length);
// A function-value command name marshals back OUT as a function value.
if (length >= 7 && memcmp(bytes, "calogFn", 7) == 0) {
Tcl_CmdInfo info;
if (Tcl_GetCommandInfo(context->interp, bytes, &info) && info.objProc == tclForeignCmd) {
calogFnRetain((CalogFnT *)info.objClientData);
calogValueFn(out, (CalogFnT *)info.objClientData);
return calogOkE;
}
}
// Tcl's own coercion: a pure integer/real string is a number.
if (Tcl_GetWideIntFromObj(NULL, obj, &wide) == TCL_OK) {
calogValueInt(out, (int64_t)wide);
return calogOkE;
}
if (Tcl_GetDoubleFromObj(NULL, obj, &real) == TCL_OK) {
calogValueReal(out, real);
return calogOkE;
}
return calogValueString(out, bytes, (int64_t)length);
}
}
static int tclTrampoline(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
CalogValueT *args;
CalogValueT result;
int32_t argc;
int32_t index;
int32_t status;
(void)cd;
context = tclOf(ip);
args = NULL;
argc = 0;
if (tclMarshalArgs(context, objc, objv, 1, &args, &argc) != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal a native argument", -1));
return TCL_ERROR;
}
status = calogCall(context->broker, Tcl_GetString(objv[0]), args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
return tclSetResult(context, ip, status, &result);
}
// The `unknown` handler: a command Tcl could not resolve -- objv[1] is its name, objv[2..] its
// arguments -- is looked up as a broker export and invoked; a miss becomes the standard error.
// Tcl is case-sensitive, so the match is exact (unlike my-basic). No receiver-method syntax exists
// in Tcl, so no top-level guard is needed (unlike Ruby's method_missing).
static int tclUnknownCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
const char *name;
CalogValueT nameArg;
CalogValueT resolved;
CalogValueT *args;
CalogValueT result;
int32_t argc;
int32_t index;
int32_t status;
(void)cd;
context = tclOf(ip);
if (objc < 2) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("unknown: missing command name", -1));
return TCL_ERROR;
}
name = Tcl_GetString(objv[1]);
calogValueNil(&resolved);
if (calogValueString(&nameArg, name, (int64_t)strlen(name)) == calogOkE) {
calogCall(context->broker, "__calogExportResolve", &nameArg, 1, &resolved);
calogValueFree(&nameArg);
}
if (resolved.type != calogFnE) {
calogValueFree(&resolved);
Tcl_SetObjResult(ip, Tcl_ObjPrintf("invalid command name \"%s\"", name));
return TCL_ERROR;
}
// It is an export: invoke with the remaining words. Keep the resolved reference across the
// invoke (guards a concurrent unexport), then release it before returning.
args = NULL;
argc = 0;
if (tclMarshalArgs(context, objc, objv, 2, &args, &argc) != calogOkE) {
calogValueFree(&resolved);
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal a native argument", -1));
return TCL_ERROR;
}
status = calogFnInvoke(resolved.as.fn, args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
calogValueFree(&resolved);
return tclSetResult(context, ip, status, &result);
}
static int32_t tclWrapCommand(CalogTclT *context, Tcl_Obj *prefix, CalogFnT **out) {
TclScriptT *holder;
int32_t status;
*out = NULL;
holder = (TclScriptT *)malloc(sizeof(*holder));
if (holder == NULL) {
return calogErrOomE;
}
holder->context = context;
holder->prefix = prefix;
Tcl_IncrRefCount(prefix);
status = calogFnCreate(out, context->broker, tclScriptInvoke, holder, tclScriptRelease, context->ctxId);
if (status != calogOkE) {
Tcl_DecrRefCount(prefix);
free(holder);
return status;
}
return calogOkE;
}
int32_t calogTclRun(CalogTclT *context, const char *source) {
int code;
code = Tcl_EvalEx(context->interp, source, -1, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
fprintf(stderr, "tcl error: %s\n", Tcl_GetString(Tcl_GetObjResult(context->interp)));
return calogErrArgE;
}
return calogOkE;
}

31
src/tcl/tclAdapter.h Normal file
View file

@ -0,0 +1,31 @@
// tclAdapter.h -- Tcl (Tool Command Language) engine adapter for the broker.
//
// Exposes broker-registered natives into a Tcl interpreter as commands routed through one
// trampoline (the command name is objv[0], the context is per-interp assoc data). Marshals values
// between Tcl_Obj and CalogValueT: int64 (Tcl_WideInt), double, list<->list, dict<->map, and
// BINARY-SAFE strings via byte-array objects. Tcl is "everything is a string", so egress recovers
// the canonical type from the Tcl_Obj internal representation (typePtr), coercing an untyped
// numeric string to int/real and otherwise treating it as a string; nil has no Tcl equivalent and
// round-trips to the empty string, and bool round-trips to 0/1 (documented EIAS losses).
//
// Callbacks both ways ride on commands: a foreign CalogFnT pushed IN becomes a command (carrying
// the CalogFnT as clientData, released by its delete proc) whose NAME is the value handed to the
// script (call it as `$fn a b`); a Tcl command prefix wrapped with `calogCallback` becomes a
// CalogFnT the same way, so it marshals back OUT as a function value (tclToValue recognizes such a
// command by its trampoline). Tcl file/socket IO is intentionally absent -- scripts use calog's
// fs*/net* natives; the adapter provides puts/print.
#ifndef TCL_ADAPTER_H
#define TCL_ADAPTER_H
#include "calogInternal.h"
typedef struct CalogTclT CalogTclT;
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId);
void calogTclDestroy(CalogTclT *context);
int32_t calogTclExport(CalogTclT *context, const char *name, CalogFnT **out);
int32_t calogTclExpose(CalogTclT *context, const char *name);
int32_t calogTclRun(CalogTclT *context, const char *source);
#endif

62
src/tcl/tclEngine.c Normal file
View file

@ -0,0 +1,62 @@
// tclEngine.c -- bridges the Tcl adapter to the actor layer's CalogEngineT vtable.
//
// Every hook runs on the owning context's thread (createInterpreter, runSource,
// destroyInterpreter), confining the Tcl interpreter to one thread -- which is exactly Tcl's
// apartment threading model (one Tcl_Interp per thread, no global lock). createInterpreter builds
// the interp and exposes the registered natives; runSource evaluates a script and reports failure
// through the single error channel (result).
#include "calogInternal.h"
#include "tclAdapter.h"
static int32_t tclEngineCreate(CalogContextT *context, void **interpOut);
static void tclEngineDestroy(void *interp);
static int32_t tclEngineRun(void *interp, const char *source, CalogValueT *result);
static void tclExposeVisitor(const CalogEntryT *entry, void *ud);
static const char *const tclExtensions[] = { "tcl", NULL };
const CalogEngineT calogTclEngine = {
"tcl",
tclExtensions,
tclEngineCreate,
tclEngineDestroy,
tclEngineRun
};
static int32_t tclEngineCreate(CalogContextT *context, void **interpOut) {
CalogTclT *tcl;
int32_t status;
*interpOut = NULL;
status = calogTclCreate(&tcl, calogContextBroker(context), calogContextId(context));
if (status != calogOkE) {
return status;
}
calogForEach(calogContextBroker(context), tclExposeVisitor, tcl);
*interpOut = tcl;
return calogOkE;
}
static void tclEngineDestroy(void *interp) {
calogTclDestroy((CalogTclT *)interp);
}
static int32_t tclEngineRun(void *interp, const char *source, CalogValueT *result) {
int32_t status;
calogValueNil(result);
status = calogTclRun((CalogTclT *)interp, source);
if (status != calogOkE) {
return calogFail(result, status, "tcl script failed");
}
return calogOkE;
}
static void tclExposeVisitor(const CalogEntryT *entry, void *ud) {
calogTclExpose((CalogTclT *)ud, entry->name);
}

402
tests/testEngineTcl.c Normal file
View file

@ -0,0 +1,402 @@
// testEngineTcl.c -- Tcl on a context thread, driven the host way: register natives, open a
// context, fire-and-forget a script, and calogPump on the host thread. Verifies host-thread
// dispatch, the inline escape hatch, the cross-thread callback, aggregates both ways (list/dict),
// a foreign function value, the error handler, and concurrent contexts (Tcl apartment threading).
#define _POSIX_C_SOURCE 200809L
#include "calog.h"
#include <stdatomic.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#define CHECK(cond, msg) checkImpl((cond), (msg), __FILE__, __LINE__)
#define PUMP_LIMIT 4000
static CalogT *calog = NULL;
static _Atomic int64_t reportedValue = 0;
static _Atomic uint64_t reportedCtxId = 0xFFFFu;
static _Atomic uint64_t inlineCtxId = 0xFFFFu;
static _Atomic int32_t bumpCount = 0;
static _Atomic bool scriptDone = false;
static _Atomic int32_t errorCount = 0;
static _Atomic uint64_t errorCtxId = 0;
static CalogFnT *_Atomic storedCb = NULL;
static char storedName[32] = { 0 };
static _Atomic int32_t nameLen = -1;
static int32_t testsRun = 0;
static int32_t testsFailed = 0;
static void checkImpl(bool condition, const char *message, const char *file, int32_t line);
static int32_t nativeAdd(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeBump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeDone(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeGetAdder(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeMakeUser(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeMapAge(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReport(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReportInline(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReportName(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeSetCb(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void onError(uint64_t contextId, const char *message, void *userData);
static void pumpUntilDone(void);
static void testConcurrentContexts(void);
static void testCrossThreadCallback(void);
static void testForeignFunction(void);
static void testHostAndInlineNatives(void);
static void testMapIngress(void);
static void testMaterializedRecord(void);
static void testScriptError(void);
static void checkImpl(bool condition, const char *message, const char *file, int32_t line) {
testsRun++;
if (!condition) {
testsFailed++;
printf("FAIL %s:%d %s\n", file, line, message);
}
}
static int32_t nativeAdd(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount != 2 || args[0].type != calogIntE || args[1].type != calogIntE) {
return calogFail(result, calogErrArgE, "add expects two integers");
}
calogValueInt(result, args[0].as.i + args[1].as.i);
return calogOkE;
}
static int32_t nativeBump(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
atomic_fetch_add(&bumpCount, 1);
calogValueNil(result);
return calogOkE;
}
static int32_t nativeDone(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
atomic_store(&scriptDone, true);
calogValueNil(result);
return calogOkE;
}
static int32_t nativeGetAdder(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
CalogFnT *callable;
int32_t status;
(void)args;
(void)argCount;
(void)userData;
calogValueNil(result);
status = calogFnFromNative(&callable, calog, nativeAdd, NULL);
if (status != calogOkE) {
return calogFail(result, status, "getAdder could not allocate");
}
calogValueFn(result, callable);
return calogOkE;
}
static int32_t nativeMakeUser(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
CalogAggT *user;
CalogValueT key;
CalogValueT val;
int32_t status;
(void)args;
(void)argCount;
(void)userData;
calogValueNil(result);
status = calogAggCreate(&user, calogMapE);
if (status != calogOkE) {
return calogFail(result, status, "makeUser could not allocate");
}
calogValueString(&key, "name", 4);
calogValueString(&val, "ada", 3);
calogAggSet(user, &key, &val);
calogValueString(&key, "age", 3);
calogValueInt(&val, 36);
calogAggSet(user, &key, &val);
calogValueAgg(result, user);
return calogOkE;
}
static int32_t nativeMapAge(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
CalogValueT key;
CalogValueT *found;
(void)userData;
calogValueNil(result);
if (argCount != 1 || args[0].type != calogAggE) {
return calogFail(result, calogErrArgE, "mapAge expects a map");
}
calogValueString(&key, "age", 3);
found = calogAggGet(args[0].as.agg, &key);
calogValueFree(&key);
if (found != NULL && found->type == calogIntE) {
atomic_store(&reportedValue, found->as.i);
}
return calogOkE;
}
static int32_t nativeReport(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount != 1 || args[0].type != calogIntE) {
return calogFail(result, calogErrArgE, "report expects one integer");
}
atomic_store(&reportedCtxId, calogCurrentId());
atomic_store(&reportedValue, args[0].as.i);
return calogOkE;
}
static int32_t nativeReportInline(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
atomic_store(&inlineCtxId, calogCurrentId());
calogValueNil(result);
return calogOkE;
}
static int32_t nativeReportName(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
size_t length;
(void)userData;
calogValueNil(result);
if (argCount != 1 || args[0].type != calogStringE) {
return calogFail(result, calogErrArgE, "reportName expects one string");
}
length = (size_t)args[0].as.s.length;
if (length >= sizeof(storedName)) {
length = sizeof(storedName) - 1;
}
memcpy(storedName, args[0].as.s.bytes, length);
storedName[length] = '\0';
atomic_store(&nameLen, (int32_t)length);
return calogOkE;
}
static int32_t nativeSetCb(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount != 1 || args[0].type != calogFnE) {
return calogFail(result, calogErrArgE, "setCb expects one function");
}
calogFnRetain(args[0].as.fn);
atomic_store(&storedCb, args[0].as.fn);
return calogOkE;
}
static void onError(uint64_t contextId, const char *message, void *userData) {
(void)message;
(void)userData;
atomic_store(&errorCtxId, contextId);
atomic_fetch_add(&errorCount, 1);
}
static void pumpUntilDone(void) {
struct timespec ts = { 0, 500000 };
int errorsBefore;
int i;
errorsBefore = atomic_load(&errorCount);
for (i = 0; i < PUMP_LIMIT; i++) {
calogPump(calog);
if (atomic_load(&scriptDone) || atomic_load(&errorCount) != errorsBefore) {
calogPump(calog);
return;
}
nanosleep(&ts, NULL);
}
}
static void testHostAndInlineNatives(void) {
CalogContextT *ctx;
ctx = calogContextOpen(calog, &calogTclEngine);
CHECK(ctx != NULL, "opened a Tcl context");
atomic_store(&scriptDone, false);
calogContextEval(ctx, "report 42\nreportInline 1\ndone");
pumpUntilDone();
CHECK(atomic_load(&reportedValue) == 42, "host native received the argument");
CHECK(atomic_load(&reportedCtxId) == 0, "default native ran on the host thread (id 0)");
CHECK(atomic_load(&inlineCtxId) == calogContextId(ctx), "inline native ran on the script's own thread");
calogContextClose(ctx);
}
static void testMaterializedRecord(void) {
CalogContextT *ctx;
ctx = calogContextOpen(calog, &calogTclEngine);
atomic_store(&scriptDone, false);
atomic_store(&nameLen, -1);
atomic_store(&reportedValue, 0);
calogContextEval(ctx, "set u [makeUser]\nreport [dict get $u age]\nreportName [dict get $u name]\ndone");
pumpUntilDone();
CHECK(atomic_load(&reportedValue) == 36, "read an int field from a materialized record dict");
CHECK(atomic_load(&nameLen) == 3 && memcmp(storedName, "ada", 3) == 0, "read a string field from a materialized record dict");
calogContextClose(ctx);
}
static void testMapIngress(void) {
CalogContextT *ctx;
ctx = calogContextOpen(calog, &calogTclEngine);
atomic_store(&scriptDone, false);
atomic_store(&reportedValue, 0);
// The script builds a dict (with a nested list, exercising list ingress too) and hands it
// to a native, which reads a field.
calogContextEval(ctx, "set m [dict create age 9 tags [list 1 2]]\nmapAge $m\ndone");
pumpUntilDone();
CHECK(atomic_load(&reportedValue) == 9, "native read a field from a dict the script built");
calogContextClose(ctx);
}
static void testForeignFunction(void) {
CalogContextT *ctx;
ctx = calogContextOpen(calog, &calogTclEngine);
atomic_store(&scriptDone, false);
atomic_store(&reportedValue, 0);
// getAdder returns a function value (a command name); the script calls it as `$adder 2 3`.
calogContextEval(ctx, "set adder [getAdder]\nreport [$adder 2 3]\ndone");
pumpUntilDone();
CHECK(atomic_load(&reportedValue) == 5, "script called a foreign function value pushed in from the host");
calogContextClose(ctx);
}
static void testCrossThreadCallback(void) {
CalogContextT *ctx;
CalogFnT *callback;
CalogValueT arg;
CalogValueT result;
int32_t status;
ctx = calogContextOpen(calog, &calogTclEngine);
atomic_store(&scriptDone, false);
atomic_store(&storedCb, NULL);
// A Tcl proc wrapped by calogCallback becomes a function value that marshals to a CalogFnT.
calogContextEval(ctx, "proc cb {x} { expr {$x + 100} }\nsetCb [calogCallback cb]\ndone");
pumpUntilDone();
callback = atomic_load(&storedCb);
CHECK(callback != NULL, "a Tcl callback was captured as a CalogFnT");
calogValueInt(&arg, 7);
status = calogFnInvoke(callback, &arg, 1, &result);
CHECK(status == calogOkE && result.type == calogIntE && result.as.i == 107, "cross-thread callable invoke routed to the owner");
calogValueFree(&result);
calogValueFree(&arg);
calogFnRelease(callback);
calogContextClose(ctx);
}
static void testScriptError(void) {
CalogContextT *ctx;
int32_t before;
ctx = calogContextOpen(calog, &calogTclEngine);
before = atomic_load(&errorCount);
atomic_store(&scriptDone, false);
calogContextEval(ctx, "error {intentional test error}");
pumpUntilDone();
CHECK(atomic_load(&errorCount) == before + 1, "a fire-and-forget script error reached the error handler");
CHECK(atomic_load(&errorCtxId) == calogContextId(ctx), "the error names the failing context");
calogContextClose(ctx);
}
static void testConcurrentContexts(void) {
CalogContextT *ctxs[3];
struct timespec ts = { 0, 500000 };
int32_t i;
atomic_store(&bumpCount, 0);
for (i = 0; i < 3; i++) {
ctxs[i] = calogContextOpen(calog, &calogTclEngine);
calogContextEval(ctxs[i], "bump\nbump\nbump");
}
for (i = 0; i < PUMP_LIMIT && atomic_load(&bumpCount) < 9; i++) {
calogPump(calog);
nanosleep(&ts, NULL);
}
CHECK(atomic_load(&bumpCount) == 9, "three concurrent Tcl contexts all dispatched to the host thread");
for (i = 0; i < 3; i++) {
calogContextClose(ctxs[i]);
}
}
int main(void) {
calog = calogCreate();
if (calog == NULL) {
printf("calog create failed\n");
return 1;
}
calogSetErrorHandler(calog, onError, NULL);
calogRegister(calog, "report", nativeReport, NULL);
calogRegister(calog, "setCb", nativeSetCb, NULL);
calogRegister(calog, "done", nativeDone, NULL);
calogRegister(calog, "bump", nativeBump, NULL);
calogRegister(calog, "makeUser", nativeMakeUser, NULL);
calogRegister(calog, "reportName", nativeReportName, NULL);
calogRegister(calog, "getAdder", nativeGetAdder, NULL);
calogRegister(calog, "mapAge", nativeMapAge, NULL);
calogRegisterInline(calog, "reportInline", nativeReportInline, NULL);
testHostAndInlineNatives();
testMaterializedRecord();
testMapIngress();
testForeignFunction();
testCrossThreadCallback();
testScriptError();
testConcurrentContexts();
calogDestroy(calog);
printf("\n%d checks, %d failed\n", testsRun, testsFailed);
fflush(stdout);
if (testsFailed != 0) {
return 1;
}
return 0;
}

105
vendor/tcl/.github/workflows/linux-build.yml vendored Normal file
View file

@ -0,0 +1,105 @@
name: Linux
on:
push:
branches:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
permissions:
contents: read
jobs:
plan:
runs-on: ubuntu-latest
outputs:
gcc: ${{ steps.matrix.outputs.gcc }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo gcc=$(jq -nc '{config: (if env.IsMatched == "true" then env.FULL else env.PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THESE MATRIX SPECS; IT AFFECTS OUR COST CONTROLS
FULL: >
[
"",
"CFLAGS=-DTCL_NO_DEPRECATED=1",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all",
"CFLAGS=-ftrapv",
"CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
]
PARTIAL: >
[
"",
"--enable-symbols=all",
"CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
]
gcc:
needs: plan
runs-on: ubuntu-24.04
strategy:
matrix: ${{ fromJson(needs.plan.outputs.gcc) }}
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v7
timeout-minutes: 5
- name: Install 32-bit dependencies if needed
# Duplicated from above
if: ${{ matrix.config == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }}
run: |
sudo apt-get update
sudo apt-get install gcc-multilib libc6-dev-i386
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
working-directory: generic
- name: Configure ${{ matrix.config }}
run: |
mkdir "${HOME}/install dir"
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: ${{ matrix.config }}
timeout-minutes: 5
- name: Build
run: |
make -j4 all
timeout-minutes: 5
- name: Build Test Harness
run: |
make -j4 tcltest
timeout-minutes: 5
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
timeout-minutes: 30
- name: Test-Drive Installation
run: |
make install
timeout-minutes: 5
- name: Create Distribution Package
if: ${{ matrix.config == '' }}
run: |
make dist
timeout-minutes: 5
- name: Convert Documentation to HTML
if: ${{ matrix.config == '' }}
run: |
make html-tcl
timeout-minutes: 5

106
vendor/tcl/.github/workflows/mac-build.yml vendored Normal file
View file

@ -0,0 +1,106 @@
name: macOS
on:
push:
branches:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
permissions:
contents: read
jobs:
plan:
runs-on: ubuntu-latest
outputs:
clang: ${{ steps.matrix.outputs.clang }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo clang=$(jq -nc '{config: (if env.IsMatched == "true" then env.FULL else env.PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THIS MATRIX SPEC; IT AFFECTS OUR COST CONTROLS
FULL: >
[
"",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all"
]
PARTIAL: >
[
"",
"--enable-symbols=all"
]
xcode:
runs-on: macos-15
defaults:
run:
shell: bash
working-directory: macosx
steps:
- name: Checkout
uses: actions/checkout@v7
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
working-directory: generic
- name: Build
run: make -j4 all
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Run Tests
run: make -j4 test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 15
clang:
runs-on: macos-15
needs: plan
strategy:
matrix: ${{ fromJson(needs.plan.outputs.clang) }}
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v7
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
mkdir "$HOME/install dir"
working-directory: generic
- name: Configure ${{ matrix.config }}
# Note that macOS is always a 64 bit platform
run: ./configure --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1)
env:
CFLAGS: -arch x86_64 -arch arm64
CFGOPT: ${{ matrix.config }}
timeout-minutes: 5
- name: Build
run: |
make -j4 all tcltest
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 20

243
vendor/tcl/.github/workflows/onefiledist.yml vendored Normal file
View file

@ -0,0 +1,243 @@
name: Build Binaries
on:
push:
branches:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
permissions:
contents: read
jobs:
linux:
name: Linux
runs-on: ubuntu-24.04
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v7
- name: Prepare
run: |
touch generic/tclStubInit.c generic/tclOOStubInit.c
mkdir 1dist
echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
working-directory: .
- name: Configure
run: ./configure --disable-symbols --disable-shared --enable-zipfs
working-directory: unix
- name: Build
run: |
make tclsh
make shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_snapshot
chmod +x tclsh${TCL_PATCHLEVEL}_snapshot
tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot
working-directory: 1dist
- name: Info
run: |
ulimit -a || echo 'get limit failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Upload
uses: actions/upload-artifact@v7
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot)
path: 1dist/*.tar
id: upload
outputs:
url: ${{ steps.upload.outputs.artifact-url }}
macos:
name: macOS
runs-on: macos-15-intel
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v7
- name: Checkout create-dmg
uses: actions/checkout@v7
with:
repository: create-dmg/create-dmg
ref: v1.2.2
path: create-dmg
- name: Prepare
run: |
mkdir 1dist
touch generic/tclStubInit.c generic/tclOOStubInit.c || true
wget https://github.com/culler/macher/releases/download/v1.8/macher
sudo cp macher /usr/local/bin
sudo chmod a+x /usr/local/bin/macher
echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV
echo "CFLAGS=-arch x86_64 -arch arm64" >> $GITHUB_ENV
- name: Configure
run: ./configure --disable-symbols --disable-shared --enable-zipfs
working-directory: unix
- name: Build
run: |
make -j4 tclsh
make -j4 shell SCRIPT="$VER_PATH $GITHUB_ENV"
echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: unix
- name: Package
run: |
mkdir contents
cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_snapshot
chmod +x contents/tclsh${TCL_PATCHLEVEL}_snapshot
cat > contents/README.txt <<EOF
This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL
It is not intended as an official release at all, so it is unsigned and unnotarized.
Use strictly at your own risk.
To run it, you need to copy the executable out and run:
xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_snapshot
to mark the executable as runnable on your machine.
EOF
$CREATE_DMG \
--volname "Tcl $TCL_PATCHLEVEL (snapshot)" \
--window-pos 200 120 \
--window-size 800 400 \
"Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \
"contents/"
working-directory: 1dist
- name: Info
run: |
ulimit -a || echo 'get limit failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Upload
uses: actions/upload-artifact@v7
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot)
path: 1dist/*.dmg
id: upload
outputs:
url: ${{ steps.upload.outputs.artifact-url }}
win:
name: Windows
runs-on: windows-2025
defaults:
run:
shell: msys2 {0}
timeout-minutes: 10
env:
CC: gcc
CFGOPT: --disable-symbols --disable-shared
steps:
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: UCRT64
install: git mingw-w64-ucrt-x86_64-toolchain make zip
- name: Checkout
uses: actions/checkout@v7
- name: Prepare
run: |
touch generic/tclStubInit.c generic/tclOOStubInit.c
echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
mkdir 1dist
working-directory: .
- name: Configure
run: ./configure $CFGOPT
working-directory: win
- name: Build
run: |
make binaries libraries
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
working-directory: win
- name: Get Exact Version
run: |
./tclsh*.exe $VER_PATH $GITHUB_ENV
working-directory: win
- name: Set Executable Name
run: |
cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe
working-directory: 1dist
- name: Info
run: |
ulimit -a || echo 'get limit failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Upload
uses: actions/upload-artifact@v7
with:
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot)
path: '1dist/*_snapshot.exe'
id: upload
outputs:
url: ${{ steps.upload.outputs.artifact-url }}
combine:
needs:
- linux
- macos
- win
name: Combine Artifacts (prototype)
runs-on: ubuntu-latest
defaults:
run:
shell: bash
timeout-minutes: 10
env:
# See also
# https://docs.github.com/en/actions/writing-workflows/choosing-what-your-workflow-does/store-information-in-variables
REMOTE_PATH: ${{ vars.PUBLISH_DROP_PATH }}/data-${{ github.sha }}
steps:
- name: Make directory
run: |
mkdir data
- name: Get Linux build
uses: actions/download-artifact@v8
with:
path: data
# Can't download by artifact ID; stupid missing feature!
merge-multiple: true
- name: Check data downloaded
run: |
ls -AlR
working-directory: data
- name: Transfer built files
# https://github.com/marketplace/actions/rsync-deployments-action
uses: burnett01/rsync-deployments@8.0.5
id: rsync
if: false # Disabled... for now
with:
# I don't know what the right switches are here, BTW
switches: -avzr
path: data/
remote_path: ${{ env.REMOTE_PATH }}
remote_host: ${{ vars.PUBLISH_HOST }}
remote_user: ${{ vars.PUBLISH_USER }}
remote_key: ${{ secrets.DEPLOY_HOST_KEY }}
# MUST be a literal passwordless key
- name: Publish files
# https://github.com/marketplace/actions/ssh-remote-commands
uses: appleboy/ssh-action@v1.2.5
id: ssh
if: steps.rsync.outcome == 'success'
with:
host: ${{ vars.PUBLISH_HOST }}
username: ${{ vars.PUBLISH_USER }}
key: ${{ secrets.DEPLOY_HOST_KEY }}
script: |
${{ vars.PUBLISHER_SCRIPT }} ${{ env.REMOTE_PATH }} ${{ github.ref_type }} ${{ github.ref_name }}
- name: Report what would be done
if: steps.rsync.outcome == 'skipped'
env:
SWITCHES: -av
LOCAL_PATH: data/
REMOTE_HOST: ${{ vars.PUBLISH_HOST }}
REMOTE_USER: ${{ vars.PUBLISH_USER }}
REMOTE_SCRIPT: |
${{ vars.PUBLISHER_SCRIPT }} ${{ env.REMOTE_PATH }} ${{ github.ref_type }} ${{ github.ref_name }}
run: |
echo "would run: rsync $SWITCHES $LOCAL_PATH $REMOTE_USER@$REMOTE_HOST:$REMOTE_PATH"
echo "would run: ssh $REMOTE_USER@$REMOTE_HOST $REMOTE_SCRIPT"
# Consider https://github.com/marketplace/actions/slack-notify maybe?

148
vendor/tcl/.github/workflows/win-build.yml vendored Normal file
View file

@ -0,0 +1,148 @@
name: Windows
on:
push:
branches:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
permissions:
contents: read
jobs:
plan:
runs-on: ubuntu-latest
outputs:
msvc: ${{ steps.matrix.outputs.msvc }}
gcc: ${{ steps.matrix.outputs.gcc }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo msvc=$(jq -nc '{config: (if env.IsMatched == "true" then env.MSVC_FULL else env.MSVC_PARTIAL end) | fromjson }' )
echo gcc=$(jq -nc '{config: (if env.IsMatched == "true" then env.GCC_FULL else env.GCC_PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THESE MATRIX SPECS; IT AFFECTS OUR COST CONTROLS
MSVC_FULL: >
[
"",
"CHECKS=nodep",
"OPTS=static",
"OPTS=noembed",
"OPTS=symbols",
"OPTS=symbols STATS=compdbg,memdbg"
]
MSVC_PARTIAL: >
[
"",
"OPTS=symbols STATS=compdbg,memdbg"
]
GCC_FULL: >
[
"",
"CFLAGS=-DTCL_NO_DEPRECATED=1",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all"
]
GCC_PARTIAL: >
[
"",
"--disable-shared",
"--enable-symbols=all"
]
msvc:
runs-on: windows-2025
needs: plan
defaults:
run:
shell: powershell
working-directory: win
strategy:
matrix: ${{ fromJson(needs.plan.outputs.msvc) }}
# Using powershell means we need to explicitly stop on failure
steps:
- name: Checkout
uses: actions/checkout@v7
timeout-minutes: 5
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
timeout-minutes: 5
- name: Build ${{ matrix.config }}
run: |
&nmake -f makefile.vc ${{ matrix.config }} all
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Build Test Harness ${{ matrix.config }}
run: |
&nmake -f makefile.vc ${{ matrix.config }} tcltest
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Run Tests ${{ matrix.config }}
run: |
&nmake -f makefile.vc ${{ matrix.config }} test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 30
env:
ERROR_ON_FAILURES: 1
gcc:
runs-on: windows-2025
needs: plan
defaults:
run:
shell: msys2 {0}
working-directory: win
strategy:
matrix: ${{ fromJson(needs.plan.outputs.gcc) }}
steps:
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: MINGW64
install: git mingw-w64-x86_64-toolchain make
timeout-minutes: 10
- name: Checkout
uses: actions/checkout@v7
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
mkdir "${HOME}/install dir"
working-directory: generic
- name: Configure ${{ matrix.config }}
run: |
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-64bit ${{ matrix.config }}
timeout-minutes: 5
- name: Build
run: make -j4 all
timeout-minutes: 5
- name: Build Test Harness
run: make -j4 tcltest
timeout-minutes: 5
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
- name: Run Tests
run: make test
timeout-minutes: 30
env:
ERROR_ON_FAILURES: 1
- name: Install
run: make install
timeout-minutes: 5
# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.

156
vendor/tcl/README.md vendored Normal file
View file

@ -0,0 +1,156 @@
# README: Tcl
This is the **Tcl 9.0.4** source distribution.
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).
9.1 (in development, daily build)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/win-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions/workflows/win-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/mac-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions/workflows/mac-build.yml?query=branch%3Amain)
<br>
9.0 (production release, daily build)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml/badge.svg?branch=core-9-0-branch)](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml?query=branch%3Acore-9-0-branch)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/win-build.yml/badge.svg?branch=core-9-0-branch)](https://github.com/tcltk/tcl/actions/workflows/win-build.yml?query=branch%3Acore-9-0-branch)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/mac-build.yml/badge.svg?branch=core-9-0-branch)](https://github.com/tcltk/tcl/actions/workflows/mac-build.yml?query=branch%3Acore-9-0-branch)
## Contents
1. [Introduction](#intro)
2. [Documentation](#doc)
3. [Compiling and installing Tcl](#build)
4. [Development tools](#devtools)
5. [Tcl newsgroup](#complangtcl)
6. [The Tcler's Wiki](#wiki)
7. [Mailing lists](#email)
8. [Support and Training](#support)
9. [Tracking Development](#watch)
10. [Thank You](#thanks)
## <a id="intro">1.</a> Introduction
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and macOS.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
take place at [core.tcl-lang.org](https://core.tcl-lang.org/).
Tcl/Tk release and mailing list services are [hosted by
SourceForge](https://sourceforge.net/projects/tcl/)
with the Tcl Developer Xchange hosted at
[www.tcl-lang.org](https://www.tcl-lang.org).
Tcl is a freely available open-source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part. See the file
`license.terms` for complete information.
## <a id="doc">2.</a> Documentation
Extensive documentation is available on our website.
The home page for this release, including new features, is
[here](https://www.tcl-lang.org/software/tcltk/9.0.html).
Detailed release notes can be found at the
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
by clicking on the relevant version.
Information about Tcl itself can be found at the [Developer
Xchange](https://www.tcl-lang.org/about/).
There have been many Tcl books on the market. Many are mentioned in
[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206).
The complete set of reference manual entries for Tcl 9.0 is [online,
here](https://www.tcl-lang.org/man/tcl9.0/).
### <a id="doc.unix">2a.</a> Unix Documentation
The `doc` subdirectory in this release contains a complete set of
reference manual entries for Tcl. Files with extension "`.1`" are for
programs (for example, `tclsh.1`); files with extension "`.3`" are for C
library procedures; and files with extension "`.n`" describe Tcl
commands. The file "`doc/Tcl.n`" gives a quick summary of the Tcl
language syntax. To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example
groff -man -Tpdf Tcl.n >output.pdf
to print Tcl.n to PDF. If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as
man Tcl
### <a id="doc.win">2b.</a> Windows Documentation
The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl. Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:
Start | Programs | Tcl | Tcl Help
## <a id="build">3.</a> Compiling and installing Tcl
There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms. There is additional information
about building Tcl from sources
[online](https://www.tcl-lang.org/doc/howto/compile.html).
## <a id="devtools">4.</a> Development tools
ActiveState produces a high-quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler, and
more. More information can be found at
https://www.activestate.com/products/tcl/
## <a id="complangtcl">5.</a> Tcl newsgroup
There is a USENET newsgroup, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)
covering all aspects of Tcl/Tk.
It is dedicated to the Tcl programming language and its extensions. A
wealth of useful information can be found there. It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications. You can also recommend
additional URLs by editing the wiki yourself.
## <a id="email">7.</a> Mailing lists
Several mailing lists are hosted at SourceForge to discuss development or use
issues (like Macintosh and Windows topics). For more information and to
subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the
Mailing Lists page.
## <a id="support">8.</a> Support and Training
We are very interested in receiving bug reports, patches, and suggestions for
improvements. We prefer that you send this information to us as tickets
entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist).
We will log and follow-up on each bug, although we cannot promise a
specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.
The Tcl community is too large for us to provide much individual support for
users. If you need help we suggest that you post questions to `comp.lang.tcl`
or ask a question on [Stack
Overflow](https://stackoverflow.com/questions/tagged/tcl). We read the
newsgroup and will attempt to answer esoteric questions for which no one else
is likely to know the answer. In addition, see the wiki for [links to other
organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training.
## <a id="watch">9.</a> Tracking Development
Tcl is developed in public. You can keep an eye on how Tcl is changing at
[core.tcl-lang.org](https://core.tcl-lang.org/).
## <a id="thanks">10.</a> Thank You
We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.

290
vendor/tcl/changes.md vendored Normal file
View file

@ -0,0 +1,290 @@
The source code for Tcl is managed by fossil. Tcl developers coordinate all
changes to the Tcl source code at
> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline)
Release Tcl 9.0.4 arises from the check-in with tag `core-9-0-4`.
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.
# Bug fixes
- [unsupported commands should not be available in safe interpreters](https://core.tcl-lang.org/tcl/tktview/82d12c)
- [Check for -municode doesn't work on WSL](https://core.tcl-lang.org/tcl/tktview/632710)
- [configure --enable-man-compression error](https://core.tcl-lang.org/tcl/tktview/886549)
- [nmake: rmdir and mkdir are picked from cygwin if available](https://core.tcl-lang.org/tcl/tktview/be40b7)
- [lseq: has incorrect results in edge cases](https://core.tcl-lang.org/tcl/tktview/999b69)
- [lseq: "count" error persists across calls](https://core.tcl-lang.org/tcl/tktview/8d1fc7)
- [lseq: Remove the ability to pass expressions as numeric values in the lseq command.](https://core.tcl-lang.org/tips/doc/trunk/tip/746.md)
- [Performance regression in expr in/ni operators](https://core.tcl-lang.org/tcl/info/8994c9)
- [Uninitialized memory access in setting script limits](https://core.tcl-lang.org/tcl/info/f7495f)
- [Crash when defining const if namespace does not exist](https://core.tcl-lang.org/tcl/info/4b22d8)
- [Glob errors with -directory option and patterns containing absolute paths (Windows)](https://core.tcl-lang.org/tcl/info/b0682c)
- [Glob errors with -directory option with trailing backslash (Windows)](https://core.tcl-lang.org/tcl/info/b0682c)
- [File normalization inconsistency for glob result (Windows)](https://core.tcl-lang.org/tcl/info/108904)
- [Avoid ClockClientData typedef redefinition](https://core.tcl-lang.org/tcl/info/4724f3)
- [Building sqlite3 for tcl8 redefines typedef](https://core.tcl-lang.org/tcl/info/ad08bc)
- [Inconsistent file join with volume-relative arguments](https://core.tcl-lang.org/tcl/info/1215dc)
- [mind PTHREAD_NULL as sentinel value vs legitimate pthread_t arg](https://core.tcl-lang.org/tcl/info/673f2d)
- [fileevent poor performance due to shimmering](https://core.tcl-lang.org/tcl/info/7da6c2)
# Updated bundled packages, libraries, standards, data
- autoconf 2.73
- http 2.10.2
- Itcl 4.3.8
- sqlite3 3.53.0
- tcltest 2.5.11
- Thread 3.0.6
- tzdata 2026b
- zlib 1.3.2
Release Tcl 9.0.3 arises from the check-in with tag `core-9-0-3`.
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.
# Bug fixes
- [On Unix, IsTimeNative() always defined but not always used](https://core.tcl-lang.org/tcl/tktview/6b8e39)
- [Tweak install permissions](https://core.tcl-lang.org/tcl/tktview/31d4fa)
- [interp creation resets encoding directory search path](https://core.tcl-lang.org/tcl/tktview/87b697)
- [Pointer arithmetic with NULL in buildInfoObjCmd()](https://core.tcl-lang.org/tcl/tktview/85fc8b)
- [TclPushVarName(): pointer overflow](https://core.tcl-lang.org/tcl/tktview/77059c)
- [Add IWYU export pragma annotations](https://core.tcl-lang.org/tcl/tktview/c7dc59)
- [Windows: Install man pages](https://core.tcl-lang.org/tcl/tktview/3161b7)
- [Windows: Install pkgconfig](https://core.tcl-lang.org/tcl/tktview/1cf49a)
- [Non-existent variables are ignored if re is {}](https://core.tcl-lang.org/tcl/tktview/cb03e5)
- [bug in single-argument 'max' with bignums](https://core.tcl-lang.org/tcl/tktview/8dd280)
- [Windows static builds: package require registry dde fails in child interpreters](https://core.tcl-lang.org/tcl/tktview/4f06d7)
- [Windows static builds: registry command is available in main interpreter without package require](https://core.tcl-lang.org/tcl/tktview/6094de)
# Updated bundled packages, libraries, standards, data
- Itcl 4.3.5
- http 2.10.1
- opt 0.4.10
- platform 1.1.0
- sqlite3 3.51.0
- tcltest 2.5.10
- Thread 3.0.4
- TDBC\* 1.1.13
- dde 1.4.6
- Unicode 17.0.0
Release Tcl 9.0.2 arises from the check-in with tag `core-9-0-2`.
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.
# New commands and options
- [New command encoding user](https://core.tcl-lang.org/tips/doc/trunk/tip/716.md)
- [New exec option -encoding](https://core.tcl-lang.org/tips/doc/trunk/tip/716.md)
# Bug fixes
- [Better error-message than "interpreter uses an incompatible stubs mechanism"](https://core.tcl-lang.org/tcl/tktview/fc3509)
- [\[$interp eval $lambda\] after \[eval $lambda\] or vice versa fails](https://core.tcl-lang.org/tcl/tktview/67d5f7)
- [tcl::mathfunc::isunordered inconsistency with some integer values](https://core.tcl-lang.org/tcl/tktview/98006f)
- [test lseq hangs with -Os](https://core.tcl-lang.org/tcl/tktview/d2a3c5)
- [exec does not handle app execution aliases on Windows](https://core.tcl-lang.org/tcl/tktview/4f0b57)
- [auto_execok does not find several built-in cmd commands](https://core.tcl-lang.org/tcl/tktview/4e2c8b)
- [Panic "Buffer Underflow, BUFFER_PADDING not enough"](https://core.tcl-lang.org/tcl/tktview/73bb42)
- [MS-VS build system: pckIndex.tcl when building for 9 misses "t" for TCL 8.6 part](https://core.tcl-lang.org/tcl/tktview/a77029)
- [clock format -locale does not look up locale children if parent locale used first](https://core.tcl-lang.org/tcl/tktview/2c0f49)
- [Missing libtcl?.?.dll.a in Cygwin](https://core.tcl-lang.org/tcl/tktview/dcedba)
- [tclEpollNotfy PlatformEventsControl panics if websocket disconnected](https://core.tcl-lang.org/tcl/tktview/010d8f)
- [Tcl_InitStubs compatibility for 9.1](https://core.tcl-lang.org/tcl/tktview/fd8341)
- [proc with more than 2**31 variables](https://core.tcl-lang.org/tcl/tktview/92aeb8)
- [scan "long mantissa" %g](https://core.tcl-lang.org/tcl/tktview/42d14c)
- ["encoding system": wrong result without manifest](https://core.tcl-lang.org/tcl/tktview/8ffd8c)
- [lseq crash on out-of-range index](https://core.tcl-lang.org/tcl/tktview/7d3101)
- [lseq crash on nested indices](https://core.tcl-lang.org/tcl/tktview/452b10)
- [Build broken (trunk branch) tclCompExpr.c tclOOCall.c](https://core.tcl-lang.org/tcl/tktview/1dcda0)
- [Memory allocation runaway on truncated iso2022 encoding](https://core.tcl-lang.org/tcl/tktview/7346ad)
- [Missing include dir for extensions in non-default locations](https://core.tcl-lang.org/tcl/tktview/333512)
- [tcl::tm::path doesn't handle tilde expand](https://core.tcl-lang.org/tcl/tktview/b87673)
- [lseq numeric overflow](https://core.tcl-lang.org/tcl/tktview/0ee626)
- ["return": broken ordering of nested -options](https://core.tcl-lang.org/tcl/tktview/ecf35c)
- [Euro/Tail-sign missing from cp864 encoding](https://core.tcl-lang.org/tcl/tktview/ecafd8)
- [use after free on TSD in Winsock](https://core.tcl-lang.org/tcl/tktview/40b181)
- [use after free on Windows pipe handles](https://core.tcl-lang.org/tcl/tktview/7c2716)
- [tcl::build-info not documented](https://core.tcl-lang.org/tcl/tktview/ef7042)
- [Fix 32 bit overflow in interp limit](https://core.tcl-lang.org/tcl/tktview/9dfae3)
# Incompatibilities
- [The ActiveCodePage element has been removed from the Windows executable manifest for tclsh](https://core.tcl-lang.org/tips/doc/trunk/tip/716.md)
# Updated bundled packages, libraries, standards, data
- Itcl 4.3.3
- sqlite3 3.49.1
- Thread 3.0.2
- TDBC\* 1.1.11
- tzdata 2025b
Release Tcl 9.0.1 arises from the check-in with tag `core-9-0-1`.
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase. As the first patch release in the Tcl 9.0.\* series,
Tcl 9.0.1 also includes a small number of interface changes that complete
some incomplete features first delivered in Tcl 9.0.0.
# Completed 9.0 Features and Interfaces
- [TIP 701 - Tcl_FSTildeExpand C API](https://core.tcl-lang.org/tips/doc/trunk/tip/701.md)
- [TIP 707 - ptrAndSize internal rep in Tcl_Obj](https://core.tcl-lang.org/tips/doc/trunk/tip/707.md)
- [Size modifiers j, q, z, t not implemented]( https://core.tcl-lang.org/tcl/info/c4f365)
# Bug fixes
- [regression in tzdata, %z instead of offset TZ-name](https://core.tcl-lang.org/tcl/tktview/2c237b)
- [Tcl will not start properly if there is an init.tcl file in the current dir](https://core.tcl-lang.org/tcl/tktview/43c94f)
- [clock scan "24:00", ISO-8601 compatibility](https://core.tcl-lang.org/tcl/tktview/aee9f2)
- [Temporary folder with file "tcl9registry13.dll" remains after "exit"](https://core.tcl-lang.org/tcl/tktview/6ce3c0)
- [Wrong result by "lsearch -stride -subindices -inline -all"](https://core.tcl-lang.org/tcl/info/5a1aaa)
- [TIP 609 - required Tcl_ThreadAlert() skipped with nested event loop](https://core.tcl-lang.org/tcl/info/c7e4c4)
- [buffer overwrite for non-BMP characters in utf-16](https://core.tcl-lang.org/tcl/tktview/66da4d)
- [zipfs info on mountpoint of executable returns zero offset in field 4"](https://core.tcl-lang.org/tcl/info/aaa84f)
- [zlib-8.8, zlib-8.16 fail on Fedora 40, gcc 14.1.1](https://core.tcl-lang.org/tcl/tktview/73d5cb)
- [install registry and dde in $INSTALL_DIR\lib always](https://core.tcl-lang.org/tcl/tktview/364bd9)
- [cannot build .chm help file (Windows)](https://core.tcl-lang.org/tcl/tktview/bb110c)
# Incompatibilities
- No known incompatibilities with the Tcl 9.0.0 public interface.
# Updated bundled packages, libraries, standards, data
- Itcl 4.3.2
- sqlite3 3.47.2
- Thread 3.0.1
- TDBC\* 1.1.10
- tcltest 2.5.9
- tzdata 2024b, corrected
Release Tcl 9.0.0 arises from the check-in with tag `core-9-0-0`.
Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below,
with focus on changes important to programmers using the Tcl library and
writing Tcl scripts.
# Major Features
## 64-bit capacity: Data values larger than 2Gb
- Strings can be any length (that fits in your available memory)
- Lists and dictionaries can have very large numbers of elements
## Internationalization of text
- Full Unicode range of codepoints
- New encodings: `utf-16`/`utf-32`/`ucs-2`(`le`|`be`), `CESU-8`, etc.
- `encoding` options `-profile`, `-failindex` manage encoding of I/O.
- `msgcat` supports custom locale search list
- `source` defaults to `-encoding utf-8`
## Zip filesystems and attached archives.
- Packaging of the Tcl script library with the Tcl binary library,
meaning that the `TCL_LIBRARY` environment variable is usually not required.
- Packaging of an application into a virtual filesystem is now a supported
core Tcl feature.
## Unix notifiers available using `epoll()` or `kqueue()`
- This relieves limits on file descriptors imposed by legacy `select()` and fixes a performance bottleneck.
# Incompatibilities
## Notable incompatibilities
- Unqualified varnames resolved in current namespace, not global.
Note that in almost all cases where this causes a change, the change is actually the removal of a latent bug.
- No `--disable-threads` build option. Always thread-enabled.
- I/O malencoding default response: raise error (`-profile strict`)
- Windows platform needs Windows 7 or Windows Server 2008 R2 or later
- Ended interpretation of `~` as home directory in pathnames.
(See `file home` and `file tildeexpand` for replacements when you need them.)
- Removed the `identity` encoding.
(There were only ever very few valid use cases for this; almost all uses
were systematically wrong.)
- Removed the encoding alias `binary` to `iso8859-1`.
- `$::tcl_precision` no longer controls string generation of doubles.
(If you need a particular precision, use `format`.)
- Removed pre-Tcl 8 legacies: `case`, `puts` and `read` variant syntaxes.
- Removed subcommands [`trace variable`|`vdelete`|`vinfo`]
- Removed `-eofchar` option for write channels.
- On Windows 10+ (Version 1903 or higher), system encoding is always utf-8.
- `%b`/`%d`/`%o`/`%x` format modifiers (without size modifier) for `format`
and `scan` always truncate to 32-bits on all platforms.
- `%L` size modifier for `scan` no longer truncates to 64-bit.
- Removed command `::tcl::unsupported::inject`.
(See `coroinject` and `coroprobe` for supported commands with significantly
more comprehensible semantics.)
## Incompatibilities in C public interface
- Extensions built against Tcl 8.6 and before will not work with Tcl 9.0;
ABI compatibility was a non-goal for 9.0. In _most_ cases, rebuilding
against Tcl 9.0 should work except when a removed API function is used.
- Many arguments expanded type from `int` to `Tcl_Size`, a signed integer type
large enough to support 64-bit sized memory objects.
The constant `TCL_AUTO_LENGTH` is a value of that type that indicates that
the length should be obtained using an appropriate function (typically `strlen()` for `char *` values).
- Ended support for `Tcl_ChannelTypeVersion` less than 5
- Introduced versioning of the `Tcl_ObjType` struct
- Removed macros `CONST*`: Tcl 9 support means dropping Tcl 8.3 support.
(Replaced with standard C `const` keyword going forward.)
- Removed registration of several `Tcl_ObjType`s.
- Removed API functions:
`Tcl_Backslash()`,
`Tcl_*VA()`,
`Tcl_*MathFunc*()`,
`Tcl_MakeSafe()`,
`Tcl_(Save|Restore|Discard|Free)Result()`,
`Tcl_EvalTokens()`,
`Tcl_(Get|Set)DefaultEncodingDir()`,
`Tcl_UniCharN(case)cmp()`,
`Tcl_UniCharCaseMatch()`
- Revised many internals; beware reliance on undocumented behaviors.
# New Features
## New commands
- `array default` — Specify default values for arrays (note that this alters the behaviour of `append`, `incr`, `lappend`).
- `array for` — Cheap iteration over an array's contents.
- `chan isbinary` — Test if a channel is configured to work with binary data.
- `coroinject`, `coroprobe` — Interact with paused coroutines.
- `clock add weekdays` — Clock arithmetic with week days.
- `const`, `info const*` — Commands for defining constants (variables that can't be modified).
- `dict getwithdefault` — Define a fallback value to use when `dict get` would otherwise fail.
- `file home` — Get the user home directory.
- `file tempdir` — Create a temporary directory.
- `file tildeexpand` — Expand a file path containing a `~`.
- `info commandtype` — Introspection for the kinds of commands.
- `ledit` — Equivalent to `lreplace` but on a list in a variable.
- `lpop` — Remove an item from a list in a variable.
- `lremove` — Remove a sublist from a list in a variable.
- `lseq` — Generate a list of numbers in a sequence.
- `package files` — Describe the contents of a package.
- `string insert` — Insert a string as a substring of another string.
- `string is dict` — Test whether a string is a dictionary.
- `tcl::process` — Commands for working with subprocesses.
- `*::build-info` — Obtain information about the build of Tcl.
- `readFile`, `writeFile`, `foreachLine` — Simple procedures for basic working with files.
- `tcl::idna::*` — Commands for working with encoded DNS names.
## New command options
- `chan configure ... -inputmode ...` — Support for raw terminal input and reading passwords.
- `clock scan ... -validate ...`
- `info loaded ... ?prefix?`
- `lsearch ... -stride ...` — Search a list by groups of items.
- `regsub ... -command ...` — Generate the replacement for a regular expression by calling a command.
- `socket ... -nodelay ... -keepalive ...`
- `vwait` controlled by several new options
- `expr` string comparators `lt`, `gt`, `le`, `ge`
- `expr` supports comments inside expressions
## Numbers
- <code>0<i>NNN</i></code> format is no longer octal interpretation. Use <code>0o<i>NNN</i></code>.
- <code>0d<i>NNNN</i></code> format to compel decimal interpretation.
- <code>NN_NNN_NNN</code>, underscores in numbers for optional readability
- Functions: `isinf()`, `isnan()`, `isnormal()`, `issubnormal()`, `isunordered()`
- Command: `fpclassify`
- Function `int()` no longer truncates to word size
## TclOO facilities
- private variables and methods
- class variables and methods
- abstract and singleton classes
- configurable properties
- `method -export`, `method -unexport`

6
vendor/tcl/compat/README vendored Normal file
View file

@ -0,0 +1,6 @@
This directory contains various header and code files that are
used make Tcl compatible with various releases of UNIX and UNIX-like
systems. Typically, files from this directory are used to compile
Tcl when a system doesn't contain the corresponding files or when
they are known to be incorrect. When the whole world becomes POSIX-
compliant this directory should be unnecessary.

58
vendor/tcl/compat/dlfcn.h vendored Normal file
View file

@ -0,0 +1,58 @@
/*
* dlfcn.h --
*
* This file provides a replacement for the header file "dlfcn.h"
* on systems where dlfcn.h is missing. It's primary use is for
* AIX, where Tcl emulates the dl library.
*
* This file is subject to the following copyright notice, which is
* different from the notice used elsewhere in Tcl but rougly
* equivalent in meaning.
*
* Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
* Not derived from licensed software.
*
* Permission is granted to freely use, copy, modify, and redistribute
* this software, provided that the author is not construed to be liable
* for any results of using the software, alterations are clearly marked
* as such, and this notice is not modified.
*/
/*
* This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
* 30159 Hannover, Germany
*/
#ifndef __dlfcn_h__
#define __dlfcn_h__
#ifdef __cplusplus
extern "C" {
#endif
/*
* Mode flags for the dlopen routine.
*/
#define RTLD_LAZY 1 /* lazy function call binding */
#define RTLD_NOW 2 /* immediate function call binding */
#define RTLD_GLOBAL 0x100 /* allow symbols to be global */
/*
* To be able to intialize, a library may provide a dl_info structure
* that contains functions to be called to initialize and terminate.
*/
struct dl_info {
void (*init) (void);
void (*fini) (void);
};
void *dlopen (const char *path, int mode);
void *dlsym (void *handle, const char *symbol);
char *dlerror (void);
int dlclose (void *handle);
#ifdef __cplusplus
}
#endif
#endif /* __dlfcn_h__ */

267
vendor/tcl/compat/fake-rfc2553.c vendored Normal file
View file

@ -0,0 +1,267 @@
/*
* Copyright (C) 2000-2003 Damien Miller. All rights reserved.
* Copyright (C) 1999 WIDE Project. 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 project nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
/*
* Pseudo-implementation of RFC2553 name / address resolution functions
*
* But these functions are not implemented correctly. The minimum subset
* is implemented for ssh use only. For example, this routine assumes
* that ai_family is AF_INET. Don't use it for another purpose.
*/
#include "tclInt.h"
TCL_DECLARE_MUTEX(netdbMutex)
#ifndef HAVE_GETNAMEINFO
#ifndef HAVE_STRLCPY
static size_t
strlcpy(char *dst, const char *src, size_t siz)
{
char *d = dst;
const char *s = src;
size_t n = siz;
/* Copy as many bytes as will fit */
if (n != 0 && --n != 0) {
do {
if ((*d++ = *s++) == 0)
break;
} while (--n != 0);
}
/* Not enough room in dst, add NUL and traverse rest of src */
if (n == 0) {
if (siz != 0)
*d = '\0'; /* NUL-terminate dst */
while (*s++)
;
}
return(s - src - 1); /* count does not include NUL */
}
#endif
int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
size_t hostlen, char *serv, size_t servlen, int flags)
{
struct sockaddr_in *sin = (struct sockaddr_in *)sa;
struct hostent *hp;
char tmpserv[16];
(void)salen;
if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET)
return (EAI_FAMILY);
if (serv != NULL) {
snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port));
if (strlcpy(serv, tmpserv, servlen) >= servlen)
return (EAI_MEMORY);
}
if (host != NULL) {
if (flags & NI_NUMERICHOST) {
size_t len;
Tcl_MutexLock(&netdbMutex);
len = strlcpy(host, inet_ntoa(sin->sin_addr), hostlen);
Tcl_MutexUnlock(&netdbMutex);
if (len >= hostlen) {
return (EAI_MEMORY);
} else {
return (0);
}
} else {
int ret;
Tcl_MutexLock(&netdbMutex);
hp = gethostbyaddr((char *)&sin->sin_addr,
sizeof(struct in_addr), AF_INET);
if (hp == NULL) {
ret = EAI_NODATA;
} else if (strlcpy(host, hp->h_name, hostlen)
>= hostlen) {
ret = EAI_MEMORY;
} else {
ret = 0;
}
Tcl_MutexUnlock(&netdbMutex);
return ret;
}
}
return (0);
}
#endif /* !HAVE_GETNAMEINFO */
#ifndef HAVE_GAI_STRERROR
const char *
fake_gai_strerror(int err)
{
switch (err) {
case EAI_NODATA:
return ("no address associated with name");
case EAI_MEMORY:
return ("memory allocation failure.");
case EAI_NONAME:
return ("nodename nor servname provided, or not known");
case EAI_FAMILY:
return ("ai_family not supported");
default:
return ("unknown/invalid error.");
}
}
#endif /* !HAVE_GAI_STRERROR */
#ifndef HAVE_FREEADDRINFO
void
fake_freeaddrinfo(struct addrinfo *ai)
{
struct addrinfo *next;
for(; ai != NULL;) {
next = ai->ai_next;
free(ai);
ai = next;
}
}
#endif /* !HAVE_FREEADDRINFO */
#ifndef HAVE_GETADDRINFO
static struct
addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
{
struct addrinfo *ai;
ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in));
if (ai == NULL)
return (NULL);
memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in));
ai->ai_addr = (struct sockaddr *)(ai + 1);
/* XXX -- ssh doesn't use sa_len */
ai->ai_addrlen = sizeof(struct sockaddr_in);
ai->ai_addr->sa_family = ai->ai_family = AF_INET;
((struct sockaddr_in *)(ai)->ai_addr)->sin_port = port;
((struct sockaddr_in *)(ai)->ai_addr)->sin_addr.s_addr = addr;
/* XXX: the following is not generally correct, but does what we want */
if (hints->ai_socktype)
ai->ai_socktype = hints->ai_socktype;
else
ai->ai_socktype = SOCK_STREAM;
if (hints->ai_protocol)
ai->ai_protocol = hints->ai_protocol;
return (ai);
}
int
fake_getaddrinfo(const char *hostname, const char *servname,
const struct addrinfo *hints, struct addrinfo **res)
{
struct hostent *hp;
struct servent *sp;
struct in_addr in;
int i;
long int port;
u_long addr;
port = 0;
if (hints && hints->ai_family != AF_UNSPEC &&
hints->ai_family != AF_INET)
return (EAI_FAMILY);
if (servname != NULL) {
char *cp;
port = strtol(servname, &cp, 10);
if (port > 0 && port <= 65535 && *cp == '\0')
port = htons((unsigned short)port);
else if ((sp = getservbyname(servname, NULL)) != NULL)
port = sp->s_port;
else
port = 0;
}
if (hints && hints->ai_flags & AI_PASSIVE) {
addr = htonl(0x00000000);
if (hostname && inet_aton(hostname, &in) != 0)
addr = in.s_addr;
*res = malloc_ai(port, addr, hints);
if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
if (!hostname) {
*res = malloc_ai(port, htonl(0x7F000001), hints);
if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
if (inet_aton(hostname, &in)) {
*res = malloc_ai(port, in.s_addr, hints);
if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
/* Don't try DNS if AI_NUMERICHOST is set */
if (hints && hints->ai_flags & AI_NUMERICHOST)
return (EAI_NONAME);
Tcl_MutexLock(&netdbMutex);
hp = gethostbyname(hostname);
if (hp && hp->h_name && hp->h_name[0] && hp->h_addr_list[0]) {
struct addrinfo *cur, *prev;
cur = prev = *res = NULL;
for (i = 0; hp->h_addr_list[i]; i++) {
struct in_addr *in = (struct in_addr *)hp->h_addr_list[i];
cur = malloc_ai(port, in->s_addr, hints);
if (cur == NULL) {
if (*res != NULL)
freeaddrinfo(*res);
Tcl_MutexUnlock(&netdbMutex);
return (EAI_MEMORY);
}
if (prev)
prev->ai_next = cur;
else
*res = cur;
prev = cur;
}
Tcl_MutexUnlock(&netdbMutex);
return (0);
}
Tcl_MutexUnlock(&netdbMutex);
return (EAI_NODATA);
}
#endif /* !HAVE_GETADDRINFO */

170
vendor/tcl/compat/fake-rfc2553.h vendored Normal file
View file

@ -0,0 +1,170 @@
/*
* Copyright (C) 2000-2003 Damien Miller. All rights reserved.
* Copyright (C) 1999 WIDE Project. 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 project nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
/*
* Pseudo-implementation of RFC2553 name / address resolution functions
*
* But these functions are not implemented correctly. The minimum subset
* is implemented for ssh use only. For example, this routine assumes
* that ai_family is AF_INET. Don't use it for another purpose.
*/
#ifndef _FAKE_RFC2553_H
#define _FAKE_RFC2553_H
/*
* First, socket and INET6 related definitions
*/
#ifndef HAVE_STRUCT_SOCKADDR_STORAGE
# define _SS_MAXSIZE 128 /* Implementation specific max size */
# define _SS_PADSIZE (_SS_MAXSIZE - sizeof (struct sockaddr))
struct sockaddr_storage {
struct sockaddr ss_sa;
char __ss_pad2[_SS_PADSIZE];
};
# define ss_family ss_sa.sa_family
#endif /* !HAVE_STRUCT_SOCKADDR_STORAGE */
#ifndef IN6_IS_ADDR_LOOPBACK
# define IN6_IS_ADDR_LOOPBACK(a) \
(((uint32_t *)(a))[0] == 0 && ((uint32_t *)(a))[1] == 0 && \
((uint32_t *)(a))[2] == 0 && ((uint32_t *)(a))[3] == htonl(1))
#endif /* !IN6_IS_ADDR_LOOPBACK */
#ifndef HAVE_STRUCT_IN6_ADDR
struct in6_addr {
uint8_t s6_addr[16];
};
#endif /* !HAVE_STRUCT_IN6_ADDR */
#ifndef HAVE_STRUCT_SOCKADDR_IN6
struct sockaddr_in6 {
unsigned short sin6_family;
uint16_t sin6_port;
uint32_t sin6_flowinfo;
struct in6_addr sin6_addr;
uint32_t sin6_scope_id;
};
#endif /* !HAVE_STRUCT_SOCKADDR_IN6 */
#ifndef AF_INET6
/* Define it to something that should never appear */
#define AF_INET6 AF_MAX
#endif
/*
* Next, RFC2553 name / address resolution API
*/
#ifndef NI_NUMERICHOST
# define NI_NUMERICHOST (1)
#endif
#ifndef NI_NAMEREQD
# define NI_NAMEREQD (1<<1)
#endif
#ifndef NI_NUMERICSERV
# define NI_NUMERICSERV (1<<2)
#endif
#ifndef AI_PASSIVE
# define AI_PASSIVE (1)
#endif
#ifndef AI_CANONNAME
# define AI_CANONNAME (1<<1)
#endif
#ifndef AI_NUMERICHOST
# define AI_NUMERICHOST (1<<2)
#endif
#ifndef NI_MAXSERV
# define NI_MAXSERV 32
#endif /* !NI_MAXSERV */
#ifndef NI_MAXHOST
# define NI_MAXHOST 1025
#endif /* !NI_MAXHOST */
#ifndef EAI_NODATA
# define EAI_NODATA (INT_MAX - 1)
#endif
#ifndef EAI_MEMORY
# define EAI_MEMORY (INT_MAX - 2)
#endif
#ifndef EAI_NONAME
# define EAI_NONAME (INT_MAX - 3)
#endif
#ifndef EAI_SYSTEM
# define EAI_SYSTEM (INT_MAX - 4)
#endif
#ifndef EAI_FAMILY
# define EAI_FAMILY (INT_MAX - 5)
#endif
#ifndef EAI_SERVICE
# define EAI_SERVICE -8 /* SERVICE not supported for `ai_socktype'. */
#endif
#ifndef HAVE_STRUCT_ADDRINFO
struct addrinfo {
int ai_flags; /* AI_PASSIVE, AI_CANONNAME */
int ai_family; /* PF_xxx */
int ai_socktype; /* SOCK_xxx */
int ai_protocol; /* 0 or IPPROTO_xxx for IPv4 and IPv6 */
size_t ai_addrlen; /* length of ai_addr */
char *ai_canonname; /* canonical name for hostname */
struct sockaddr *ai_addr; /* binary address */
struct addrinfo *ai_next; /* next structure in linked list */
};
#endif /* !HAVE_STRUCT_ADDRINFO */
#ifndef HAVE_GETADDRINFO
#ifdef getaddrinfo
# undef getaddrinfo
#endif
#define getaddrinfo(a,b,c,d) (fake_getaddrinfo(a,b,c,d))
int getaddrinfo(const char *, const char *,
const struct addrinfo *, struct addrinfo **);
#endif /* !HAVE_GETADDRINFO */
#ifndef HAVE_GAI_STRERROR
#define gai_strerror(a) (fake_gai_strerror(a))
const char *gai_strerror(int);
#endif /* !HAVE_GAI_STRERROR */
#ifndef HAVE_FREEADDRINFO
#define freeaddrinfo(a) (fake_freeaddrinfo(a))
void freeaddrinfo(struct addrinfo *);
#endif /* !HAVE_FREEADDRINFO */
#ifndef HAVE_GETNAMEINFO
#define getnameinfo(a,b,c,d,e,f,g) (fake_getnameinfo(a,b,c,d,e,f,g))
int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
char *, size_t, int);
#endif /* !HAVE_GETNAMEINFO */
#endif /* !_FAKE_RFC2553_H */

31
vendor/tcl/compat/gettod.c vendored Normal file
View file

@ -0,0 +1,31 @@
/*
* gettod.c --
*
* This file provides the gettimeofday function on systems
* that only have the System V ftime function.
*
* Copyright (c) 1995 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
#include <sys/timeb.h>
#undef timezone
int
gettimeofday(
struct timeval *tp,
struct timezone *tz)
{
struct timeb t;
(void)tz;
ftime(&t);
tp->tv_sec = t.time;
tp->tv_usec = t.millitm * 1000;
return 0;
}

40
vendor/tcl/compat/license.terms vendored Normal file
View file

@ -0,0 +1,40 @@
This software is copyrighted by the Regents of the University of
California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
Corporation and other parties. The following terms apply to all files
associated with the software unless explicitly disclaimed in
individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.
IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.
GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7014 (b) (3) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.

79
vendor/tcl/compat/mkstemp.c vendored Normal file
View file

@ -0,0 +1,79 @@
/*
* mkstemp.c --
*
* Source code for the "mkstemp" library routine.
*
* Copyright (c) 2009 Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include <errno.h>
#include <fcntl.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
/*
*----------------------------------------------------------------------
*
* mkstemp --
*
* Create an open temporary file from a template.
*
* Results:
* A file descriptor, or -1 (with errno set) in the case of an error.
*
* Side effects:
* The template is updated to contain the real filename.
*
*----------------------------------------------------------------------
*/
int
mkstemp(
char *tmpl) /* Template for filename. */
{
static const char alphanumerics[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
char *a, *b;
int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */
a = tmpl + strlen(tmpl);
while (a > tmpl && *(a-1) == 'X') {
a--;
}
if (a == tmpl) {
errno = ENOENT;
return -1;
}
/*
* We'll only try up to 10 times; after that, we're suffering from enemy
* action and should let the caller know.
*/
count = 10;
do {
/*
* Replace the X's in the original template with random alphanumeric
* digits.
*/
for (b=a ; *b ; b++) {
float r = rand() / ((float) RAND_MAX);
*b = alphanumerics[(int)(r * alphanumericsLen)];
}
/*
* Template is now realized; try to open (with correct options).
*/
fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600);
} while (fd == -1 && errno == EEXIST && --count > 0);
return fd;
}

136
vendor/tcl/compat/strncasecmp.c vendored Normal file
View file

@ -0,0 +1,136 @@
/*
* strncasecmp.c --
*
* Source code for the "strncasecmp" library routine.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
/*
* This array is designed for mapping upper and lower case letter together for
* a case independent comparison. The mappings are based upon ASCII character
* sequences.
*/
static const unsigned char charmap[] = {
0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f,
0x40, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
0x78, 0x79, 0x7a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f,
0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f,
0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f,
0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f,
0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7,
0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf,
0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7,
0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf,
0xc0, 0xe1, 0xe2, 0xe3, 0xe4, 0xc5, 0xe6, 0xe7,
0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
0xf8, 0xf9, 0xfa, 0xdb, 0xdc, 0xdd, 0xde, 0xdf,
0xe0, 0xe1, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7,
0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff,
};
/*
* Here are the prototypes just in case they are not included in tclPort.h.
*/
int strncasecmp(const char *s1, const char *s2, size_t n);
int strcasecmp(const char *s1, const char *s2);
/*
*----------------------------------------------------------------------
*
* strcasecmp --
*
* Compares two strings, ignoring case differences.
*
* Results:
* Compares two null-terminated strings s1 and s2, returning -1, 0, or 1
* if s1 is lexicographically less than, equal to, or greater than s2.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
strcasecmp(
const char *s1, /* First string. */
const char *s2) /* Second string. */
{
unsigned char u1, u2;
for ( ; ; s1++, s2++) {
u1 = (unsigned char) *s1;
u2 = (unsigned char) *s2;
if ((u1 == '\0') || (charmap[u1] != charmap[u2])) {
break;
}
}
return charmap[u1] - charmap[u2];
}
/*
*----------------------------------------------------------------------
*
* strncasecmp --
*
* Compares two strings, ignoring case differences.
*
* Results:
* Compares up to length chars of s1 and s2, returning -1, 0, or 1 if s1
* is lexicographically less than, equal to, or greater than s2 over
* those characters.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
strncasecmp(
const char *s1, /* First string. */
const char *s2, /* Second string. */
size_t length) /* Maximum number of characters to compare
* (stop earlier if the end of either string
* is reached). */
{
unsigned char u1, u2;
for (; length != 0; length--, s1++, s2++) {
u1 = (unsigned char) *s1;
u2 = (unsigned char) *s2;
if (charmap[u1] != charmap[u2]) {
return charmap[u1] - charmap[u2];
}
if (u1 == '\0') {
return 0;
}
}
return 0;
}

172
vendor/tcl/compat/waitpid.c vendored Normal file
View file

@ -0,0 +1,172 @@
/*
* waitpid.c --
*
* This procedure emulates the POSIX waitpid kernel call on BSD systems
* that don't have waitpid but do have wait3. This code is based on a
* prototype version written by Mark Diekhans and Karl Lehenbauer.
*
* Copyright (c) 1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
#ifndef pid_t
#define pid_t int
#endif
/*
* A linked list of the following structures is used to keep track of
* processes for which we received notification from the kernel, but the
* application hasn't waited for them yet (this can happen because wait may
* not return the process we really want). We save the information here until
* the application finally does wait for the process.
*/
typedef struct WaitInfo {
pid_t pid; /* Pid of process that exited. */
WAIT_STATUS_TYPE status; /* Status returned when child exited or
* suspended. */
struct WaitInfo *nextPtr; /* Next in list of exited processes. */
} WaitInfo;
static WaitInfo *deadList = NULL;
/* First in list of all dead processes. */
/*
*----------------------------------------------------------------------
*
* waitpid --
*
* This procedure emulates the functionality of the POSIX waitpid kernel
* call, using the BSD wait3 kernel call. Note: it doesn't emulate
* absolutely all of the waitpid functionality, in that it doesn't
* support pid's of 0 or < -1.
*
* Results:
* -1 is returned if there is an error in the wait kernel call. Otherwise
* the pid of an exited or suspended process is returned and *statusPtr
* is set to the status value of the process.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifdef waitpid
# undef waitpid
#endif
pid_t
waitpid(
pid_t pid, /* The pid to wait on. Must be -1 or greater
* than zero. */
int *statusPtr, /* Where to store wait status for the
* process. */
int options) /* OR'ed combination of WNOHANG and
* WUNTRACED. */
{
WaitInfo *waitPtr, *prevPtr;
pid_t result;
WAIT_STATUS_TYPE status;
if ((pid < -1) || (pid == 0)) {
errno = EINVAL;
return -1;
}
/*
* See if there's a suitable process that has already stopped or exited.
* If so, remove it from the list of exited processes and return its
* information.
*/
for (waitPtr = deadList, prevPtr = NULL; waitPtr != NULL;
prevPtr = waitPtr, waitPtr = waitPtr->nextPtr) {
if ((pid != waitPtr->pid) && (pid != -1)) {
continue;
}
if (!(options & WUNTRACED) && (WIFSTOPPED(waitPtr->status))) {
continue;
}
result = waitPtr->pid;
*statusPtr = *((int *) &waitPtr->status);
if (prevPtr == NULL) {
deadList = waitPtr->nextPtr;
} else {
prevPtr->nextPtr = waitPtr->nextPtr;
}
Tcl_Free(waitPtr);
return result;
}
/*
* Wait for any process to stop or exit. If it's an acceptable one then
* return it to the caller; otherwise store information about it in the
* list of exited processes and try again. On systems that have only wait
* but not wait3, there are several situations we can't handle, but we do
* the best we can (e.g. can still handle some combinations of options by
* invoking wait instead of wait3).
*/
while (1) {
#if NO_WAIT3
if (options & WNOHANG) {
return 0;
}
if (options != 0) {
errno = EINVAL;
return -1;
}
result = wait(&status);
#else
result = wait3(&status, options, 0);
#endif
if ((result == -1) && (errno == EINTR)) {
continue;
}
if (result <= 0) {
return result;
}
if ((pid != result) && (pid != -1)) {
goto saveInfo;
}
if (!(options & WUNTRACED) && (WIFSTOPPED(status))) {
goto saveInfo;
}
*statusPtr = *((int *) &status);
return result;
/*
* Can't return this info to caller. Save it in the list of stopped or
* exited processes. Tricky point: first check for an existing entry
* for the process and overwrite it if it exists (e.g. a previously
* stopped process might now be dead).
*/
saveInfo:
for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
if (waitPtr->pid == result) {
waitPtr->status = status;
goto waitAgain;
}
}
waitPtr = (WaitInfo *) Tcl_AttemptAlloc(sizeof(WaitInfo));
if (!waitPtr) {
errno = ENOMEM;
return -1;
}
waitPtr->pid = result;
waitPtr->status = status;
waitPtr->nextPtr = deadList;
deadList = waitPtr;
waitAgain:
continue;
}
}

134
vendor/tcl/compat/zlib/BUILD.bazel vendored Normal file
View file

@ -0,0 +1,134 @@
# Copied from https://github.com/bazelbuild/bazel-central-registry/tree/main/modules/zlib/1.3.1.bcr.4/patches
# Adapted from https://github.com/protocolbuffers/protobuf/blob/master/third_party/zlib.BUILD
# Copyright 2008 Google Inc. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# * Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above
# copyright notice, this list of conditions and the following disclaimer
# in the documentation and/or other materials provided with the
# distribution.
# * Neither the name of Google Inc. nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# Code generated by the Protocol Buffer compiler is owned by the owner
# of the input file used when generating it. This code is not
# standalone and requires a support library to be linked with it. This
# support library is itself covered by the above license.
load("@rules_cc//cc:defs.bzl", "cc_library")
load("@rules_license//rules:license.bzl", "license")
package(
default_applicable_licenses = [":license"],
)
license(
name = "license",
license_kinds = ["@rules_license//licenses/spdx:Zlib"],
license_text = "LICENSE",
)
exports_files([
"LICENSE",
])
_ZLIB_HEADERS = [
"crc32.h",
"deflate.h",
"gzguts.h",
"inffast.h",
"inffixed.h",
"inflate.h",
"inftrees.h",
"trees.h",
"zconf.h",
"zlib.h",
"zutil.h",
]
_ZLIB_PREFIXED_HEADERS = ["zlib/include/" + hdr for hdr in _ZLIB_HEADERS]
# In order to limit the damage from the `includes` propagation
# via `:zlib`, copy the public headers to a subdirectory and
# expose those.
genrule(
name = "copy_public_headers",
srcs = _ZLIB_HEADERS,
outs = _ZLIB_PREFIXED_HEADERS,
cmd_bash = "cp $(SRCS) $(@D)/zlib/include/",
cmd_bat = " && ".join(
["@copy /Y \"$(location %s)\" \"$(@D)\\zlib\\include\\\" >NUL" %
s for s in _ZLIB_HEADERS],
),
)
config_setting(
name = "mingw_gcc_compiler",
flag_values = {
"@bazel_tools//tools/cpp:compiler": "mingw-gcc",
},
visibility = [":__subpackages__"],
)
cc_library(
name = "z",
srcs = [
"adler32.c",
"compress.c",
"crc32.c",
"deflate.c",
"gzclose.c",
"gzlib.c",
"gzread.c",
"gzwrite.c",
"infback.c",
"inffast.c",
"inflate.c",
"inftrees.c",
"trees.c",
"uncompr.c",
"zutil.c",
# Include the un-prefixed headers in srcs to work
# around the fact that zlib isn't consistent in its
# choice of <> or "" delimiter when including itself.
] + _ZLIB_HEADERS,
hdrs = _ZLIB_PREFIXED_HEADERS,
copts = select({
":mingw_gcc_compiler": [
"-fpermissive",
],
"@platforms//os:windows": [],
"//conditions:default": [
"-Wno-deprecated-non-prototype",
"-Wno-unused-variable",
"-Wno-implicit-function-declaration",
],
}),
includes = ["zlib/include/"],
visibility = ["//visibility:public"],
)
alias(
name = "zlib",
actual = ":z",
visibility = ["//visibility:public"],
)

310
vendor/tcl/compat/zlib/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,310 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
zlib
LANGUAGES C
VERSION 1.3.2
HOMEPAGE_URL "https://zlib.net/"
DESCRIPTION "a general-purpose lossless data-compression library")
# ============================================================================
# CPack
# ============================================================================
set(CPACK_PACKAGE_VENDOR "zlib-Project")
set(CPACK_PACKAGE_DESCRIPTION_FILE ${zlib_SOURCE_DIR}/README)
set(CPACK_RESOURCE_FILE_LICENSE ${zlib_SOURCE_DIR}/LICENSE)
set(CPACK_RESOURCE_FILE_README ${zlib_SOURCE_DIR}/README)
# ============================================================================
# configuration
# ============================================================================
option(ZLIB_BUILD_TESTING "Enable Zlib Examples as tests" ON)
option(ZLIB_BUILD_SHARED "Enable building zlib shared library" ON)
option(ZLIB_BUILD_STATIC "Enable building zlib static library" ON)
option(ZLIB_INSTALL "Enable installation of zlib" ON)
option(ZLIB_PREFIX "prefix for all types and library functions, see zconf.h.in"
OFF)
mark_as_advanced(ZLIB_PREFIX)
get_property(IS_MULTI GLOBAL PROPERTY GENERATOR_IS_MULTI_CONFIG)
if(NOT DEFINED CMAKE_BUILD_TYPE AND NOT IS_MULTI)
message(STATUS "No CMAKE_BUILD_TYPE set -- using Release")
set(CMAKE_BUILD_TYPE Release)
endif(NOT DEFINED CMAKE_BUILD_TYPE AND NOT IS_MULTI)
include(CheckCSourceCompiles)
include(CheckFunctionExists)
include(CheckIncludeFile)
include(CMakePackageConfigHelpers)
include(CheckTypeSize)
include(CPack)
include(GNUInstallDirs)
set(CPACK_INCLUDED TRUE)
if(NOT ZLIB_CONF_WRITTEN)
set(Z_PREFIX ${ZLIB_PREFIX})
set(CONF_OUT_FILE ${zlib_BINARY_DIR}/zconf.h.cmakein)
file(READ ${zlib_SOURCE_DIR}/zconf.h ZCONF_CONTENT LIMIT 245)
file(WRITE ${CONF_OUT_FILE} ${ZCONF_CONTENT})
file(APPEND ${CONF_OUT_FILE} "#cmakedefine Z_PREFIX 1\n")
file(APPEND ${CONF_OUT_FILE} "#cmakedefine HAVE_STDARG_H 1\n")
file(APPEND ${CONF_OUT_FILE} "#cmakedefine HAVE_UNISTD_H 1\n")
file(READ ${zlib_SOURCE_DIR}/zconf.h ZCONF_CONTENT OFFSET 244)
set(FIRST_ITEM TRUE)
foreach(item IN LISTS ZCONF_CONTENT)
if(FIRST_ITEM)
string(APPEND OUT_CONTENT ${item})
set(FIRST_ITEM FALSE)
else(FIRST_ITEM)
string(APPEND OUT_CONTENT "\;" ${item})
endif(FIRST_ITEM)
endforeach(item IN LISTS ${ZCONF_CONTENT})
file(APPEND ${CONF_OUT_FILE} ${OUT_CONTENT})
set(ZLIB_CONF_WRITTEN
TRUE
CACHE BOOL "zconf.h.cmakein was created")
mark_as_advanced(ZLIB_CONF_WRITTEN)
endif(NOT ZLIB_CONF_WRITTEN)
#
# Check to see if we have large file support
#
set(CMAKE_REQUIRED_DEFINITIONS -D_LARGEFILE64_SOURCE=1)
check_type_size(off64_t OFF64_T)
unset(CMAKE_REQUIRED_DEFINITIONS) # clear variable
#
# Check for fseeko
#
check_function_exists(fseeko HAVE_FSEEKO)
#
# Check for stdarg.h
#
check_include_file(stdarg.h HAVE_STDARG_H)
#
# Check for unistd.h
#
check_include_file(unistd.h HAVE_UNISTD_H)
#
# Check visibility attribute is supported
#
if(MSVC)
set(CMAKE_REQUIRED_FLAGS "-WX")
else(MSVC)
set(CMAKE_REQUIRED_FLAGS "-Werror")
endif(MSVC)
check_c_source_compiles(
"
#include <stdlib.h>
static void f(void) __attribute__ ((visibility(\"hidden\")));
int main(void) {return 0;}
"
HAVE___ATTR__VIS_HIDDEN)
unset(CMAKE_COMPILE_FLAGS)
set(ZLIB_PC ${zlib_BINARY_DIR}/zlib.pc)
configure_file(${zlib_SOURCE_DIR}/zlib.pc.cmakein ${ZLIB_PC} @ONLY)
configure_file(${zlib_BINARY_DIR}/zconf.h.cmakein ${zlib_BINARY_DIR}/zconf.h)
# ============================================================================
# zlib
# ============================================================================
set(ZLIB_PUBLIC_HDRS ${zlib_BINARY_DIR}/zconf.h zlib.h)
set(ZLIB_PRIVATE_HDRS
crc32.h
deflate.h
gzguts.h
inffast.h
inffixed.h
inflate.h
inftrees.h
trees.h
zutil.h)
set(ZLIB_SRCS
adler32.c
compress.c
crc32.c
deflate.c
gzclose.c
gzlib.c
gzread.c
gzwrite.c
inflate.c
infback.c
inftrees.c
inffast.c
trees.c
uncompr.c
zutil.c)
if(WIN32)
set(zlib_static_suffix "s")
set(CMAKE_DEBUG_POSTFIX "d")
endif(WIN32)
if(ZLIB_BUILD_SHARED)
add_library(
zlib SHARED ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}
$<$<OR:$<BOOL:${WIN32}>,$<BOOL:${CYGWIN}>>:win32/zlib1.rc>)
add_library(ZLIB::ZLIB ALIAS zlib)
target_include_directories(
zlib
PUBLIC $<BUILD_INTERFACE:${zlib_BINARY_DIR}>
$<BUILD_INTERFACE:${zlib_SOURCE_DIR}>
$<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}>)
target_compile_definitions(
zlib
PRIVATE ZLIB_BUILD
$<$<BOOL:NOT:${HAVE_FSEEKO}>:NO_FSEEKO>
$<$<BOOL:${HAVE___ATTR__VIS_HIDDEN}>:HAVE_HIDDEN>
$<$<BOOL:${MSVC}>:_CRT_SECURE_NO_DEPRECATE>
$<$<BOOL:${MSVC}>:_CRT_NONSTDC_NO_DEPRECATE>
PUBLIC $<$<BOOL:${HAVE_OFF64_T}>:_LARGEFILE64_SOURCE=1>)
set(INSTALL_VERSION ${zlib_VERSION})
if(NOT CYGWIN)
set_target_properties(zlib PROPERTIES SOVERSION ${zlib_VERSION_MAJOR}
VERSION ${INSTALL_VERSION})
endif(NOT CYGWIN)
set_target_properties(
zlib
PROPERTIES DEFINE_SYMBOL ZLIB_DLL
EXPORT_NAME ZLIB
OUTPUT_NAME z)
if(UNIX
AND NOT APPLE
AND NOT (CMAKE_SYSTEM_NAME STREQUAL AIX)
AND NOT (CMAKE_SYSTEM_NAME STREQUAL SunOS))
# On unix-like platforms the library is almost always called libz
set_target_properties(
zlib
PROPERTIES LINK_FLAGS
"-Wl,--version-script,\"${zlib_SOURCE_DIR}/zlib.map\"")
endif(
UNIX
AND NOT APPLE
AND NOT (CMAKE_SYSTEM_NAME STREQUAL AIX)
AND NOT (CMAKE_SYSTEM_NAME STREQUAL SunOS))
endif(ZLIB_BUILD_SHARED)
if(ZLIB_BUILD_STATIC)
add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS}
${ZLIB_PRIVATE_HDRS})
add_library(ZLIB::ZLIBSTATIC ALIAS zlibstatic)
target_include_directories(
zlibstatic
PUBLIC $<BUILD_INTERFACE:${zlib_BINARY_DIR}>
$<BUILD_INTERFACE:${zlib_SOURCE_DIR}>
$<INSTALL_INTERFACE:${CMAKE_INSTALL_INCLUDEDIR}>)
target_compile_definitions(
zlibstatic
PRIVATE ZLIB_BUILD
$<$<BOOL:NOT:${HAVE_FSEEKO}>:NO_FSEEKO>
$<$<BOOL:${HAVE___ATTR__VIS_HIDDEN}>:HAVE_HIDDEN>
$<$<BOOL:${MSVC}>:_CRT_SECURE_NO_DEPRECATE>
$<$<BOOL:${MSVC}>:_CRT_NONSTDC_NO_DEPRECATE>
PUBLIC $<$<BOOL:${HAVE_OFF64_T}>:_LARGEFILE64_SOURCE=1>)
set_target_properties(
zlibstatic PROPERTIES EXPORT_NAME ZLIBSTATIC OUTPUT_NAME
z${zlib_static_suffix})
endif(ZLIB_BUILD_STATIC)
if(ZLIB_INSTALL)
if(ZLIB_BUILD_SHARED)
install(
TARGETS zlib
COMPONENT Runtime
EXPORT zlibSharedExport
RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}"
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}"
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}")
install(
EXPORT zlibSharedExport
FILE ZLIB-shared.cmake
NAMESPACE ZLIB::
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/zlib)
if(MSVC)
install(
FILES $<TARGET_PDB_FILE:zlib>
COMPONENT Runtime
DESTINATION ${CMAKE_INSTALL_BINDIR}
CONFIGURATIONS Debug OR RelWithDebInfo
OPTIONAL)
endif(MSVC)
endif(ZLIB_BUILD_SHARED)
if(ZLIB_BUILD_STATIC)
install(
TARGETS zlibstatic
COMPONENT Development
EXPORT zlibStaticExport
RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}"
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}"
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}")
install(
EXPORT zlibStaticExport
FILE ZLIB-static.cmake
NAMESPACE ZLIB::
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/zlib)
endif(ZLIB_BUILD_STATIC)
configure_package_config_file(
${zlib_SOURCE_DIR}/zlibConfig.cmake.in
${zlib_BINARY_DIR}/ZLIBConfig.cmake
INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/zlib)
write_basic_package_version_file(
"${zlib_BINARY_DIR}/ZLIBConfigVersion.cmake"
VERSION "${zlib_VERSION}"
COMPATIBILITY AnyNewerVersion)
install(FILES ${zlib_BINARY_DIR}/ZLIBConfig.cmake
${zlib_BINARY_DIR}/ZLIBConfigVersion.cmake
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/zlib)
install(
FILES ${ZLIB_PUBLIC_HDRS}
COMPONENT Development
DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}")
install(
FILES zlib.3
COMPONENT Docs
DESTINATION "${CMAKE_INSTALL_MANDIR}/man3")
install(
FILES LICENSE
doc/algorithm.txt
doc/crc-doc.1.0.pdf
doc/rfc1950.txt
doc/rfc1951.txt
doc/rfc1952.txt
doc/txtvsbin.txt
COMPONENT Docs
DESTINATION "${CMAKE_INSTALL_DOCDIR}/zlib")
install(
FILES ${ZLIB_PC}
COMPONENT Development
DESTINATION "${CMAKE_INSTALL_LIBDIR}/pkgconfig")
endif(ZLIB_INSTALL)
# ============================================================================
# Tests
# ============================================================================
if(ZLIB_BUILD_TESTING)
enable_testing()
add_subdirectory(test)
endif(ZLIB_BUILD_TESTING)
add_subdirectory(contrib)

1669
vendor/tcl/compat/zlib/ChangeLog vendored Normal file
View file

File diff suppressed because it is too large Load diff

371
vendor/tcl/compat/zlib/FAQ vendored Normal file
View file

@ -0,0 +1,371 @@
Frequently Asked Questions about zlib
If your question is not there, please check the zlib home page
https://zlib.net/ which may have more recent information.
The latest zlib FAQ is at https://zlib.net/zlib_faq.html
1. Is zlib Y2K-compliant?
Yes. zlib doesn't handle dates.
2. Where can I get a Windows DLL version?
The zlib sources can be compiled without change to produce a DLL. See the
file win32/DLL_FAQ.txt in the zlib distribution.
3. Where can I get a Visual Basic interface to zlib?
See
* https://zlib.net/nelson/
* win32/DLL_FAQ.txt in the zlib distribution
4. compress() returns Z_BUF_ERROR.
Make sure that before the call of compress(), the length of the compressed
buffer is equal to the available size of the compressed buffer and not
zero. For Visual Basic, check that this parameter is passed by reference
("as any"), not by value ("as long").
5. deflate() or inflate() returns Z_BUF_ERROR.
Before making the call, make sure that avail_in and avail_out are not zero.
When setting the parameter flush equal to Z_FINISH, also make sure that
avail_out is big enough to allow processing all pending input. Note that a
Z_BUF_ERROR is not fatal--another call to deflate() or inflate() can be
made with more input or output space. A Z_BUF_ERROR may in fact be
unavoidable depending on how the functions are used, since it is not
possible to tell whether or not there is more output pending when
strm.avail_out returns with zero. See https://zlib.net/zlib_how.html for a
heavily annotated example.
6. Where's the zlib documentation (man pages, etc.)?
It's in zlib.h . Examples of zlib usage are in the files test/example.c
and test/minigzip.c, with more in examples/ .
7. Why don't you use GNU autoconf or libtool or ...?
Because we would like to keep zlib as a very small and simple package.
zlib is rather portable and doesn't need much configuration.
8. I found a bug in zlib.
Most of the time, such problems are due to an incorrect usage of zlib.
Please try to reproduce the problem with a small program and send the
corresponding source to us at zlib@gzip.org . Do not send multi-megabyte
data files without prior agreement.
9. Why do I get "undefined reference to gzputc"?
If "make test" produces something like
example.o(.text+0x154): undefined reference to `gzputc'
check that you don't have old files libz.* in /usr/lib, /usr/local/lib or
/usr/X11R6/lib. Remove any old versions, then do "make install".
10. I need a Delphi interface to zlib.
See the contrib/delphi directory in the zlib distribution.
11. Can zlib handle .zip archives?
Not by itself, no. See the directory contrib/minizip in the zlib
distribution.
12. Can zlib handle .Z files?
No, sorry. You have to spawn an uncompress or gunzip subprocess, or adapt
the code of uncompress on your own.
13. How can I make a Unix shared library?
By default a shared (and a static) library is built for Unix. So:
make distclean
./configure
make
14. How do I install a shared zlib library on Unix?
After the above, then:
make install
However, many flavors of Unix come with a shared zlib already installed.
Before going to the trouble of compiling a shared version of zlib and
trying to install it, you may want to check if it's already there! If you
can #include <zlib.h>, it's there. The -lz option will probably link to
it. You can check the version at the top of zlib.h or with the
ZLIB_VERSION symbol defined in zlib.h .
15. I have a question about OttoPDF.
We are not the authors of OttoPDF. The real author is on the OttoPDF web
site: Joel Hainley, jhainley@myndkryme.com.
16. Can zlib decode Flate data in an Adobe PDF file?
Yes. See https://www.pdflib.com/ . To modify PDF forms, see
https://sourceforge.net/projects/acroformtool/ .
17. Why am I getting this "register_frame_info not found" error on Solaris?
After installing zlib 1.1.4 on Solaris 2.6, running applications using zlib
generates an error such as:
ld.so.1: rpm: fatal: relocation error: file /usr/local/lib/libz.so:
symbol __register_frame_info: referenced symbol not found
The symbol __register_frame_info is not part of zlib, it is generated by
the C compiler (cc or gcc). You must recompile applications using zlib
which have this problem. This problem is specific to Solaris. See
http://www.sunfreeware.com for Solaris versions of zlib and applications
using zlib.
18. Why does gzip give an error on a file I make with compress/deflate?
The compress and deflate functions produce data in the zlib format, which
is different and incompatible with the gzip format. The gz* functions in
zlib on the other hand use the gzip format. Both the zlib and gzip formats
use the same compressed data format internally, but have different headers
and trailers around the compressed data.
19. Ok, so why are there two different formats?
The gzip format was designed to retain the directory information about a
single file, such as the name and last modification date. The zlib format
on the other hand was designed for in-memory and communication channel
applications, and has a much more compact header and trailer and uses a
faster integrity check than gzip.
20. Well that's nice, but how do I make a gzip file in memory?
You can request that deflate write the gzip format instead of the zlib
format using deflateInit2(). You can also request that inflate decode the
gzip format using inflateInit2(). Read zlib.h for more details.
21. Is zlib thread-safe?
Yes. However any library routines that zlib uses and any application-
provided memory allocation routines must also be thread-safe. zlib's gz*
functions use stdio library routines, and most of zlib's functions use the
library memory allocation routines by default. zlib's *Init* functions
allow for the application to provide custom memory allocation routines.
If the non-default BUILDFIXED or DYNAMIC_CRC_TABLE defines are used on a
system without atomics (e.g. pre-C11), then inflate() and crc32() will not
be thread safe.
Of course, you should only operate on any given zlib or gzip stream from a
single thread at a time.
22. Can I use zlib in my commercial application?
Yes. Please read the license in zlib.h.
23. Is zlib under the GNU license?
No. Please read the license in zlib.h.
24. The license says that altered source versions must be "plainly marked". So
what exactly do I need to do to meet that requirement?
You need to change the ZLIB_VERSION and ZLIB_VERNUM #defines in zlib.h. In
particular, the final version number needs to be changed to "f", and an
identification string should be appended to ZLIB_VERSION. Version numbers
x.x.x.f are reserved for modifications to zlib by others than the zlib
maintainers. For example, if the version of the base zlib you are altering
is "1.2.3.4", then in zlib.h you should change ZLIB_VERNUM to 0x123f, and
ZLIB_VERSION to something like "1.2.3.f-zachary-mods-v3". You can also
update the version strings in deflate.c and inftrees.c.
For altered source distributions, you should also note the origin and
nature of the changes in zlib.h, as well as in ChangeLog and README, along
with the dates of the alterations. The origin should include at least your
name (or your company's name), and an email address to contact for help or
issues with the library.
Note that distributing a compiled zlib library along with zlib.h and
zconf.h is also a source distribution, and so you should change
ZLIB_VERSION and ZLIB_VERNUM and note the origin and nature of the changes
in zlib.h as you would for a full source distribution.
25. Will zlib work on a big-endian or little-endian architecture, and can I
exchange compressed data between them?
Yes and yes.
26. Will zlib work on a 64-bit machine?
Yes. It has been tested on 64-bit machines, and has no dependence on any
data types being limited to 32-bits in length. If you have any
difficulties, please provide a complete problem report to zlib@gzip.org
27. Will zlib decompress data from the PKWare Data Compression Library?
No. The PKWare DCL uses a completely different compressed data format than
does PKZIP and zlib. However, you can look in zlib's contrib/blast
directory for a possible solution to your problem.
28. Can I access data randomly in a compressed stream?
No, not without some preparation. If when compressing you periodically use
Z_FULL_FLUSH, carefully write all the pending data at those points, and
keep an index of those locations, then you can start decompression at those
points. You have to be careful to not use Z_FULL_FLUSH too often, since it
can significantly degrade compression. Alternatively, you can scan a
deflate stream once to generate an index, and then use that index for
random access. See examples/zran.c .
29. Does zlib work on MVS, OS/390, CICS, etc.?
It has in the past, but we have not heard of any recent evidence. There
were working ports of zlib 1.1.4 to MVS, but those links no longer work.
If you know of recent, successful applications of zlib on these operating
systems, please let us know. Thanks.
30. Is there some simpler, easier to read version of inflate I can look at to
understand the deflate format?
First off, you should read RFC 1951. Second, yes. Look in zlib's
contrib/puff directory.
31. Does zlib infringe on any patents?
As far as we know, no. In fact, that was originally the whole point behind
zlib. Look here for some more information:
https://web.archive.org/web/20180729212847/http://www.gzip.org/#faq11
32. Can zlib work with greater than 4 GB of data?
Yes. inflate() and deflate() will process any amount of data correctly.
Each call of inflate() or deflate() is limited to input and output chunks
of the maximum value that can be stored in the compiler's "unsigned int"
type, but there is no limit to the number of chunks. Note however that the
strm.total_in and strm_total_out counters may be limited to 4 GB. These
counters are provided as a convenience and are not used internally by
inflate() or deflate(). The application can easily set up its own counters
updated after each call of inflate() or deflate() to count beyond 4 GB.
compress() and uncompress() may be limited to 4 GB, since they operate in a
single call. gzseek() and gztell() may be limited to 4 GB depending on how
zlib is compiled. See the zlibCompileFlags() function in zlib.h.
The word "may" appears several times above since there is a 4 GB limit only
if the compiler's "long" type is 32 bits. If the compiler's "long" type is
64 bits, then the limit is 16 exabytes.
33. Does zlib have any security vulnerabilities?
The only one that we are aware of is potentially in gzprintf(). If zlib is
compiled to use sprintf() or vsprintf(), which requires that ZLIB_INSECURE
be defined, then there is no protection against a buffer overflow of an 8K
string space (or other value as set by gzbuffer()), other than the caller
of gzprintf() assuring that the output will not exceed 8K. On the other
hand, if zlib is compiled to use snprintf() or vsnprintf(), which should
normally be the case, then there is no vulnerability. The ./configure
script will display warnings if an insecure variation of sprintf() will be
used by gzprintf(). Also the zlibCompileFlags() function will return
information on what variant of sprintf() is used by gzprintf().
If you don't have snprintf() or vsnprintf() and would like one, you can
find a good portable implementation in stb_sprintf.h here:
https://github.com/nothings/stb
Note that you should be using the most recent version of zlib. Versions
1.1.3 and before were subject to a double-free vulnerability, and versions
1.2.1 and 1.2.2 were subject to an access exception when decompressing
invalid compressed data.
34. Is there a Java version of zlib?
Probably what you want is to use zlib in Java. zlib is already included
as part of the Java SDK in the java.util.zip package. If you really want
a version of zlib written in the Java language, look on the zlib home
page for links: https://zlib.net/ .
35. I get this or that compiler or source-code scanner warning when I crank it
up to maximally-pedantic. Can't you guys write proper code?
Many years ago, we gave up attempting to avoid warnings on every compiler
in the universe. It just got to be a waste of time, and some compilers
were downright silly as well as contradicted each other. So now, we simply
make sure that the code always works.
36. Valgrind (or some similar memory access checker) says that deflate is
performing a conditional jump that depends on an uninitialized value.
Isn't that a bug?
No. That is intentional for performance reasons, and the output of deflate
is not affected. This only started showing up recently since zlib 1.2.x
uses malloc() by default for allocations, whereas earlier versions used
calloc(), which zeros out the allocated memory. Even though the code was
correct, versions 1.2.4 and later was changed to not stimulate these
checkers.
37. Will zlib read the (insert any ancient or arcane format here) compressed
data format?
Probably not. Look in the comp.compression FAQ for pointers to various
formats and associated software.
38. How can I encrypt/decrypt zip files with zlib?
zlib doesn't support encryption. The original PKZIP encryption is very
weak and can be broken with freely available programs. To get strong
encryption, use GnuPG, https://www.gnupg.org/ , which already includes zlib
compression. For PKZIP compatible "encryption", look at
https://infozip.sourceforge.net/
39. What's the difference between the "gzip" and "deflate" HTTP 1.1 encodings?
"gzip" is the gzip format, and "deflate" is the zlib format. They should
probably have called the second one "zlib" instead to avoid confusion with
the raw deflate compressed data format. While the HTTP 1.1 RFC 2616
correctly points to the zlib specification in RFC 1950 for the "deflate"
transfer encoding, there have been reports of servers and browsers that
incorrectly produce or expect raw deflate data per the deflate
specification in RFC 1951, most notably Microsoft. So even though the
"deflate" transfer encoding using the zlib format would be the more
efficient approach (and in fact exactly what the zlib format was designed
for), using the "gzip" transfer encoding is probably more reliable due to
an unfortunate choice of name on the part of the HTTP 1.1 authors.
Bottom line: use the gzip format for HTTP 1.1 encoding.
40. Does zlib support the new "Deflate64" format introduced by PKWare?
No. PKWare has apparently decided to keep that format proprietary, since
they have not documented it as they have previous compression formats. In
any case, the compression improvements are so modest compared to other more
modern approaches, that it's not worth the effort to implement.
41. I'm having a problem with the zip functions in zlib, can you help?
There are no zip functions in zlib. You are probably using minizip by
Giles Vollant, which is found in the contrib directory of zlib. It is not
part of zlib. In fact none of the stuff in contrib is part of zlib. The
files in there are not supported by the zlib authors. You need to contact
the authors of the respective contribution for help.
42. The match.asm code in contrib is under the GNU General Public License.
Since it's part of zlib, doesn't that mean that all of zlib falls under the
GNU GPL?
No. The files in contrib are not part of zlib. They were contributed by
other authors and are provided as a convenience to the user within the zlib
distribution. Each item in contrib has its own license.
43. Is zlib subject to export controls? What is its ECCN?
zlib is not subject to export controls, and so is classified as EAR99.
44. Can you please sign these lengthy legal documents and fax them back to us
so that we can use your software in our product?
No. Go away. Shoo.

67
vendor/tcl/compat/zlib/INDEX vendored Normal file
View file

@ -0,0 +1,67 @@
CMakeLists.txt cmake build file
ChangeLog history of changes
FAQ Frequently Asked Questions about zlib
INDEX this file
Makefile dummy Makefile that tells you to ./configure
Makefile.in template for Unix Makefile
README guess what
configure configure script for Unix
make_vms.com makefile for VMS
test/example.c zlib usages examples for build testing
test/minigzip.c minimal gzip-like functionality for build testing
test/infcover.c inf*.c code coverage for build coverage testing
treebuild.xml XML description of source file dependencies
zconf.h.cmakein zconf.h template for cmake
zconf.h.in zconf.h template for configure
zlib.3 Man page for zlib
zlib.3.pdf Man page in PDF format
zlib.map Linux symbol information
zlib.pc.in Template for pkg-config descriptor
zlib.pc.cmakein zlib.pc template for cmake
zlib2ansi perl script to convert source files for C++ compilation
amiga/ makefiles for Amiga SAS C
doc/ documentation for formats and algorithms
msdos/ makefiles for MSDOS
old/ makefiles for various architectures and zlib documentation
files that have not yet been updated for zlib 1.2.x
os400/ makefiles for OS/400
qnx/ makefiles for QNX
watcom/ makefiles for OpenWatcom
win32/ makefiles for Windows
zlib public header files (required for library use):
zconf.h
zlib.h
private source files used to build the zlib library:
adler32.c
compress.c
crc32.c
crc32.h
deflate.c
deflate.h
gzclose.c
gzguts.h
gzlib.c
gzread.c
gzwrite.c
infback.c
inffast.c
inffast.h
inffixed.h
inflate.c
inflate.h
inftrees.c
inftrees.h
trees.c
trees.h
uncompr.c
zutil.c
zutil.h
source files for sample programs
See examples/README.examples
unsupported contributions by third parties
See contrib/README.contrib

22
vendor/tcl/compat/zlib/LICENSE vendored Normal file
View file

@ -0,0 +1,22 @@
Copyright notice:
(C) 1995-2026 Jean-loup Gailly and Mark Adler
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.
Jean-loup Gailly Mark Adler
jloup@gzip.org madler@alumni.caltech.edu

9
vendor/tcl/compat/zlib/MODULE.bazel vendored Normal file
View file

@ -0,0 +1,9 @@
module(
name = "zlib",
version = "0.0.0",
compatibility_level = 1,
)
bazel_dep(name = "platforms", version = "0.0.10")
bazel_dep(name = "rules_cc", version = "0.0.16")
bazel_dep(name = "rules_license", version = "1.0.0")

5
vendor/tcl/compat/zlib/Makefile vendored Normal file
View file

@ -0,0 +1,5 @@
all:
-@echo "Please use ./configure first. Thank you."
distclean:
make -f Makefile.in distclean

426
vendor/tcl/compat/zlib/Makefile.in vendored Normal file
View file

@ -0,0 +1,426 @@
# Makefile for zlib
# Copyright (C) 1995-2026 Jean-loup Gailly, Mark Adler
# For conditions of distribution and use, see copyright notice in zlib.h
# To compile and test, type:
# ./configure; make test
# Normally configure builds both a static and a shared library.
# If you want to build just a static library, use: ./configure --static
# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type:
# make install
# To install in $HOME instead of /usr/local, use:
# make install prefix=$HOME
CC=cc
GCOV=GCOV
LLVM_GCOV_FLAG=LLMV_GCOV_FLAG
CFLAGS=-O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-g -DZLIB_DEBUG
#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
# -Wstrict-prototypes -Wmissing-prototypes
SFLAGS=-O
LDFLAGS=
TEST_LIBS=-L. libz.a
LDSHARED=$(CC)
CPP=$(CC) -E
VGFMAFLAG=
STATICLIB=libz.a
SHAREDLIB=libz.so
SHAREDLIBV=libz.so.1.3.2
SHAREDLIBM=libz.so.1
LIBS=$(STATICLIB) $(SHAREDLIBV)
AR=ar
ARFLAGS=rc
RANLIB=ranlib
LDCONFIG=ldconfig
LDSHAREDLIBC=-lc
TAR=tar
SHELL=/bin/sh
EXE=
prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
sharedlibdir = ${libdir}
includedir = ${prefix}/include
mandir = ${prefix}/share/man
man3dir = ${mandir}/man3
pkgconfigdir = ${libdir}/pkgconfig
SRCDIR=
ZINC=
ZINCOUT=-I.
OBJZ = adler32.o crc32.o deflate.o infback.o inffast.o inflate.o inftrees.o trees.o zutil.o
OBJG = compress.o uncompr.o gzclose.o gzlib.o gzread.o gzwrite.o
OBJC = $(OBJZ) $(OBJG)
PIC_OBJZ = adler32.lo crc32.lo deflate.lo infback.lo inffast.lo inflate.lo inftrees.lo trees.lo zutil.lo
PIC_OBJG = compress.lo uncompr.lo gzclose.lo gzlib.lo gzread.lo gzwrite.lo
PIC_OBJC = $(PIC_OBJZ) $(PIC_OBJG)
# to use the asm code: make OBJA=match.o, PIC_OBJA=match.lo
OBJA =
PIC_OBJA =
OBJS = $(OBJC) $(OBJA)
PIC_OBJS = $(PIC_OBJC) $(PIC_OBJA)
all: static shared
static: example$(EXE) minigzip$(EXE)
shared: examplesh$(EXE) minigzipsh$(EXE)
all64: example64$(EXE) minigzip64$(EXE)
check: test
test: all teststatic testshared
teststatic: static
@TMPST=tmpst_$$; \
if echo hello world | ${QEMU_RUN} ./minigzip | ${QEMU_RUN} ./minigzip -d && ${QEMU_RUN} ./example $$TMPST ; then \
echo ' *** zlib test OK ***'; \
else \
echo ' *** zlib test FAILED ***'; false; \
fi
@rm -f tmpst_$$
testshared: shared
@LD_LIBRARY_PATH=`pwd`:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
LD_LIBRARYN32_PATH=`pwd`:$(LD_LIBRARYN32_PATH) ; export LD_LIBRARYN32_PATH; \
DYLD_LIBRARY_PATH=`pwd`:$(DYLD_LIBRARY_PATH) ; export DYLD_LIBRARY_PATH; \
SHLIB_PATH=`pwd`:$(SHLIB_PATH) ; export SHLIB_PATH; \
TMPSH=tmpsh_$$; \
if echo hello world | ${QEMU_RUN} ./minigzipsh | ${QEMU_RUN} ./minigzipsh -d && ${QEMU_RUN} ./examplesh $$TMPSH; then \
echo ' *** zlib shared test OK ***'; \
else \
echo ' *** zlib shared test FAILED ***'; false; \
fi
@rm -f tmpsh_$$
test64: all64
@TMP64=tmp64_$$; \
if echo hello world | ${QEMU_RUN} ./minigzip64 | ${QEMU_RUN} ./minigzip64 -d && ${QEMU_RUN} ./example64 $$TMP64; then \
echo ' *** zlib 64-bit test OK ***'; \
else \
echo ' *** zlib 64-bit test FAILED ***'; false; \
fi
@rm -f tmp64_$$
infcover.o: $(SRCDIR)test/infcover.c $(SRCDIR)zlib.h zconf.h $(SRCDIR)inflate.h $(SRCDIR)inftrees.h
$(CC) $(CFLAGS) $(ZINCOUT) -c -coverage -o $@ $(SRCDIR)test/infcover.c
infcover: infcover.o libz.a
$(CC) $(CFLAGS) -coverage -o $@ infcover.o libz.a
cover: infcover
rm -f *.gcda
${QEMU_RUN} ./infcover
${GCOV} ${LLVM_GCOV_FLAG} inf*.c -o ./infcover.gcda
libz.a: $(OBJS)
$(AR) $(ARFLAGS) $@ $(OBJS)
-@ ($(RANLIB) $@ || true) >/dev/null 2>&1
match.o: match.S
$(CPP) match.S > _match.s
$(CC) -c _match.s
mv _match.o match.o
rm -f _match.s
match.lo: match.S
$(CPP) match.S > _match.s
$(CC) -c -fPIC _match.s
mv _match.o match.lo
rm -f _match.s
example.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h
$(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/example.c
minigzip.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h
$(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/minigzip.c
example64.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h
$(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/example.c
minigzip64.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h
$(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/minigzip.c
adler32.o: $(SRCDIR)adler32.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)adler32.c
crc32.o: $(SRCDIR)crc32.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)crc32.c
crc32_vx.o: $(SRCDIR)contrib/crc32vx/crc32_vx.c
$(CC) $(CFLAGS) $(VGFMAFLAG) $(ZINC) -c -o $@ $(SRCDIR)contrib/crc32vx/crc32_vx.c
deflate.o: $(SRCDIR)deflate.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)deflate.c
infback.o: $(SRCDIR)infback.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)infback.c
inffast.o: $(SRCDIR)inffast.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inffast.c
inflate.o: $(SRCDIR)inflate.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inflate.c
inftrees.o: $(SRCDIR)inftrees.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inftrees.c
trees.o: $(SRCDIR)trees.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)trees.c
zutil.o: $(SRCDIR)zutil.c $(SRCDIR)gzguts.h
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)zutil.c
compress.o: $(SRCDIR)compress.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)compress.c
uncompr.o: $(SRCDIR)uncompr.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)uncompr.c
gzclose.o: $(SRCDIR)gzclose.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzclose.c
gzlib.o: $(SRCDIR)gzlib.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzlib.c
gzread.o: $(SRCDIR)gzread.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzread.c
gzwrite.o: $(SRCDIR)gzwrite.c
$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzwrite.c
adler32.lo: $(SRCDIR)adler32.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/adler32.o $(SRCDIR)adler32.c
-@mv objs/adler32.o $@
crc32.lo: $(SRCDIR)crc32.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/crc32.o $(SRCDIR)crc32.c
-@mv objs/crc32.o $@
crc32_vx.lo: $(SRCDIR)contrib/crc32vx/crc32_vx.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(VGFMAFLAG) $(ZINC) -DPIC -c -o objs/crc32_vx.o $(SRCDIR)contrib/crc32vx/crc32_vx.c
-@mv objs/crc32_vx.o $@
deflate.lo: $(SRCDIR)deflate.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/deflate.o $(SRCDIR)deflate.c
-@mv objs/deflate.o $@
infback.lo: $(SRCDIR)infback.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/infback.o $(SRCDIR)infback.c
-@mv objs/infback.o $@
inffast.lo: $(SRCDIR)inffast.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inffast.o $(SRCDIR)inffast.c
-@mv objs/inffast.o $@
inflate.lo: $(SRCDIR)inflate.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inflate.o $(SRCDIR)inflate.c
-@mv objs/inflate.o $@
inftrees.lo: $(SRCDIR)inftrees.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inftrees.o $(SRCDIR)inftrees.c
-@mv objs/inftrees.o $@
trees.lo: $(SRCDIR)trees.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/trees.o $(SRCDIR)trees.c
-@mv objs/trees.o $@
zutil.lo: $(SRCDIR)zutil.c $(SRCDIR)gzguts.h
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/zutil.o $(SRCDIR)zutil.c
-@mv objs/zutil.o $@
compress.lo: $(SRCDIR)compress.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/compress.o $(SRCDIR)compress.c
-@mv objs/compress.o $@
uncompr.lo: $(SRCDIR)uncompr.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/uncompr.o $(SRCDIR)uncompr.c
-@mv objs/uncompr.o $@
gzclose.lo: $(SRCDIR)gzclose.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzclose.o $(SRCDIR)gzclose.c
-@mv objs/gzclose.o $@
gzlib.lo: $(SRCDIR)gzlib.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzlib.o $(SRCDIR)gzlib.c
-@mv objs/gzlib.o $@
gzread.lo: $(SRCDIR)gzread.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzread.o $(SRCDIR)gzread.c
-@mv objs/gzread.o $@
gzwrite.lo: $(SRCDIR)gzwrite.c
-@mkdir objs 2>/dev/null || test -d objs
$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzwrite.o $(SRCDIR)gzwrite.c
-@mv objs/gzwrite.o $@
placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a $(SRCDIR)zlib.map
$(LDSHARED) $(SFLAGS) -o $@ $(PIC_OBJS) $(LDSHAREDLIBC) $(LDFLAGS)
rm -f $(SHAREDLIB) $(SHAREDLIBM)
ln -s $@ $(SHAREDLIB)
ln -s $@ $(SHAREDLIBM)
-@rmdir objs
example$(EXE): example.o $(STATICLIB)
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ example.o $(TEST_LIBS)
minigzip$(EXE): minigzip.o $(STATICLIB)
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip.o $(TEST_LIBS)
examplesh$(EXE): example.o $(SHAREDLIBV)
$(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS) -L. $(SHAREDLIBV)
minigzipsh$(EXE): minigzip.o $(SHAREDLIBV)
$(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS) -L. $(SHAREDLIBV)
example64$(EXE): example64.o $(STATICLIB)
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ example64.o $(TEST_LIBS)
minigzip64$(EXE): minigzip64.o $(STATICLIB)
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip64.o $(TEST_LIBS)
install-libs: $(LIBS)
-@if [ ! -d $(DESTDIR)$(exec_prefix) ]; then mkdir -p $(DESTDIR)$(exec_prefix); fi
-@if [ ! -d $(DESTDIR)$(libdir) ]; then mkdir -p $(DESTDIR)$(libdir); fi
-@if [ ! -d $(DESTDIR)$(sharedlibdir) ]; then mkdir -p $(DESTDIR)$(sharedlibdir); fi
-@if [ ! -d $(DESTDIR)$(man3dir) ]; then mkdir -p $(DESTDIR)$(man3dir); fi
-@if [ ! -d $(DESTDIR)$(pkgconfigdir) ]; then mkdir -p $(DESTDIR)$(pkgconfigdir); fi
rm -f $(DESTDIR)$(libdir)/$(STATICLIB)
cp $(STATICLIB) $(DESTDIR)$(libdir)
chmod 644 $(DESTDIR)$(libdir)/$(STATICLIB)
-@($(RANLIB) $(DESTDIR)$(libdir)/libz.a || true) >/dev/null 2>&1
-@if test -n "$(SHAREDLIBV)"; then \
rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \
cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir); \
echo "cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)"; \
chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \
echo "chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV)"; \
rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB); \
ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
($(LDCONFIG) || true) >/dev/null 2>&1; \
fi
rm -f $(DESTDIR)$(man3dir)/zlib.3
cp $(SRCDIR)zlib.3 $(DESTDIR)$(man3dir)
chmod 644 $(DESTDIR)$(man3dir)/zlib.3
rm -f $(DESTDIR)$(pkgconfigdir)/zlib.pc
cp zlib.pc $(DESTDIR)$(pkgconfigdir)
chmod 644 $(DESTDIR)$(pkgconfigdir)/zlib.pc
# The ranlib in install is needed on NeXTSTEP which checks file times
# ldconfig is for Linux
install: install-libs
-@if [ ! -d $(DESTDIR)$(includedir) ]; then mkdir -p $(DESTDIR)$(includedir); fi
rm -f $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h
cp $(SRCDIR)zlib.h zconf.h $(DESTDIR)$(includedir)
chmod 644 $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h
uninstall:
cd $(DESTDIR)$(includedir) && rm -f zlib.h zconf.h
cd $(DESTDIR)$(libdir) && rm -f libz.a; \
if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \
fi
cd $(DESTDIR)$(man3dir) && rm -f zlib.3
cd $(DESTDIR)$(pkgconfigdir) && rm -f zlib.pc
docs: zlib.3.pdf
zlib.3.pdf: $(SRCDIR)zlib.3
groff -mandoc -f H -T ps $(SRCDIR)zlib.3 | ps2pdf - $@
# zconf.h.cmakein: $(SRCDIR)zconf.h.in
# -@ TEMPFILE=zconfh_$$; \
# echo "/#define ZCONF_H/ a\\\\\n#cmakedefine Z_PREFIX\\\\\n#cmakedefine Z_HAVE_UNISTD_H\n" >> $$TEMPFILE &&\
# sed -f $$TEMPFILE $(SRCDIR)zconf.h.in > $@ &&\
# touch -r $(SRCDIR)zconf.h.in $@ &&\
# rm $$TEMPFILE
#
zconf: $(SRCDIR)zconf.h.in
cp -p $(SRCDIR)zconf.h.in zconf.h
minizip-test: static
cd contrib/minizip && { CC="$(CC)" CFLAGS="$(CFLAGS)" $(MAKE) test ; cd ../.. ; }
minizip-clean:
cd contrib/minizip && { $(MAKE) clean ; cd ../.. ; }
mostlyclean: clean
clean: minizip-clean
rm -f *.o *.lo *~ \
example$(EXE) minigzip$(EXE) examplesh$(EXE) minigzipsh$(EXE) \
example64$(EXE) minigzip64$(EXE) \
infcover \
libz.* foo.gz so_locations \
_match.s maketree contrib/infback9/*.o
rm -rf objs
rm -f *.gcda *.gcno *.gcov
rm -f contrib/infback9/*.gcda contrib/infback9/*.gcno contrib/infback9/*.gcov
maintainer-clean: distclean
distclean: clean zconf # zconf.h.cmakein
rm -f Makefile zlib.pc configure.log
-@rm -f .DS_Store
@if [ -f Makefile.in ]; then \
printf 'all:\n\t-@echo "Please use ./configure first. Thank you."\n' > Makefile ; \
printf '\ndistclean:\n\tmake -f Makefile.in distclean\n' >> Makefile ; \
touch -r $(SRCDIR)Makefile.in Makefile ; fi
tags:
etags $(SRCDIR)*.[ch]
adler32.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
zutil.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
gzclose.o gzlib.o gzread.o gzwrite.o: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
compress.o example.o minigzip.o uncompr.o: $(SRCDIR)zlib.h zconf.h
crc32.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h
deflate.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
infback.o inflate.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h
inffast.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h
inftrees.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h
trees.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h
crc32_vx.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)contrib/crc32vx/crc32_vx_hooks.h
adler32.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
zutil.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
gzclose.lo gzlib.lo gzread.lo gzwrite.lo: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
compress.lo example.lo minigzip.lo uncompr.lo: $(SRCDIR)zlib.h zconf.h
crc32.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h
deflate.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
infback.lo inflate.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h
inffast.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h
inftrees.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h
trees.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h
crc32_vx.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)contrib/crc32vx/crc32_vx_hooks.h

115
vendor/tcl/compat/zlib/README vendored Normal file
View file

@ -0,0 +1,115 @@
ZLIB DATA COMPRESSION LIBRARY
zlib 1.3.2 is a general purpose data compression library. All the code is
thread safe (though see the FAQ for caveats). The data format used by the zlib
library is described by RFCs (Request for Comments) 1950 to 1952 at
https://datatracker.ietf.org/doc/html/rfc1950 (zlib format), rfc1951 (deflate
format) and rfc1952 (gzip format).
All functions of the compression library are documented in the file zlib.h
(volunteer to write man pages welcome, contact zlib@gzip.org). A usage example
of the library is given in the file test/example.c which also tests that
the library is working correctly. Another example is given in the file
test/minigzip.c. The compression library itself is composed of all source
files in the root directory.
To compile all files and run the test program, follow the instructions given at
the top of Makefile.in. In short "./configure; make test", and if that goes
well, "make install" should work for most flavors of Unix. For Windows, use
one of the special makefiles in win32/ or contrib/vstudio/ . For VMS, use
make_vms.com.
Questions about zlib should be sent to <zlib@gzip.org>, or to Gilles Vollant
<info@winimage.com> for the Windows DLL version. The zlib home page is
https://zlib.net/ . Before reporting a problem, please check this site to
verify that you have the latest version of zlib; otherwise get the latest
version and check whether the problem still exists or not.
PLEASE read the zlib FAQ https://zlib.net/zlib_faq.html before asking for help.
Mark Nelson <markn@ieee.org> wrote an article about zlib for the Jan. 1997
issue of Dr. Dobb's Journal; a copy of the article is available at
https://zlib.net/nelson/ .
The changes made in version 1.3.2 are documented in the file ChangeLog.
Unsupported third party contributions are provided in directory contrib/ .
zlib is available in Java using the java.util.zip package. Follow the API
Documentation link at: https://docs.oracle.com/search/?q=java.util.zip .
A Perl interface to zlib and bzip2 written by Paul Marquess <pmqs@cpan.org>
can be found at https://github.com/pmqs/IO-Compress .
A Python interface to zlib written by A.M. Kuchling <amk@amk.ca> is
available in Python 1.5 and later versions, see
https://docs.python.org/3/library/zlib.html .
zlib is built into tcl: https://wiki.tcl-lang.org/page/zlib .
An experimental package to read and write files in .zip format, written on top
of zlib by Gilles Vollant <info@winimage.com>, is available in the
contrib/minizip directory of zlib.
Notes for some targets:
- For Windows DLL versions, please see win32/DLL_FAQ.txt
- For 64-bit Irix, deflate.c must be compiled without any optimization. With
-O, one libpng test fails. The test works in 32 bit mode (with the -n32
compiler flag). The compiler bug has been reported to SGI.
- zlib doesn't work with gcc 2.6.3 on a DEC 3000/300LX under OSF/1 2.1 it works
when compiled with cc.
- On Digital Unix 4.0D (formerly OSF/1) on AlphaServer, the cc option -std1 is
necessary to get gzprintf working correctly. This is done by configure.
- zlib doesn't work on HP-UX 9.05 with some versions of /bin/cc. It works with
other compilers. Use "make test" to check your compiler.
- For PalmOs, see https://palmzlib.sourceforge.net/
Acknowledgments:
The deflate format used by zlib was defined by Phil Katz. The deflate and
zlib specifications were written by L. Peter Deutsch. Thanks to all the
people who reported problems and suggested various improvements in zlib; they
are too numerous to cite here.
Copyright notice:
(C) 1995-2026 Jean-loup Gailly and Mark Adler
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.
Jean-loup Gailly Mark Adler
jloup@gzip.org madler@alumni.caltech.edu
If you use the zlib library in a product, we would appreciate *not* receiving
lengthy legal documents to sign. The sources are provided for free but without
warranty of any kind. The library has been entirely written by Jean-loup
Gailly and Mark Adler; it does not include third-party code. We make all
contributions to and distributions of this project solely in our personal
capacity, and are not conveying any rights to any intellectual property of
any third parties.
If you redistribute modified sources, we would appreciate that you include in
the file ChangeLog history information documenting your changes. Please read
the FAQ for more information on the distribution of modified source versions.

79
vendor/tcl/compat/zlib/README-cmake.md vendored Normal file
View file

@ -0,0 +1,79 @@
# For building with cmake at least version 3.12 (minizip 3.12) is needed
In most cases the usual
cmake -S . -B build -D CMAKE_BUILD_TYPE=Release
will create everything you need, however if you want something off default you can adjust several options fit your needs.
Every option is list below (excluding the cmake-standard options), they can be set via cmake-gui or on cmdline with
-D<option>=ON/OFF
## ZLIB-options with defaults ##
ZLIB_BUILD_TESTING=ON -- Enable Zlib Examples as tests
ZLIB_BUILD_SHARED=ON -- Enable building zlib shared library
ZLIB_BUILD_STATIC=ON -- Enable building zlib static library
ZLIB_BUILD_MINIZIP=ON -- Enable building libminizip contrib library
If this option is turned on, additional options are available from minizip (see below)
ZLIB_INSTALL=ON -- Enable installation of zlib
ZLIB_PREFIX=OFF -- prefix for all types and library functions, see zconf.h.in
This option is only on windows available and may/will be turned off and removed somewhen in the future.
If you rely cmake for finding and using zlib, this can be turned off, as `zlib1.dll` will never be used.
## minizip-options with defaults ##
MINIZIP_BUILD_SHARED=ON -- Enable building minizip shared library
MINIZIP_BUILD_STATIC=ON -- Enable building minizip static library
MINIZIP_BUILD_TESTING=ON -- Enable testing of minizip
MINIZIP_ENABLE_BZIP2=ON -- Build minizip withj bzip2 support
A usable installation of bzip2 is needed or config will fail. Turn this option of in this case.
MINIZIP_INSTALL=ON -- Enable installation of minizip
This option is only available on mingw as they tend to name this lib different. Maybe this will also be
removed in the future as. If you rely cmake for finding and using zlib, this can be turned off, as
the other file will never be used.
## Using the libs ##
To pull in what you need it's enough to just write
find_package(ZLIB CONFIG)
or
find_package(minizip CONFIG)
in your CMakeLists.txt, however it is advised to specify what you really want via:
find_package(ZLIB CONFIG COMPONENTS shared static REQUIRED)
or
find_package(minizip CONFIG COMPONENTS shared static REQUIRED)
As it's possible to only build the shared or the static lib, you can make sure that everything you need
is found. If no COMPONENTS are requested, everything needs to be found to satisfy your request. If the
libraries are optional in you project, you can omit the REQUIRED and check yourself if the targets you
want to link against are created.
When you search for minizip, it will search zlib for you, so only one of both is needed.
## Imported targets ##
When found the following targets are created for you:
ZLIB::ZLIB and ZLIB::ZLIBSTATIC -- for zlib
MINIZIP::minizip and MINIZIP::minizipstatic -- for minizip

164
vendor/tcl/compat/zlib/adler32.c vendored Normal file
View file

@ -0,0 +1,164 @@
/* adler32.c -- compute the Adler-32 checksum of a data stream
* Copyright (C) 1995-2011, 2016 Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
/* @(#) $Id$ */
#include "zutil.h"
#define BASE 65521U /* largest prime smaller than 65536 */
#define NMAX 5552
/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */
#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;}
#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8);
/* use NO_DIVIDE if your processor does not do division in hardware --
try it both ways to see which is faster */
#ifdef NO_DIVIDE
/* note that this assumes BASE is 65521, where 65536 % 65521 == 15
(thank you to John Reiser for pointing this out) */
# define CHOP(a) \
do { \
unsigned long tmp = a >> 16; \
a &= 0xffffUL; \
a += (tmp << 4) - tmp; \
} while (0)
# define MOD28(a) \
do { \
CHOP(a); \
if (a >= BASE) a -= BASE; \
} while (0)
# define MOD(a) \
do { \
CHOP(a); \
MOD28(a); \
} while (0)
# define MOD63(a) \
do { /* this assumes a is not negative */ \
z_off64_t tmp = a >> 32; \
a &= 0xffffffffL; \
a += (tmp << 8) - (tmp << 5) + tmp; \
tmp = a >> 16; \
a &= 0xffffL; \
a += (tmp << 4) - tmp; \
tmp = a >> 16; \
a &= 0xffffL; \
a += (tmp << 4) - tmp; \
if (a >= BASE) a -= BASE; \
} while (0)
#else
# define MOD(a) a %= BASE
# define MOD28(a) a %= BASE
# define MOD63(a) a %= BASE
#endif
/* ========================================================================= */
uLong ZEXPORT adler32_z(uLong adler, const Bytef *buf, z_size_t len) {
unsigned long sum2;
unsigned n;
/* split Adler-32 into component sums */
sum2 = (adler >> 16) & 0xffff;
adler &= 0xffff;
/* in case user likes doing a byte at a time, keep it fast */
if (len == 1) {
adler += buf[0];
if (adler >= BASE)
adler -= BASE;
sum2 += adler;
if (sum2 >= BASE)
sum2 -= BASE;
return adler | (sum2 << 16);
}
/* initial Adler-32 value (deferred check for len == 1 speed) */
if (buf == Z_NULL)
return 1L;
/* in case short lengths are provided, keep it somewhat fast */
if (len < 16) {
while (len--) {
adler += *buf++;
sum2 += adler;
}
if (adler >= BASE)
adler -= BASE;
MOD28(sum2); /* only added so many BASE's */
return adler | (sum2 << 16);
}
/* do length NMAX blocks -- requires just one modulo operation */
while (len >= NMAX) {
len -= NMAX;
n = NMAX / 16; /* NMAX is divisible by 16 */
do {
DO16(buf); /* 16 sums unrolled */
buf += 16;
} while (--n);
MOD(adler);
MOD(sum2);
}
/* do remaining bytes (less than NMAX, still just one modulo) */
if (len) { /* avoid modulos if none remaining */
while (len >= 16) {
len -= 16;
DO16(buf);
buf += 16;
}
while (len--) {
adler += *buf++;
sum2 += adler;
}
MOD(adler);
MOD(sum2);
}
/* return recombined sums */
return adler | (sum2 << 16);
}
/* ========================================================================= */
uLong ZEXPORT adler32(uLong adler, const Bytef *buf, uInt len) {
return adler32_z(adler, buf, len);
}
/* ========================================================================= */
local uLong adler32_combine_(uLong adler1, uLong adler2, z_off64_t len2) {
unsigned long sum1;
unsigned long sum2;
unsigned rem;
/* for negative len, return invalid adler32 as a clue for debugging */
if (len2 < 0)
return 0xffffffffUL;
/* the derivation of this formula is left as an exercise for the reader */
MOD63(len2); /* assumes len2 >= 0 */
rem = (unsigned)len2;
sum1 = adler1 & 0xffff;
sum2 = rem * sum1;
MOD(sum2);
sum1 += (adler2 & 0xffff) + BASE - 1;
sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem;
if (sum1 >= BASE) sum1 -= BASE;
if (sum1 >= BASE) sum1 -= BASE;
if (sum2 >= ((unsigned long)BASE << 1)) sum2 -= ((unsigned long)BASE << 1);
if (sum2 >= BASE) sum2 -= BASE;
return sum1 | (sum2 << 16);
}
/* ========================================================================= */
uLong ZEXPORT adler32_combine(uLong adler1, uLong adler2, z_off_t len2) {
return adler32_combine_(adler1, adler2, len2);
}
uLong ZEXPORT adler32_combine64(uLong adler1, uLong adler2, z_off64_t len2) {
return adler32_combine_(adler1, adler2, len2);
}

69
vendor/tcl/compat/zlib/amiga/Makefile.pup vendored Normal file
View file

@ -0,0 +1,69 @@
# Amiga powerUP (TM) Makefile
# makefile for libpng and SAS C V6.58/7.00 PPC compiler
# Copyright (C) 1998 by Andreas R. Kleinert
LIBNAME = libzip.a
CC = scppc
CFLAGS = NOSTKCHK NOSINT OPTIMIZE OPTGO OPTPEEP OPTINLOCAL OPTINL \
OPTLOOP OPTRDEP=8 OPTDEP=8 OPTCOMP=8 NOVER
AR = ppc-amigaos-ar cr
RANLIB = ppc-amigaos-ranlib
LD = ppc-amigaos-ld -r
LDFLAGS = -o
LDLIBS = LIB:scppc.a LIB:end.o
RM = delete quiet
OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
TEST_OBJS = example.o minigzip.o
all: example minigzip
check: test
test: all
example
echo hello world | minigzip | minigzip -d
$(LIBNAME): $(OBJS)
$(AR) $@ $(OBJS)
-$(RANLIB) $@
example: example.o $(LIBNAME)
$(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)
minigzip: minigzip.o $(LIBNAME)
$(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)
mostlyclean: clean
clean:
$(RM) *.o example minigzip $(LIBNAME) foo.gz
zip:
zip -ul9 zlib README ChangeLog Makefile Make????.??? Makefile.?? \
descrip.mms *.[ch]
tgz:
cd ..; tar cfz zlib/zlib.tgz zlib/README zlib/ChangeLog zlib/Makefile \
zlib/Make????.??? zlib/Makefile.?? zlib/descrip.mms zlib/*.[ch]
# DO NOT DELETE THIS LINE -- make depend depends on it.
adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
example.o: zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
gzwrite.o: zlib.h zconf.h gzguts.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

68
vendor/tcl/compat/zlib/amiga/Makefile.sas vendored Normal file
View file

@ -0,0 +1,68 @@
# SMakefile for zlib
# Modified from the standard UNIX Makefile Copyright Jean-loup Gailly
# Osma Ahvenlampi <Osma.Ahvenlampi@hut.fi>
# Amiga, SAS/C 6.56 & Smake
CC=sc
CFLAGS=OPT
#CFLAGS=OPT CPU=68030
#CFLAGS=DEBUG=LINE
LDFLAGS=LIB z.lib
SCOPTIONS=OPTSCHED OPTINLINE OPTALIAS OPTTIME OPTINLOCAL STRMERGE \
NOICONS PARMS=BOTH NOSTACKCHECK UTILLIB NOVERSION ERRORREXX \
DEF=POSTINC
OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o
TEST_OBJS = example.o minigzip.o
all: SCOPTIONS example minigzip
check: test
test: all
example
echo hello world | minigzip | minigzip -d
install: z.lib
copy clone zlib.h zconf.h INCLUDE:
copy clone z.lib LIB:
z.lib: $(OBJS)
oml z.lib r $(OBJS)
example: example.o z.lib
$(CC) $(CFLAGS) LINK TO $@ example.o $(LDFLAGS)
minigzip: minigzip.o z.lib
$(CC) $(CFLAGS) LINK TO $@ minigzip.o $(LDFLAGS)
mostlyclean: clean
clean:
-delete force quiet example minigzip *.o z.lib foo.gz *.lnk SCOPTIONS
SCOPTIONS: Makefile.sas
copy to $@ <from <
$(SCOPTIONS)
<
# DO NOT DELETE THIS LINE -- make depend depends on it.
adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
example.o: zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
gzwrite.o: zlib.h zconf.h gzguts.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

99
vendor/tcl/compat/zlib/compress.c vendored Normal file
View file

@ -0,0 +1,99 @@
/* compress.c -- compress a memory buffer
* Copyright (C) 1995-2026 Jean-loup Gailly, Mark Adler
* For conditions of distribution and use, see copyright notice in zlib.h
*/
/* @(#) $Id$ */
#define ZLIB_INTERNAL
#include "zlib.h"
/* ===========================================================================
Compresses the source buffer into the destination buffer. The level
parameter has the same meaning as in deflateInit. sourceLen is the byte
length of the source buffer. Upon entry, destLen is the total size of the
destination buffer, which must be at least 0.1% larger than sourceLen plus
12 bytes. Upon exit, destLen is the actual size of the compressed buffer.
compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
memory, Z_BUF_ERROR if there was not enough room in the output buffer,
Z_STREAM_ERROR if the level parameter is invalid.
The _z versions of the functions take size_t length arguments.
*/
int ZEXPORT compress2_z(Bytef *dest, z_size_t *destLen, const Bytef *source,
z_size_t sourceLen, int level) {
z_stream stream;
int err;
const uInt max = (uInt)-1;
z_size_t left;
if ((sourceLen > 0 && source == NULL) ||
destLen == NULL || (*destLen > 0 && dest == NULL))
return Z_STREAM_ERROR;
left = *destLen;
*destLen = 0;
stream.zalloc = (alloc_func)0;
stream.zfree = (free_func)0;
stream.opaque = (voidpf)0;
err = deflateInit(&stream, level);
if (err != Z_OK) return err;
stream.next_out = dest;
stream.avail_out = 0;
stream.next_in = (z_const Bytef *)source;
stream.avail_in = 0;
do {
if (stream.avail_out == 0) {
stream.avail_out = left > (z_size_t)max ? max : (uInt)left;
left -= stream.avail_out;
}
if (stream.avail_in == 0) {
stream.avail_in = sourceLen > (z_size_t)max ? max :
(uInt)sourceLen;
sourceLen -= stream.avail_in;
}
err = deflate(&stream, sourceLen ? Z_NO_FLUSH : Z_FINISH);
} while (err == Z_OK);
*destLen = (z_size_t)(stream.next_out - dest);
deflateEnd(&stream);
return err == Z_STREAM_END ? Z_OK : err;
}
int ZEXPORT compress2(Bytef *dest, uLongf *destLen, const Bytef *source,
uLong sourceLen, int level) {
int ret;
z_size_t got = *destLen;
ret = compress2_z(dest, &got, source, sourceLen, level);
*destLen = (uLong)got;
return ret;
}
/* ===========================================================================
*/
int ZEXPORT compress_z(Bytef *dest, z_size_t *destLen, const Bytef *source,
z_size_t sourceLen) {
return compress2_z(dest, destLen, source, sourceLen,
Z_DEFAULT_COMPRESSION);
}
int ZEXPORT compress(Bytef *dest, uLongf *destLen, const Bytef *source,
uLong sourceLen) {
return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION);
}
/* ===========================================================================
If the default memLevel or windowBits for deflateInit() is changed, then
this function needs to be updated.
*/
z_size_t ZEXPORT compressBound_z(z_size_t sourceLen) {
z_size_t bound = sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
(sourceLen >> 25) + 13;
return bound < sourceLen ? (z_size_t)-1 : bound;
}
uLong ZEXPORT compressBound(uLong sourceLen) {
z_size_t bound = compressBound_z(sourceLen);
return (uLong)bound != bound ? (uLong)-1 : (uLong)bound;
}

1078
vendor/tcl/compat/zlib/configure vendored Executable file
View file

File diff suppressed because it is too large Load diff

61
vendor/tcl/compat/zlib/contrib/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,61 @@
function(zlib_add_contrib_lib name description dir)
option(ZLIB_BUILD_${name} "Enable building of ${description}" OFF)
if(ZLIB_BUILD_${name})
if(NOT DEFINED ZLIB_${name}_BUILD_SHARED)
set(ZLIB_${name}_BUILD_SHARED ${ZLIB_BUILD_SHARED} CACHE BOOL "")
endif(NOT DEFINED ZLIB_${name}_BUILD_SHARED)
if(NOT DEFINED ZLIB_${name}_BUILD_STATIC)
set(ZLIB_${name}_BUILD_STATIC ${ZLIB_BUILD_STATIC} CACHE BOOL "")
endif(NOT DEFINED ZLIB_${name}_BUILD_STATIC)
if(NOT DEFINED ZLIB_${name}_BUILD_TESTING)
set(ZLIB_${name}_BUILD_TESTING ${ZLIB_BUILD_TESTING} CACHE BOOL "")
endif(NOT DEFINED ZLIB_${name}_BUILD_TESTING)
if(NOT DEFINED ZLIB_${name}_INSTALL)
set(ZLIB_${name}_INSTALL ${ZLIB_INSTALL} CACHE BOOL "")
endif(NOT DEFINED ZLIB_${name}_INSTALL)
add_subdirectory(${dir}/)
endif(ZLIB_BUILD_${name})
endfunction(zlib_add_contrib_lib name description dir)
function(zlib_add_contrib_feature name description dir)
if(ARGC EQUAL 4)
set(default_on ${ARGV3})
else()
set(default_on Off)
endif()
option(ZLIB_WITH_${name}
"Enable build ${description}"
${default_on})
if(ZLIB_WITH_${name})
add_subdirectory(${dir}/)
endif(ZLIB_WITH_${name})
endfunction(zlib_add_contrib_feature name description dir)
zlib_add_contrib_feature("GVMAT64"
"of an optimized longest_match for 32 bits x86_64"
gcc_gvmat64)
zlib_add_contrib_feature(INFBACK9 "with support for method 9 deflate" infback9)
zlib_add_contrib_feature(CRC32VX "with S390X-CRC32VX implementation" crc32vx)
zlib_add_contrib_lib(ADA "Ada bindings" ada)
zlib_add_contrib_lib(BLAST "blast binary" blast)
zlib_add_contrib_lib(IOSTREAM3 "IOStream C++ bindings V3" iostream3)
zlib_add_contrib_lib(MINIZIP "minizip library" minizip)
zlib_add_contrib_lib(PUFF "puff decompress library" puff)
if(WIN32)
zlib_add_contrib_lib(TESTZLIB "testzlib binary" testzlib)
if (ZLIB_BUILD_ZLIB1_DLL)
add_subdirectory(zlib1-dll/)
endif (ZLIB_BUILD_ZLIB1_DLL)
option(ZLIB_BUILD_ZLIB1_DLL "Build the legacy zlib + minizip DLL" OFF)
endif(WIN32)

57
vendor/tcl/compat/zlib/contrib/README.contrib vendored Normal file
View file

@ -0,0 +1,57 @@
All files under this contrib directory are UNSUPPORTED. They were
provided by users of zlib and were not tested by the authors of zlib.
Use at your own risk. Please contact the authors of the contributions
for help about these, not the zlib authors. Thanks.
ada/ by Dmitriy Anisimkov <anisimkov@yahoo.com>
Support for Ada
See https://zlib-ada.sourceforge.net/
blast/ by Mark Adler <madler@alumni.caltech.edu>
Decompressor for output of PKWare Data Compression Library (DCL)
delphi/ by Cosmin Truta <cosmint@cs.ubbcluj.ro>
Support for Delphi and C++ Builder
dotzlib/ by Henrik Ravn <henrik@ravn.com>
Support for Microsoft .Net and Visual C++ .Net
gcc_gvmat64/by Gilles Vollant <info@winimage.com>
GCC Version of x86 64-bit (AMD64 and Intel EM64t) code for x64
assembler to replace longest_match() and inflate_fast()
infback9/ by Mark Adler <madler@alumni.caltech.edu>
Unsupported diffs to infback to decode the deflate64 format
iostream/ by Kevin Ruland <kevin@rodin.wustl.edu>
A C++ I/O streams interface to the zlib gz* functions
iostream2/ by Tyge Løvset <Tyge.Lovset@cmr.no>
Another C++ I/O streams interface
iostream3/ by Ludwig Schwardt <schwardt@sun.ac.za>
and Kevin Ruland <kevin@rodin.wustl.edu>
Yet another C++ I/O streams interface
minizip/ by Gilles Vollant <info@winimage.com>
Mini zip and unzip based on zlib
Includes Zip64 support by Mathias Svensson <mathias@result42.com>
See https://www.winimage.com/zLibDll/minizip.html
pascal/ by Bob Dellaca <bobdl@xtra.co.nz> et al.
Support for Pascal
puff/ by Mark Adler <madler@alumni.caltech.edu>
Small, low memory usage inflate. Also serves to provide an
unambiguous description of the deflate format.
crc32vx/ by Ilya Leoshkevich <iii@linux.ibm.com>
Hardware-accelerated CRC32 on IBM Z with Z13 VX extension.
testzlib/ by Gilles Vollant <info@winimage.com>
Example of the use of zlib
zlib1-dll/
by @Vollstrecker on github.com
Build the legacy zlib1.dll with zlib and minizip.

217
vendor/tcl/compat/zlib/contrib/ada/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,217 @@
cmake_minimum_required(VERSION 3.12...3.31)
set(CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules")
project(
zlibAda
VERSION 1.0.0
LANGUAGES C ADA
DESCRIPTION "A library for creating zipfiles based in zlib"
HOMEPAGE_URL "https://www.zlib.net")
option(ZLIB_ADA_BUILD_SHARED "Enable building ada bindings shared library" ON)
option(ZLIB_ADA_BUILD_STATIC "Enable building ada bindings static library" ON)
option(ZLIB_ADA_BUILD_TESTING "Enable building tests for ada bindings library" ON)
if(WIN32 OR CYGWIN)
set(zlib_Ada_static_suffix "s")
set(CMAKE_DEBUG_POSTFIX "d")
endif(WIN32 OR CYGWIN)
if(NOT DEFINED ZLIB_BUILD_ADA)
if(ZLIB_ADA_BUILD_SHARED)
list(APPEND REQUIRED_COMPONENTS "shared")
endif(ZLIB_ADA_BUILD_SHARED)
if(ZLIB_ADA_BUILD_STATIC)
list(APPEND REQUIRED_COMPONENTS "static")
endif(ZLIB_ADA_BUILD_STATIC)
find_package(ZLIB REQUIRED COMPONENTS ${REQUIRED_COMPONENTS} CONFIG)
endif(NOT DEFINED ZLIB_BUILD_ADA)
function(ZLIB_ADA_findTestEnv testName)
set(testEnv "PATH=")
if(MSVC OR MINGW)
set(separator "\\\;")
else()
set(separator ":")
endif()
string(APPEND testEnv "$<TARGET_FILE_DIR:ZLIB::ZLIB>${separator}")
string(APPEND testEnv "$ENV{PATH}")
set_tests_properties(${testName} PROPERTIES ENVIRONMENT "${testEnv}")
endfunction(ZLIB_ADA_findTestEnv testName)
if(ZLIB_ADA_BUILD_SHARED)
ada_add_library(zlib_ada_Ada SHARED
zlib-thin.adb
zlib.adb)
set_target_properties(zlib_ada_Ada
PROPERTIES OUTPUT_NAME zlib-ada)
target_link_libraries(zlib_ada_Ada
INTERFACE ZLIB::ZLIB)
ada_add_library(zlib_ada_streams SHARED
zlib-streams.adb)
target_link_libraries(zlib_ada_streams
PUBLIC
zlib_ada_Ada)
ada_find_ali(zlib_ada_streams)
if(ZLIB_ADA_BUILD_TESTING)
enable_testing()
ada_add_executable(zlib_ada_test test.adb)
target_link_libraries(zlib_ada_test
PRIVATE
zlib_ada_Ada
zlib_ada_streams)
ada_find_ali(zlib_ada_test)
add_test(NAME zlib_ada_ada-test COMMAND zlib_ada_test)
set_tests_properties(zlib_ada_ada-test PROPERTIES FIXTURES_REQUIRED zlib_ada_cleanup)
if(MSVC
OR MSYS
OR MINGW
OR CYGWIN)
zlib_ada_findtestenv(zlib_ada_ada-test)
endif(
MSVC
OR MSYS
OR MINGW
OR CYGWIN)
ada_add_executable(zlib_ada_buffer_demo buffer_demo.adb)
target_link_libraries(zlib_ada_buffer_demo
PRIVATE
zlib_ada_Ada)
ada_find_ali(zlib_ada_buffer_demo)
add_test(NAME zlib_ada_buffer-demo COMMAND zlib_ada_buffer_demo)
if(MSVC
OR MSYS
OR MINGW
OR CYGWIN)
zlib_ada_findtestenv(zlib_ada_buffer-demo)
endif(
MSVC
OR MSYS
OR MINGW
OR CYGWIN)
ada_add_executable(zlib_ada_mtest mtest.adb)
target_link_libraries(zlib_ada_mtest
PRIVATE
zlib_ada_Ada)
ada_find_ali(zlib_ada_mtest)
#Not adding test as this is an endless-loop
ada_add_executable(zlib_ada_read read.adb)
target_link_libraries(zlib_ada_read
PRIVATE
zlib_ada_Ada)
ada_find_ali(zlib_ada_read)
add_test(NAME zlib_ada_read COMMAND zlib_ada_read)
if(MSVC
OR MSYS
OR MINGW
OR CYGWIN)
zlib_ada_findtestenv(zlib_ada_read)
endif(
MSVC
OR MSYS
OR MINGW
OR CYGWIN)
endif(ZLIB_ADA_BUILD_TESTING)
endif(ZLIB_ADA_BUILD_SHARED)
if(ZLIB_ADA_BUILD_STATIC)
ada_add_library(zlib_ada_AdaStatic STATIC
zlib-thin.adb
zlib.adb)
target_link_libraries(zlib_ada_AdaStatic
INTERFACE ZLIB::ZLIBSTATIC)
set_target_properties(zlib_ada_AdaStatic
PROPERTIES OUTPUT_NAME zlib-ada${zlib_Ada_static_suffix})
ada_add_library(zlib_ada_streamsStatic STATIC
zlib-streams.adb)
target_link_libraries(zlib_ada_streamsStatic
PUBLIC
zlib_ada_AdaStatic)
ada_find_ali(zlib_ada_streamsStatic)
if(ZLIB_ADA_BUILD_TESTING)
enable_testing()
ada_add_executable(zlib_ada_testStatic test.adb)
target_link_libraries(zlib_ada_testStatic
PRIVATE
zlib_ada_AdaStatic
zlib_ada_streamsStatic)
ada_find_ali(zlib_ada_testStatic)
add_test(NAME zlib_ada_testStatic COMMAND zlib_ada_testStatic)
set_tests_properties(zlib_ada_testStatic PROPERTIES FIXTURES_REQUIRED zlib_ada_cleanup)
ada_add_executable(zlib_ada_buffer-demoStatic buffer_demo.adb)
target_link_libraries(zlib_ada_buffer-demoStatic
PRIVATE
zlib_ada_AdaStatic)
ada_find_ali(zlib_ada_buffer-demoStatic)
add_test(NAME zlib_ada_buffer-demoStatic COMMAND zlib_ada_buffer-demoStatic)
ada_add_executable(zlib_ada_mtestStatic mtest.adb)
target_link_libraries(zlib_ada_mtestStatic
PRIVATE
zlib_ada_AdaStatic)
ada_find_ali(zlib_ada_mtestStatic)
# Not adding test as this is an endless-loop
ada_add_executable(zlib_ada_readStatic read.adb)
target_link_libraries(zlib_ada_readStatic
PRIVATE
zlib_ada_AdaStatic)
ada_find_ali(zlib_ada_readStatic)
add_test(NAME zlib_ada_readStatic COMMAND zlib_ada_readStatic)
endif(ZLIB_ADA_BUILD_TESTING)
endif(ZLIB_ADA_BUILD_STATIC)
if(ZLIB_ADA_BUILD_TESTING)
add_test(NAME zlib_ada_cleanup COMMAND ${CMAKE_COMMAND} -E rm ${CMAKE_CURRENT_BINARY_DIR}/testzlib.in
${CMAKE_CURRENT_BINARY_DIR}/testzlib.out ${CMAKE_CURRENT_BINARY_DIR}/testzlib.zlb)
set_tests_properties(zlib_ada_cleanup PROPERTIES FIXTURES_CLEANUP zlib_ada_cleanup)
endif(ZLIB_ADA_BUILD_TESTING)

106
vendor/tcl/compat/zlib/contrib/ada/buffer_demo.adb vendored Normal file
View file

@ -0,0 +1,106 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
--
-- $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $
-- This demo program provided by Dr Steve Sangwine <sjs@essex.ac.uk>
--
-- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
-- of exactly the correct size is used for decompressed data, and the last
-- few bytes passed in to Zlib are checksum bytes.
-- This program compresses a string of text, and then decompresses the
-- compressed text into a buffer of the same size as the original text.
with Ada.Streams; use Ada.Streams;
with Ada.Text_IO;
with ZLib; use ZLib;
procedure Buffer_Demo is
EOL : Character renames ASCII.LF;
Text : constant String
:= "Four score and seven years ago our fathers brought forth," & EOL &
"upon this continent, a new nation, conceived in liberty," & EOL &
"and dedicated to the proposition that `all men are created equal'.";
Source : Stream_Element_Array (1 .. Text'Length);
for Source'Address use Text'Address;
begin
Ada.Text_IO.Put (Text);
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line
("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
declare
Compressed_Data : Stream_Element_Array (1 .. Text'Length);
L : Stream_Element_Offset;
begin
Compress : declare
Compressor : Filter_Type;
I : Stream_Element_Offset;
begin
Deflate_Init (Compressor);
-- Compress the whole of T at once.
Translate (Compressor, Source, I, Compressed_Data, L, Finish);
pragma Assert (I = Source'Last);
Close (Compressor);
Ada.Text_IO.Put_Line
("Compressed size : "
& Stream_Element_Offset'Image (L) & " bytes");
end Compress;
-- Now we decompress the data, passing short blocks of data to Zlib
-- (because this demonstrates the problem - the last block passed will
-- contain checksum information and there will be no output, only a
-- check inside Zlib that the checksum is correct).
Decompress : declare
Decompressor : Filter_Type;
Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
Block_Size : constant := 4;
-- This makes sure that the last block contains
-- only Adler checksum data.
P : Stream_Element_Offset := Compressed_Data'First - 1;
O : Stream_Element_Offset;
begin
Inflate_Init (Decompressor);
loop
Translate
(Decompressor,
Compressed_Data
(P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
P,
Uncompressed_Data
(Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
O,
No_Flush);
Ada.Text_IO.Put_Line
("Total in : " & Count'Image (Total_In (Decompressor)) &
", out : " & Count'Image (Total_Out (Decompressor)));
exit when P = L;
end loop;
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line
("Decompressed text matches original text : "
& Boolean'Image (Uncompressed_Data = Source));
end Decompress;
end;
end Buffer_Demo;

23
vendor/tcl/compat/zlib/contrib/ada/cmake/Modules/CMakeADACompiler.cmake.in vendored Normal file
View file

@ -0,0 +1,23 @@
set(CMAKE_ADA_COMPILER "@CMAKE_ADA_COMPILER@")
set(CMAKE_ADA_COMPILER_ARG1 "@CMAKE_ADA_COMPILER_ARG1@")
set(CMAKE_ADA_COMPILER_ID "@CMAKE_ADA_COMPILER_ID@")
set(CMAKE_ADA_COMPILER_VERSION "@CMAKE_ADA_COMPILER_VERSION@")
set(CMAKE_ADA_PLATFORM_ID "@CMAKE_ADA_PLATFORM_ID@")
set(CMAKE_AR "@CMAKE_AR@")
#set(CMAKE_RANLIB "@CMAKE_RANLIB@")
#set(CMAKE_LINKER "@CMAKE_LINKER@")
set(CMAKE_ADA_COMPILER_LOADED TRUE)
set(CMAKE_ADA_COMPILER_WORKS @CMAKE_ADA_COMPILER_WORKS@)
#set(CMAKE_ADA_ABI_COMPILED @CMAKE_ADA_ABI_COMPILED@)
set(CMAKE_ADA_COMPILER_ENV_VAR "ADA")
set(CMAKE_ADA_COMPILER_ID_RUN TRUE)
set(CMAKE_ADA_SOURCE_FILE_EXTENSIONS adb;ADB)
set(CMAKE_ADA_IGNORE_EXTENSIONS ;o;O;obj;OBJ;ali)
set(CMAKE_ADA_BINDER_HELPER "@CMAKE_ADA_BINDER_HELPER@")
set(CMAKE_ADA_COMPILER_HELPER "@CMAKE_ADA_COMPILER_HELPER@")
set(CMAKE_ADA_EXE_LINK_HELPER "@CMAKE_ADA_EXE_LINK_HELPER@")
set(CMAKE_ADA_SHARED_LINK_HELPER "@CMAKE_ADA_SHARED_LINK_HELPER@")
set(CMAKE_ADA_STATIC_LINK_HELPER "@CMAKE_ADA_STATIC_LINK_HELPER@")

133
vendor/tcl/compat/zlib/contrib/ada/cmake/Modules/CMakeADAInformation.cmake vendored Normal file
View file

@ -0,0 +1,133 @@
include(CMakeLanguageInformation)
set(CMAKE_ADA_OUTPUT_EXTENSION .o)
set(CMAKE_ADA_OUTPUT_EXTENSION_REPLACE TRUE)
if(CMAKE_USER_MAKE_RULES_OVERRIDE)
include(${CMAKE_USER_MAKE_RULES_OVERRIDE} RESULT_VARIABLE _override)
set(CMAKE_USER_MAKE_RULES_OVERRIDE "${_override}")
endif(CMAKE_USER_MAKE_RULES_OVERRIDE)
if(CMAKE_USER_MAKE_RULES_OVERRIDE_ADA)
include(${CMAKE_USER_MAKE_RULES_OVERRIDE_ADA} RESULT_VARIABLE _override)
set(CMAKE_USER_MAKE_RULES_OVERRIDE_ADA "${_override}")
endif(CMAKE_USER_MAKE_RULES_OVERRIDE_ADA)
set(CMAKE_ADA_FLAGS_INIT "$ENV{ADAFLAGS} ${CMAKE_ADA_FLAGS_INIT}")
string(APPEND CMAKE_ADA_FLAGS_INIT " ")
string(APPEND CMAKE_ADA_FLAGS_DEBUG_INIT " -g")
string(APPEND CMAKE_ADA_FLAGS_MINSIZEREL_INIT " -Os")
string(APPEND CMAKE_ADA_FLAGS_RELEASE_INIT " -O3")
string(APPEND CMAKE_ADA_FLAGS_RELWITHDEBINFO_INIT " -O2 -g")
cmake_initialize_per_config_variable(CMAKE_ADA_FLAGS "Flags used by the Ada compiler")
if(CMAKE_ADA_STANDARD_LIBRARIES_INIT)
set(CMAKE_ADA_STANDARD_LIBRARIES
"${CMAKE_ADA_STANDARD_LIBRARIES_INIT}"
CACHE
STRING "Libraries linked by default with all Ada applications.")
mark_as_advanced(CMAKE_ADA_STANDARD_LIBRARIES)
endif(CMAKE_ADA_STANDARD_LIBRARIES_INIT)
if(NOT CMAKE_ADA_COMPILER_LAUNCHER AND DEFINED ENV{CMAKE_ADA_COMPILER_LAUNCHER})
set(CMAKE_ADA_COMPILER_LAUNCHER
"$ENV{CMAKE_ADA_COMPILER_LAUNCHER}"
CACHE
STRING "Compiler launcher for Ada.")
endif(NOT CMAKE_ADA_COMPILER_LAUNCHER AND DEFINED ENV{CMAKE_ADA_COMPILER_LAUNCHER})
if(NOT CMAKE_ADA_LINKER_LAUNCHER AND DEFINED ENV{CMAKE_ADA_LINKER_LAUNCHER})
set(CMAKE_ADA_LINKER_LAUNCHER
"$ENV{CMAKE_ADA_LINKER_LAUNCHER}"
CACHE
STRING "Linker launcher for Ada.")
endif(NOT CMAKE_ADA_LINKER_LAUNCHER AND DEFINED ENV{CMAKE_ADA_LINKER_LAUNCHER})
include(CMakeCommonLanguageInclude)
_cmake_common_language_platform_flags(ADA)
if(NOT CMAKE_ADA_CREATE_SHARED_LIBRARY)
set(CMAKE_ADA_CREATE_SHARED_LIBRARY
"${CMAKE_ADA_BINDER_HELPER} <CMAKE_ADA_COMPILER> <OBJECTS> FLAGS <FLAGS> <LINK_FLAGS>"
"${CMAKE_ADA_SHARED_LINK_HELPER} <CMAKE_ADA_COMPILER> <TARGET> <OBJECTS> <LINK_LIBRARIES>")
endif(NOT CMAKE_ADA_CREATE_SHARED_LIBRARY)
if(NOT CMAKE_ADA_CREATE_STATIC_LIBRARY)
set(CMAKE_ADA_CREATE_STATIC_LIBRARY
"${CMAKE_ADA_STATIC_LINK_HELPER} ${CMAKE_AR} <TARGET> <OBJECTS>")
endif(NOT CMAKE_ADA_CREATE_STATIC_LIBRARY)
if(NOT CMAKE_ADA_COMPILE_OBJECT)
set(CMAKE_ADA_COMPILE_OBJECT
"${CMAKE_ADA_COMPILER_HELPER} <CMAKE_ADA_COMPILER> <OBJECT_DIR> <SOURCE> <FLAGS>")
endif(NOT CMAKE_ADA_COMPILE_OBJECT)
if(NOT CMAKE_ADA_LINK_EXECUTABLE)
set(CMAKE_ADA_LINK_EXECUTABLE
"${CMAKE_ADA_BINDER_HELPER} <CMAKE_ADA_COMPILER> <OBJECTS> FLAGS <FLAGS> <LINK_FLAGS>"
"${CMAKE_ADA_EXE_LINK_HELPER} <CMAKE_ADA_COMPILER> <TARGET> <FLAGS> <CMAKE_C_LINK_FLAGS> <LINK_FLAGS> OBJ <OBJECTS> LIBS <LINK_LIBRARIES>")
endif(NOT CMAKE_ADA_LINK_EXECUTABLE)
function(ada_add_executable)
if(ARGC GREATER 1)
math(EXPR last_index "${ARGC} - 1")
foreach(source RANGE 1 ${last_index})
list(APPEND SOURCES ${ARGV${source}})
string(REPLACE ".adb" "" ali "${ARGV${source}}")
set(clean_file "CMakeFiles/${ARGV0}.dir/${ali}.ali")
list(APPEND CLEAN_FILES ${clean_file})
list(APPEND CLEAN_FILES b~${ali}.adb)
list(APPEND CLEAN_FILES b~${ali}.ads)
list(APPEND CLEAN_FILES b~${ali}.ali)
list(APPEND CLEAN_FILES b~${ali}.o)
endforeach(source RANGE 1 ${ARGC})
add_executable(${ARGV0} ${ARGV1} ${SOURCES})
set_target_properties(${ARGV0}
PROPERTIES
ADDITIONAL_CLEAN_FILES "${CLEAN_FILES}")
endif(ARGC GREATER 1)
endfunction(ada_add_executable)
function(ada_add_library)
if(ARGC GREATER 2)
math(EXPR last_index "${ARGC} - 1")
foreach(source RANGE 2 ${last_index})
list(APPEND SOURCES ${ARGV${source}})
string(REPLACE ".adb" "" ali "${ARGV${source}}")
set(clean_file "CMakeFiles/${ARGV0}.dir/${ali}.ali")
list(APPEND CLEAN_FILES ${clean_file})
list(APPEND CLEAN_FILES b~${ali}.adb)
list(APPEND CLEAN_FILES b~${ali}.ads)
list(APPEND CLEAN_FILES b~${ali}.ali)
list(APPEND CLEAN_FILES b~${ali}.o)
endforeach(source RANGE 2 ${ARGC})
add_library(${ARGV0} ${ARGV1} ${SOURCES})
set_target_properties(${ARGV0}
PROPERTIES
ADDITIONAL_CLEAN_FILES "${CLEAN_FILES};dummylib.adb;dummylib.ali;dummylib.o"
ALI_FLAG "-aO${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${ARGV0}.dir/")
endif(ARGC GREATER 2)
endfunction(ada_add_library)
function(ada_find_ali)
get_target_property(link_libs ${ARGV0} LINK_LIBRARIES)
foreach(lib IN LISTS link_libs)
get_target_property(ali ${lib} ALI_FLAG)
string(APPEND FLAGS ${ali} " ")
unset(ali)
endforeach(lib IN LISTS link_libs)
set_target_properties(${ARGV0}
PROPERTIES
LINK_FLAGS ${FLAGS})
endfunction(ada_find_ali)
set(CMAKE_ADA_INFORMATION_LOADED TRUE)

33
vendor/tcl/compat/zlib/contrib/ada/cmake/Modules/CMakeDetermineADACompiler.cmake vendored Normal file
View file

@ -0,0 +1,33 @@
include(${CMAKE_ROOT}/Modules/CMakeDetermineCompiler.cmake)
# Load system-specific compiler preferences for this language.
include(Platform/${CMAKE_SYSTEM_NAME}-Determine-Ada OPTIONAL)
include(Platform/${CMAKE_SYSTEM_NAME}-Ada OPTIONAL)
if(NOT CMAKE_ADA_COMPILER_NAMES)
set(CMAKE_ADA_COMPILER_NAMES gnat)
foreach(ver RANGE 11 99)
list(APPEND CMAKE_ADA_COMPILER_NAMES gnat-${ver})
endforeach(ver RANGE 11 99)
endif(NOT CMAKE_ADA_COMPILER_NAMES)
if(NOT CMAKE_ADA_COMPILER)
set(CMAKE_ADA_COMPILER_INIT NOTFOUND)
_cmake_find_compiler(ADA)
else(NOT CMAKE_REAL_ADA_COMPILER)
_cmake_find_compiler_path(ADA)
endif(NOT CMAKE_ADA_COMPILER)
mark_as_advanced(CMAKE_ADA_COMPILER)
set(CMAKE_ADA_COMPILER_ID "GNU")
set(CMAKE_ADA_BINDER_HELPER "${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/cmake/binder_helper.cmake")
set(CMAKE_ADA_COMPILER_HELPER "${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/cmake/compile_helper.cmake")
set(CMAKE_ADA_EXE_LINK_HELPER "${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/cmake/exe_link_helper.cmake")
set(CMAKE_ADA_SHARED_LINK_HELPER "${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/cmake/shared_link_helper.cmake")
set(CMAKE_ADA_STATIC_LINK_HELPER "${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/cmake/static_link_helper.cmake")
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules/CMakeADACompiler.cmake.in
${CMAKE_PLATFORM_INFO_DIR}/CMakeADACompiler.cmake
@ONLY)

46
vendor/tcl/compat/zlib/contrib/ada/cmake/Modules/CMakeTestADACompiler.cmake vendored Normal file
View file

@ -0,0 +1,46 @@
include(CMakeTestCompilerCommon)
unset(CMAKE_ADA_COMPILER_WORKS CACHE)
if(NOT CMAKE_ADA_COMPILER_WORKS)
PrintTestCompilerStatus("ADA" "")
set(_ADA_TEST_FILE "${CMAKE_BINARY_DIR}/${CMAKE_FILES_DIRECTORY}/CMakeTmp/main.adb")
file(WRITE ${_ADA_TEST_FILE}
"with Ada.Text_IO; use Ada.Text_IO;\n"
"\n"
"procedure main is\n"
"begin\n"
"Put_Line(\"Hello, World!\");\n"
"end Main;\n")
try_compile(CMAKE_ADA_COMPILER_WORKS ${CMAKE_BINARY_DIR}
${_ADA_TEST_FILE}
OUTPUT_VARIABLE __CMAKE_ADA_COMPILER_OUTPUT)
set(CMAKE_ADA_COMPILER_WORKS ${CMAKE_ADA_COMPILER_WORKS})
unset(CMAKE_ADA_COMPILER_WORKS CACHE)
set(ADA_TEST_WAS_RUN TRUE)
endif(NOT CMAKE_ADA_COMPILER_WORKS)
if(NOT CMAKE_ADA_COMPILER_WORKS)
PrintTestCompilerStatus("ADA" " -- broken")
file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log
"Determining if the Ada compiler works failed with "
"the following output:\n${__CMAKE_ADA_COMPILER_OUTPUT}\n\n")
message(FATAL_ERROR "The Ada compiler \"${CMAKE_ADA_COMPILER}\" "
"is not able to compile a simple test program.\nIt fails "
"with the following output:\n ${__CMAKE_ADA_COMPILER_OUTPUT}\n\n"
"CMake will not be able to correctly generate this project.")
else(NOT CMAKE_ADA_COMPILER_WORKS)
if(ADA_TEST_WAS_RUN)
PrintTestCompilerStatus("ADA" " -- works")
file(APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log
"Determining if the Ada compiler works passed with "
"the following output:\n${__CMAKE_ADA_COMPILER_OUTPUT}\n\n")
endif(ADA_TEST_WAS_RUN)
endif(NOT CMAKE_ADA_COMPILER_WORKS)
unset(__CMAKE_ADA_COMPILER_OUTPUT)

47
vendor/tcl/compat/zlib/contrib/ada/cmake/binder_helper.cmake vendored Normal file
View file

@ -0,0 +1,47 @@
#CMAKE_ARGV0 = /path/to/cmake
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = path/to/this/file
#CMAKE_ARGV3 = binder
#CMAKE_ARGV4 = ali
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "binder not set")
endif(NOT CMAKE_ARGV3)
string(REPLACE ".o" ".ali" ALI ${CMAKE_ARGV4})
set (REACHED_FLAGS FALSE)
#iterate over additional objects, only the main one is needed
foreach(arg RANGE 5 ${CMAKE_ARGC})
if(CMAKE_ARGV${arg} STREQUAL FLAGS)
set(REACHED_FLAGS TRUE)
continue()
endif(CMAKE_ARGV${arg} STREQUAL FLAGS)
string(SUBSTRING "${CMAKE_ARGV${arg}}" 0 2 start)
if(start STREQUAL "-O")
continue()
endif(start STREQUAL "-O")
if(REACHED_FLAGS)
list(APPEND FLAGS ${CMAKE_ARGV${arg}})
endif(REACHED_FLAGS)
endforeach(arg RANGE 5 CMAKE_ARGC)
#first see if there is a main function
execute_process(COMMAND ${CMAKE_ARGV3} bind ${ALI} ${FLAGS}
RESULT_VARIABLE MAIN_RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
if(MAIN_RESULT)
execute_process(COMMAND ${CMAKE_ARGV3} bind -n ${ALI} ${FLAGS}
RESULT_VARIABLE RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
endif(MAIN_RESULT)
if(RESULT)
message(FATAL_ERROR ${RESULT} ${ERROR})
endif(RESULT)

32
vendor/tcl/compat/zlib/contrib/ada/cmake/compile_helper.cmake vendored Normal file
View file

@ -0,0 +1,32 @@
#CMAKE_ARGV0 = /path/to/cmake
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = path/to/this/file
#CMAKE_ARGV3 = compiler
#CMAKE_ARGV4 = OBJECT-DIR
#CMAKE_ARGV5 = source-file
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "compiler not set")
endif(NOT CMAKE_ARGV3)
if(NOT CMAKE_ARGV4)
message(FATAL_ERROR "object dir not set")
endif(NOT CMAKE_ARGV4)
if(NOT CMAKE_ARGV5)
message(FATAL_ERROR "source not set")
endif(NOT CMAKE_ARGV5)
foreach(arg RANGE 6 ${CMAKE_ARGC})
list(APPEND FLAGS "${CMAKE_ARGV${arg}}")
endforeach(arg RANGE 6 ${CMAKE_ARGC})
execute_process(COMMAND ${CMAKE_ARGV3} compile ${FLAGS} ${CMAKE_ARGV5}
WORKING_DIRECTORY ${CMAKE_ARGV4}
RESULT_VARIABLE RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
if(RESULT)
message(FATAL_ERROR ${RESULT} ${ERROR})
endif(RESULT)

53
vendor/tcl/compat/zlib/contrib/ada/cmake/exe_link_helper.cmake vendored Normal file
View file

@ -0,0 +1,53 @@
#CMAKE_ARGV0 = /path/to/cmake
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = path/to/this/file
#CMAKE_ARGV3 = linker
#CMAKE_ARGV4 = output-name
#CMAKE_ARGV5...CMAKE_AGVN = OBJECTS
#CMAKE_ARGVN+1 = LIBS
#CMAKE_ARGVN+2...CMAKE_ARGVM libraries
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "linker not set")
endif(NOT CMAKE_ARGV3)
set(REACHED_LIBS FALSE)
set(REACHED_OBJ FALSE)
foreach(arg RANGE 5 ${CMAKE_ARGC})
if(CMAKE_ARGV${arg} STREQUAL LIBS)
set(REACHED_LIBS TRUE)
set(REACHED_OBJ FALSE)
continue()
endif(CMAKE_ARGV${arg} STREQUAL LIBS)
if(CMAKE_ARGV${arg} STREQUAL OBJ)
set(REACHED_LIBS FALSE)
set(REACHED_OBJ TRUE)
continue()
endif(CMAKE_ARGV${arg} STREQUAL OBJ)
if(CMAKE_ARGC EQUAL arg)
continue()
endif(CMAKE_ARGC EQUAL arg)
if(REACHED_LIBS)
list(APPEND LIBS "${CMAKE_ARGV${arg}}")
elseif(REACHED_OBJ AND NOT ALI)
string(REPLACE ".o" ".ali" ALI "${CMAKE_ARGV${arg}}")
else(REACHED_LIBS)
string(SUBSTRING "${CMAKE_ARGV${arg}}" 0 3 start)
if(NOT start STREQUAL -aO)
list(APPEND FLAGS "${CMAKE_ARGV${arg}}")
endif(NOT start STREQUAL -aO)
endif(REACHED_LIBS)
endforeach(arg RANGE 5 ${CMAKE_ARGC})
execute_process(COMMAND ${CMAKE_ARGV3} link ${ALI} -o ${CMAKE_ARGV4} ${FLAGS} ${OTHER_OBJECTS} ${LIBS}
RESULT_VARIABLE RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
if(RESULT)
message(FATAL_ERROR ${RESULT} ${ERROR})
endif(RESULT)

52
vendor/tcl/compat/zlib/contrib/ada/cmake/shared_link_helper.cmake vendored Normal file
View file

@ -0,0 +1,52 @@
#CMAKE_ARGV0 = /path/to/cmake
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = path/to/this/file
#CMAKE_ARGV3 = linker
#CMAKE_ARGV4 = output-name
#CMAKE_ARGV5...CMAKE_AGVN = OBJECTS
#CMAKE_ARGVN+1 = LIBS
#CMAKE_ARGVN+2...CMAKE_ARGVM libraries
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "linker not set")
endif(NOT CMAKE_ARGV3)
set(REACHED_FILES FALSE)
foreach(arg RANGE 5 ${CMAKE_ARGC})
if(CMAKE_ARGV${arg} STREQUAL "LIBS")
set(REACHED_FILES TRUE)
continue()
endif(CMAKE_ARGV${arg} STREQUAL "LIBS")
if(CMAKE_ARGC EQUAL arg)
continue()
endif(CMAKE_ARGC EQUAL arg)
if(REACHED_LIBS)
list(APPEND LIBS "${CMAKE_ARGV${arg}} ")
else(REACHED_LIBS)
list(APPEND OBJECT_FILES "${CMAKE_ARGV${arg}}")
endif(REACHED_LIBS)
endforeach(arg RANGE 5 ${CMAKE_ARGC})
file(WRITE dummylib.adb
"procedure dummylib is\n"
"begin\n"
" null;\n"
"end;\n")
execute_process(COMMAND ${CMAKE_ARGV3} compile -fPIC dummylib.adb
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
execute_process(COMMAND ${CMAKE_ARGV3} bind -n dummylib.ali
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
execute_process(COMMAND ${CMAKE_ARGV3} link -shared dummylib.ali -o ${CMAKE_ARGV4} ${OBJECT_FILES} ${LIBS}
RESULT_VARIABLE RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
if(RESULT)
message(FATAL_ERROR ${RESULT} ${ERROR})
endif(RESULT)

25
vendor/tcl/compat/zlib/contrib/ada/cmake/static_link_helper.cmake vendored Normal file
View file

@ -0,0 +1,25 @@
#CMAKE_ARGV0 = /path/to/cmake
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = path/to/this/file
#CMAKE_ARGV3 = path/to/ar
#CMAKE_ARGV4 = output-name
#CMAKE_ARGV5...CMAKE_AGVN = OBJECTS
if(NOT CMAKE_ARGV3)
message(FATAL_ERROR "linker not set")
endif(NOT CMAKE_ARGV3)
foreach(arg RANGE 5 ${CMAKE_ARGC})
if(NOT CMAKE_ARGC EQUAL arg)
list(APPEND OBJECT_FILES "${CMAKE_ARGV${arg}}")
endif(NOT CMAKE_ARGC EQUAL arg)
endforeach(arg RANGE 6 ${CMAKE_ARGC})
execute_process(COMMAND ${CMAKE_ARGV3} rcs ${CMAKE_ARGV4} ${OBJECT_FILES}
RESULT_VARIABLE RESULT
OUTPUT_VARIABLE dont_care
ERROR_VARIABLE ERROR)
if(RESULT)
message(FATAL_ERROR ${RESULT} ${ERROR})
endif(RESULT)

156
vendor/tcl/compat/zlib/contrib/ada/mtest.adb vendored Normal file
View file

@ -0,0 +1,156 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- Continuous test for ZLib multithreading. If the test would fail
-- we should provide thread safe allocation routines for the Z_Stream.
--
-- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $
with ZLib;
with Ada.Streams;
with Ada.Numerics.Discrete_Random;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Task_Identification;
procedure MTest is
use Ada.Streams;
use ZLib;
Stop : Boolean := False;
pragma Atomic (Stop);
subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
package Random_Elements is
new Ada.Numerics.Discrete_Random (Visible_Symbols);
task type Test_Task;
task body Test_Task is
Buffer : Stream_Element_Array (1 .. 100_000);
Gen : Random_Elements.Generator;
Buffer_First : Stream_Element_Offset;
Compare_First : Stream_Element_Offset;
Deflate : Filter_Type;
Inflate : Filter_Type;
procedure Further (Item : in Stream_Element_Array);
procedure Read_Buffer
(Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-------------
-- Further --
-------------
procedure Further (Item : in Stream_Element_Array) is
procedure Compare (Item : in Stream_Element_Array);
-------------
-- Compare --
-------------
procedure Compare (Item : in Stream_Element_Array) is
Next_First : Stream_Element_Offset := Compare_First + Item'Length;
begin
if Buffer (Compare_First .. Next_First - 1) /= Item then
raise Program_Error;
end if;
Compare_First := Next_First;
end Compare;
procedure Compare_Write is new ZLib.Write (Write => Compare);
begin
Compare_Write (Inflate, Item, No_Flush);
end Further;
-----------------
-- Read_Buffer --
-----------------
procedure Read_Buffer
(Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset)
is
Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;
Next_First : Stream_Element_Offset;
begin
if Item'Length <= Buff_Diff then
Last := Item'Last;
Next_First := Buffer_First + Item'Length;
Item := Buffer (Buffer_First .. Next_First - 1);
Buffer_First := Next_First;
else
Last := Item'First + Buff_Diff;
Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
Buffer_First := Buffer'Last + 1;
end if;
end Read_Buffer;
procedure Translate is new Generic_Translate
(Data_In => Read_Buffer,
Data_Out => Further);
begin
Random_Elements.Reset (Gen);
Buffer := (others => 20);
Main : loop
for J in Buffer'Range loop
Buffer (J) := Random_Elements.Random (Gen);
Deflate_Init (Deflate);
Inflate_Init (Inflate);
Buffer_First := Buffer'First;
Compare_First := Buffer'First;
Translate (Deflate);
if Compare_First /= Buffer'Last + 1 then
raise Program_Error;
end if;
Ada.Text_IO.Put_Line
(Ada.Task_Identification.Image
(Ada.Task_Identification.Current_Task)
& Stream_Element_Offset'Image (J)
& ZLib.Count'Image (Total_Out (Deflate)));
Close (Deflate);
Close (Inflate);
exit Main when Stop;
end loop;
end loop Main;
exception
when E : others =>
Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
Stop := True;
end Test_Task;
Test : array (1 .. 4) of Test_Task;
pragma Unreferenced (Test);
Dummy : Character;
begin
Ada.Text_IO.Get_Immediate (Dummy);
Stop := True;
end MTest;

156
vendor/tcl/compat/zlib/contrib/ada/read.adb vendored Normal file
View file

@ -0,0 +1,156 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $
-- Test/demo program for the generic read interface.
with Ada.Numerics.Discrete_Random;
with Ada.Streams;
with Ada.Text_IO;
with ZLib;
procedure Read is
use Ada.Streams;
------------------------------------
-- Test configuration parameters --
------------------------------------
File_Size : Stream_Element_Offset := 100_000;
Continuous : constant Boolean := False;
-- If this constant is True, the test would be repeated again and again,
-- with increment File_Size for every iteration.
Header : constant ZLib.Header_Type := ZLib.Default;
-- Do not use Header other than Default in ZLib versions 1.1.4 and older.
Init_Random : constant := 8;
-- We are using the same random sequence, in case of we catch bug,
-- so we would be able to reproduce it.
-- End --
Pack_Size : Stream_Element_Offset;
Offset : Stream_Element_Offset;
Filter : ZLib.Filter_Type;
subtype Visible_Symbols
is Stream_Element range 16#20# .. 16#7E#;
package Random_Elements is new
Ada.Numerics.Discrete_Random (Visible_Symbols);
Gen : Random_Elements.Generator;
Period : constant Stream_Element_Offset := 200;
-- Period constant variable for random generator not to be very random.
-- Bigger period, harder random.
Read_Buffer : Stream_Element_Array (1 .. 2048);
Read_First : Stream_Element_Offset;
Read_Last : Stream_Element_Offset;
procedure Reset;
procedure Read
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- this procedure is for generic instantiation of
-- ZLib.Read
-- reading data from the File_In.
procedure Read is new ZLib.Read
(Read,
Read_Buffer,
Rest_First => Read_First,
Rest_Last => Read_Last);
----------
-- Read --
----------
procedure Read
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
Last := Stream_Element_Offset'Min
(Item'Last,
Item'First + File_Size - Offset);
for J in Item'First .. Last loop
if J < Item'First + Period then
Item (J) := Random_Elements.Random (Gen);
else
Item (J) := Item (J - Period);
end if;
Offset := Offset + 1;
end loop;
end Read;
-----------
-- Reset --
-----------
procedure Reset is
begin
Random_Elements.Reset (Gen, Init_Random);
Pack_Size := 0;
Offset := 1;
Read_First := Read_Buffer'Last + 1;
Read_Last := Read_Buffer'Last;
end Reset;
begin
Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
loop
for Level in ZLib.Compression_Level'Range loop
Ada.Text_IO.Put ("Level ="
& ZLib.Compression_Level'Image (Level));
-- Deflate using generic instantiation.
ZLib.Deflate_Init
(Filter,
Level,
Header => Header);
Reset;
Ada.Text_IO.Put
(Stream_Element_Offset'Image (File_Size) & " ->");
loop
declare
Buffer : Stream_Element_Array (1 .. 1024);
Last : Stream_Element_Offset;
begin
Read (Filter, Buffer, Last);
Pack_Size := Pack_Size + Last - Buffer'First + 1;
exit when Last < Buffer'Last;
end;
end loop;
Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
ZLib.Close (Filter);
end loop;
exit when not Continuous;
File_Size := File_Size + 1;
end loop;
end Read;

65
vendor/tcl/compat/zlib/contrib/ada/readme.txt vendored Normal file
View file

@ -0,0 +1,65 @@
ZLib for Ada thick binding (ZLib.Ada)
Release 1.3
ZLib.Ada is a thick binding interface to the popular ZLib data
compression library, available at https://zlib.net/.
It provides Ada-style access to the ZLib C library.
Here are the main changes since ZLib.Ada 1.2:
- Attention: ZLib.Read generic routine have a initialization requirement
for Read_Last parameter now. It is a bit incompatible with previous version,
but extends functionality, we could use new parameters Allow_Read_Some and
Flush now.
- Added Is_Open routines to ZLib and ZLib.Streams packages.
- Add pragma Assert to check Stream_Element is 8 bit.
- Fix extraction to buffer with exact known decompressed size. Error reported by
Steve Sangwine.
- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
computers. Patch provided by Pascal Obry.
- Add Status_Error exception definition.
- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.
How to build ZLib.Ada under GNAT
You should have the ZLib library already build on your computer, before
building ZLib.Ada. Make the directory of ZLib.Ada sources current and
issue the command:
gnatmake test -largs -L<directory where libz.a is> -lz
Or use the GNAT project file build for GNAT 3.15 or later:
gnatmake -Pzlib.gpr -L<directory where libz.a is>
How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2
1. Make a project with all *.ads and *.adb files from the distribution.
2. Build the libz.a library from the ZLib C sources.
3. Rename libz.a to z.lib.
4. Add the library z.lib to the project.
5. Add the libc.lib library from the ObjectAda distribution to the project.
6. Build the executable using test.adb as a main procedure.
How to use ZLib.Ada
The source files test.adb and read.adb are small demo programs that show
the main functionality of ZLib.Ada.
The routines from the package specifications are commented.
Homepage: https://zlib-ada.sourceforge.net/
Author: Dmitriy Anisimkov <anisimkov@yahoo.com>
Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk>

463
vendor/tcl/compat/zlib/contrib/ada/test.adb vendored Normal file
View file

@ -0,0 +1,463 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $
-- The program has a few aims.
-- 1. Test ZLib.Ada95 thick binding functionality.
-- 2. Show the example of use main functionality of the ZLib.Ada95 binding.
-- 3. Build this program automatically compile all ZLib.Ada95 packages under
-- GNAT Ada95 compiler.
with ZLib.Streams;
with Ada.Streams.Stream_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Text_IO;
with Ada.Calendar;
procedure Test is
use Ada.Streams;
use Stream_IO;
------------------------------------
-- Test configuration parameters --
------------------------------------
File_Size : Count := 100_000;
Continuous : constant Boolean := False;
Header : constant ZLib.Header_Type := ZLib.Default;
-- ZLib.None;
-- ZLib.Auto;
-- ZLib.GZip;
-- Do not use Header other then Default in ZLib versions 1.1.4
-- and older.
Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
Init_Random : constant := 10;
-- End --
In_File_Name : constant String := "testzlib.in";
-- Name of the input file
Z_File_Name : constant String := "testzlib.zlb";
-- Name of the compressed file.
Out_File_Name : constant String := "testzlib.out";
-- Name of the decompressed file.
File_In : File_Type;
File_Out : File_Type;
File_Back : File_Type;
File_Z : ZLib.Streams.Stream_Type;
Filter : ZLib.Filter_Type;
Time_Stamp : Ada.Calendar.Time;
procedure Generate_File;
-- Generate file of specified size with some random data.
-- The random data is repeatable, for the good compression.
procedure Compare_Streams
(Left, Right : in out Root_Stream_Type'Class);
-- The procedure comparing data in 2 streams.
-- It is for compare data before and after compression/decompression.
procedure Compare_Files (Left, Right : String);
-- Compare files. Based on the Compare_Streams.
procedure Copy_Streams
(Source, Target : in out Root_Stream_Type'Class;
Buffer_Size : in Stream_Element_Offset := 1024);
-- Copying data from one stream to another. It is for test stream
-- interface of the library.
procedure Data_In
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- this procedure is for generic instantiation of
-- ZLib.Generic_Translate.
-- reading data from the File_In.
procedure Data_Out (Item : in Stream_Element_Array);
-- this procedure is for generic instantiation of
-- ZLib.Generic_Translate.
-- writing data to the File_Out.
procedure Stamp;
-- Store the timestamp to the local variable.
procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
-- Print the time statistic with the message.
procedure Translate is new ZLib.Generic_Translate
(Data_In => Data_In,
Data_Out => Data_Out);
-- This procedure is moving data from File_In to File_Out
-- with compression or decompression, depend on initialization of
-- Filter parameter.
-------------------
-- Compare_Files --
-------------------
procedure Compare_Files (Left, Right : String) is
Left_File, Right_File : File_Type;
begin
Open (Left_File, In_File, Left);
Open (Right_File, In_File, Right);
Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
Close (Left_File);
Close (Right_File);
end Compare_Files;
---------------------
-- Compare_Streams --
---------------------
procedure Compare_Streams
(Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
is
Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
Left_Last, Right_Last : Stream_Element_Offset;
begin
loop
Read (Left, Left_Buffer, Left_Last);
Read (Right, Right_Buffer, Right_Last);
if Left_Last /= Right_Last then
Ada.Text_IO.Put_Line ("Compare error :"
& Stream_Element_Offset'Image (Left_Last)
& " /= "
& Stream_Element_Offset'Image (Right_Last));
raise Constraint_Error;
elsif Left_Buffer (0 .. Left_Last)
/= Right_Buffer (0 .. Right_Last)
then
Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
raise Constraint_Error;
end if;
exit when Left_Last < Left_Buffer'Last;
end loop;
end Compare_Streams;
------------------
-- Copy_Streams --
------------------
procedure Copy_Streams
(Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
Buffer_Size : in Stream_Element_Offset := 1024)
is
Buffer : Stream_Element_Array (1 .. Buffer_Size);
Last : Stream_Element_Offset;
begin
loop
Read (Source, Buffer, Last);
Write (Target, Buffer (1 .. Last));
exit when Last < Buffer'Last;
end loop;
end Copy_Streams;
-------------
-- Data_In --
-------------
procedure Data_In
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
Read (File_In, Item, Last);
end Data_In;
--------------
-- Data_Out --
--------------
procedure Data_Out (Item : in Stream_Element_Array) is
begin
Write (File_Out, Item);
end Data_Out;
-------------------
-- Generate_File --
-------------------
procedure Generate_File is
subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
package Random_Elements is
new Ada.Numerics.Discrete_Random (Visible_Symbols);
Gen : Random_Elements.Generator;
Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
Buffer_Count : constant Count := File_Size / Buffer'Length;
-- Number of same buffers in the packet.
Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
procedure Fill_Buffer (J, D : in Count);
-- Change the part of the buffer.
-----------------
-- Fill_Buffer --
-----------------
procedure Fill_Buffer (J, D : in Count) is
begin
for K in 0 .. D loop
Buffer
(Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
:= Random_Elements.Random (Gen);
end loop;
end Fill_Buffer;
begin
Random_Elements.Reset (Gen, Init_Random);
Create (File_In, Out_File, In_File_Name);
Fill_Buffer (1, Buffer'Length - 2);
for J in 1 .. Buffer_Count loop
Write (File_In, Buffer);
Fill_Buffer (J, Density);
end loop;
-- fill remain size.
Write
(File_In,
Buffer
(1 .. Stream_Element_Offset
(File_Size - Buffer'Length * Buffer_Count)));
Flush (File_In);
Close (File_In);
end Generate_File;
---------------------
-- Print_Statistic --
---------------------
procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
use Ada.Calendar;
use Ada.Text_IO;
package Count_IO is new Integer_IO (ZLib.Count);
Curr_Dur : Duration := Clock - Time_Stamp;
begin
Put (Msg);
Set_Col (20);
Ada.Text_IO.Put ("size =");
Count_IO.Put
(Data_Size,
Width => Stream_IO.Count'Image (File_Size)'Length);
Put_Line (" duration =" & Duration'Image (Curr_Dur));
end Print_Statistic;
-----------
-- Stamp --
-----------
procedure Stamp is
begin
Time_Stamp := Ada.Calendar.Clock;
end Stamp;
begin
Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
loop
Generate_File;
for Level in ZLib.Compression_Level'Range loop
Ada.Text_IO.Put_Line ("Level ="
& ZLib.Compression_Level'Image (Level));
-- Test generic interface.
Open (File_In, In_File, In_File_Name);
Create (File_Out, Out_File, Z_File_Name);
Stamp;
-- Deflate using generic instantiation.
ZLib.Deflate_Init
(Filter => Filter,
Level => Level,
Strategy => Strategy,
Header => Header);
Translate (Filter);
Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
ZLib.Close (Filter);
Close (File_In);
Close (File_Out);
Open (File_In, In_File, Z_File_Name);
Create (File_Out, Out_File, Out_File_Name);
Stamp;
-- Inflate using generic instantiation.
ZLib.Inflate_Init (Filter, Header => Header);
Translate (Filter);
Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
ZLib.Close (Filter);
Close (File_In);
Close (File_Out);
Compare_Files (In_File_Name, Out_File_Name);
-- Test stream interface.
-- Compress to the back stream.
Open (File_In, In_File, In_File_Name);
Create (File_Back, Out_File, Z_File_Name);
Stamp;
ZLib.Streams.Create
(Stream => File_Z,
Mode => ZLib.Streams.Out_Stream,
Back => ZLib.Streams.Stream_Access
(Stream (File_Back)),
Back_Compressed => True,
Level => Level,
Strategy => Strategy,
Header => Header);
Copy_Streams
(Source => Stream (File_In).all,
Target => File_Z);
-- Flushing internal buffers to the back stream.
ZLib.Streams.Flush (File_Z, ZLib.Finish);
Print_Statistic ("Write compress",
ZLib.Streams.Write_Total_Out (File_Z));
ZLib.Streams.Close (File_Z);
Close (File_In);
Close (File_Back);
-- Compare reading from original file and from
-- decompression stream.
Open (File_In, In_File, In_File_Name);
Open (File_Back, In_File, Z_File_Name);
ZLib.Streams.Create
(Stream => File_Z,
Mode => ZLib.Streams.In_Stream,
Back => ZLib.Streams.Stream_Access
(Stream (File_Back)),
Back_Compressed => True,
Header => Header);
Stamp;
Compare_Streams (Stream (File_In).all, File_Z);
Print_Statistic ("Read decompress",
ZLib.Streams.Read_Total_Out (File_Z));
ZLib.Streams.Close (File_Z);
Close (File_In);
Close (File_Back);
-- Compress by reading from compression stream.
Open (File_Back, In_File, In_File_Name);
Create (File_Out, Out_File, Z_File_Name);
ZLib.Streams.Create
(Stream => File_Z,
Mode => ZLib.Streams.In_Stream,
Back => ZLib.Streams.Stream_Access
(Stream (File_Back)),
Back_Compressed => False,
Level => Level,
Strategy => Strategy,
Header => Header);
Stamp;
Copy_Streams
(Source => File_Z,
Target => Stream (File_Out).all);
Print_Statistic ("Read compress",
ZLib.Streams.Read_Total_Out (File_Z));
ZLib.Streams.Close (File_Z);
Close (File_Out);
Close (File_Back);
-- Decompress to decompression stream.
Open (File_In, In_File, Z_File_Name);
Create (File_Back, Out_File, Out_File_Name);
ZLib.Streams.Create
(Stream => File_Z,
Mode => ZLib.Streams.Out_Stream,
Back => ZLib.Streams.Stream_Access
(Stream (File_Back)),
Back_Compressed => False,
Header => Header);
Stamp;
Copy_Streams
(Source => Stream (File_In).all,
Target => File_Z);
Print_Statistic ("Write decompress",
ZLib.Streams.Write_Total_Out (File_Z));
ZLib.Streams.Close (File_Z);
Close (File_In);
Close (File_Back);
Compare_Files (In_File_Name, Out_File_Name);
end loop;
Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
exit when not Continuous;
File_Size := File_Size + 1;
end loop;
end Test;

225
vendor/tcl/compat/zlib/contrib/ada/zlib-streams.adb vendored Normal file
View file

@ -0,0 +1,225 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $
with Ada.Unchecked_Deallocation;
package body ZLib.Streams is
-----------
-- Close --
-----------
procedure Close (Stream : in out Stream_Type) is
procedure Free is new Ada.Unchecked_Deallocation
(Stream_Element_Array, Buffer_Access);
begin
if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
-- We should flush the data written by the writer.
Flush (Stream, Finish);
Close (Stream.Writer);
end if;
if Stream.Mode = In_Stream or Stream.Mode = Duplex then
Close (Stream.Reader);
Free (Stream.Buffer);
end if;
end Close;
------------
-- Create --
------------
procedure Create
(Stream : out Stream_Type;
Mode : in Stream_Mode;
Back : in Stream_Access;
Back_Compressed : in Boolean;
Level : in Compression_Level := Default_Compression;
Strategy : in Strategy_Type := Default_Strategy;
Header : in Header_Type := Default;
Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
:= Default_Buffer_Size;
Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
:= Default_Buffer_Size)
is
subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);
procedure Init_Filter
(Filter : in out Filter_Type;
Compress : in Boolean);
-----------------
-- Init_Filter --
-----------------
procedure Init_Filter
(Filter : in out Filter_Type;
Compress : in Boolean) is
begin
if Compress then
Deflate_Init
(Filter, Level, Strategy, Header => Header);
else
Inflate_Init (Filter, Header => Header);
end if;
end Init_Filter;
begin
Stream.Back := Back;
Stream.Mode := Mode;
if Mode = Out_Stream or Mode = Duplex then
Init_Filter (Stream.Writer, Back_Compressed);
Stream.Buffer_Size := Write_Buffer_Size;
else
Stream.Buffer_Size := 0;
end if;
if Mode = In_Stream or Mode = Duplex then
Init_Filter (Stream.Reader, not Back_Compressed);
Stream.Buffer := new Buffer_Subtype;
Stream.Rest_First := Stream.Buffer'Last + 1;
Stream.Rest_Last := Stream.Buffer'Last;
end if;
end Create;
-----------
-- Flush --
-----------
procedure Flush
(Stream : in out Stream_Type;
Mode : in Flush_Mode := Sync_Flush)
is
Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
Last : Stream_Element_Offset;
begin
loop
Flush (Stream.Writer, Buffer, Last, Mode);
Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));
exit when Last < Buffer'Last;
end loop;
end Flush;
-------------
-- Is_Open --
-------------
function Is_Open (Stream : Stream_Type) return Boolean is
begin
return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
end Is_Open;
----------
-- Read --
----------
procedure Read
(Stream : in out Stream_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
procedure Read
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
----------
-- Read --
----------
procedure Read
(Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
Ada.Streams.Read (Stream.Back.all, Item, Last);
end Read;
procedure Read is new ZLib.Read
(Read => Read,
Buffer => Stream.Buffer.all,
Rest_First => Stream.Rest_First,
Rest_Last => Stream.Rest_Last);
begin
Read (Stream.Reader, Item, Last);
end Read;
-------------------
-- Read_Total_In --
-------------------
function Read_Total_In (Stream : in Stream_Type) return Count is
begin
return Total_In (Stream.Reader);
end Read_Total_In;
--------------------
-- Read_Total_Out --
--------------------
function Read_Total_Out (Stream : in Stream_Type) return Count is
begin
return Total_Out (Stream.Reader);
end Read_Total_Out;
-----------
-- Write --
-----------
procedure Write
(Stream : in out Stream_Type;
Item : in Stream_Element_Array)
is
procedure Write (Item : in Stream_Element_Array);
-----------
-- Write --
-----------
procedure Write (Item : in Stream_Element_Array) is
begin
Ada.Streams.Write (Stream.Back.all, Item);
end Write;
procedure Write is new ZLib.Write
(Write => Write,
Buffer_Size => Stream.Buffer_Size);
begin
Write (Stream.Writer, Item, No_Flush);
end Write;
--------------------
-- Write_Total_In --
--------------------
function Write_Total_In (Stream : in Stream_Type) return Count is
begin
return Total_In (Stream.Writer);
end Write_Total_In;
---------------------
-- Write_Total_Out --
---------------------
function Write_Total_Out (Stream : in Stream_Type) return Count is
begin
return Total_Out (Stream.Writer);
end Write_Total_Out;
end ZLib.Streams;

114
vendor/tcl/compat/zlib/contrib/ada/zlib-streams.ads vendored Normal file
View file

@ -0,0 +1,114 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $
package ZLib.Streams is
type Stream_Mode is (In_Stream, Out_Stream, Duplex);
type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
type Stream_Type is
new Ada.Streams.Root_Stream_Type with private;
procedure Read
(Stream : in out Stream_Type;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
procedure Write
(Stream : in out Stream_Type;
Item : in Ada.Streams.Stream_Element_Array);
procedure Flush
(Stream : in out Stream_Type;
Mode : in Flush_Mode := Sync_Flush);
-- Flush the written data to the back stream,
-- all data placed to the compressor is flushing to the Back stream.
-- Should not be used until necessary, because it is decreasing
-- compression.
function Read_Total_In (Stream : in Stream_Type) return Count;
pragma Inline (Read_Total_In);
-- Return total number of bytes read from back stream so far.
function Read_Total_Out (Stream : in Stream_Type) return Count;
pragma Inline (Read_Total_Out);
-- Return total number of bytes read so far.
function Write_Total_In (Stream : in Stream_Type) return Count;
pragma Inline (Write_Total_In);
-- Return total number of bytes written so far.
function Write_Total_Out (Stream : in Stream_Type) return Count;
pragma Inline (Write_Total_Out);
-- Return total number of bytes written to the back stream.
procedure Create
(Stream : out Stream_Type;
Mode : in Stream_Mode;
Back : in Stream_Access;
Back_Compressed : in Boolean;
Level : in Compression_Level := Default_Compression;
Strategy : in Strategy_Type := Default_Strategy;
Header : in Header_Type := Default;
Read_Buffer_Size : in Ada.Streams.Stream_Element_Offset
:= Default_Buffer_Size;
Write_Buffer_Size : in Ada.Streams.Stream_Element_Offset
:= Default_Buffer_Size);
-- Create the Compression/Decompression stream.
-- If mode is In_Stream then Write operation is disabled.
-- If mode is Out_Stream then Read operation is disabled.
-- If Back_Compressed is true then
-- Data written to the Stream is compressing to the Back stream
-- and data read from the Stream is decompressed data from the Back stream.
-- If Back_Compressed is false then
-- Data written to the Stream is decompressing to the Back stream
-- and data read from the Stream is compressed data from the Back stream.
-- !!! When the Need_Header is False ZLib-Ada is using undocumented
-- ZLib 1.1.4 functionality to do not create/wait for ZLib headers.
function Is_Open (Stream : Stream_Type) return Boolean;
procedure Close (Stream : in out Stream_Type);
private
use Ada.Streams;
type Buffer_Access is access all Stream_Element_Array;
type Stream_Type
is new Root_Stream_Type with
record
Mode : Stream_Mode;
Buffer : Buffer_Access;
Rest_First : Stream_Element_Offset;
Rest_Last : Stream_Element_Offset;
-- Buffer for Read operation.
-- We need to have this buffer in the record
-- because not all read data from back stream
-- could be processed during the read operation.
Buffer_Size : Stream_Element_Offset;
-- Buffer size for write operation.
-- We do not need to have this buffer
-- in the record because all data could be
-- processed in the write operation.
Back : Stream_Access;
Reader : Filter_Type;
Writer : Filter_Type;
end record;
end ZLib.Streams;

142
vendor/tcl/compat/zlib/contrib/ada/zlib-thin.adb vendored Normal file
View file

@ -0,0 +1,142 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $
package body ZLib.Thin is
ZLIB_VERSION : constant Chars_Ptr := zlibVersion;
Dummy : Z_Stream;
Z_Stream_Size : constant Int := Dummy'Size / System.Storage_Unit;
--------------
-- Avail_In --
--------------
function Avail_In (Strm : in Z_Stream) return UInt is
begin
return Strm.Avail_In;
end Avail_In;
---------------
-- Avail_Out --
---------------
function Avail_Out (Strm : in Z_Stream) return UInt is
begin
return Strm.Avail_Out;
end Avail_Out;
------------------
-- Deflate_Init --
------------------
function Deflate_Init
(strm : Z_Streamp;
level : Int;
method : Int;
windowBits : Int;
memLevel : Int;
strategy : Int)
return Int is
begin
return deflateInit2
(strm,
level,
method,
windowBits,
memLevel,
strategy,
ZLIB_VERSION,
Z_Stream_Size);
end Deflate_Init;
------------------
-- Inflate_Init --
------------------
function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
begin
return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
end Inflate_Init;
------------------------
-- Last_Error_Message --
------------------------
function Last_Error_Message (Strm : in Z_Stream) return String is
use Interfaces.C.Strings;
begin
if Strm.msg = Null_Ptr then
return "";
else
return Value (Strm.msg);
end if;
end Last_Error_Message;
------------
-- Set_In --
------------
procedure Set_In
(Strm : in out Z_Stream;
Buffer : in Voidp;
Size : in UInt) is
begin
Strm.Next_In := Buffer;
Strm.Avail_In := Size;
end Set_In;
------------------
-- Set_Mem_Func --
------------------
procedure Set_Mem_Func
(Strm : in out Z_Stream;
Opaque : in Voidp;
Alloc : in alloc_func;
Free : in free_func) is
begin
Strm.opaque := Opaque;
Strm.zalloc := Alloc;
Strm.zfree := Free;
end Set_Mem_Func;
-------------
-- Set_Out --
-------------
procedure Set_Out
(Strm : in out Z_Stream;
Buffer : in Voidp;
Size : in UInt) is
begin
Strm.Next_Out := Buffer;
Strm.Avail_Out := Size;
end Set_Out;
--------------
-- Total_In --
--------------
function Total_In (Strm : in Z_Stream) return ULong is
begin
return Strm.Total_In;
end Total_In;
---------------
-- Total_Out --
---------------
function Total_Out (Strm : in Z_Stream) return ULong is
begin
return Strm.Total_Out;
end Total_Out;
end ZLib.Thin;

450
vendor/tcl/compat/zlib/contrib/ada/zlib-thin.ads vendored Normal file
View file

@ -0,0 +1,450 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2003 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $
with Interfaces.C.Strings;
with System;
private package ZLib.Thin is
-- From zconf.h
MAX_MEM_LEVEL : constant := 9; -- zconf.h:105
-- zconf.h:105
MAX_WBITS : constant := 15; -- zconf.h:115
-- 32K LZ77 window
-- zconf.h:115
SEEK_SET : constant := 8#0000#; -- zconf.h:244
-- Seek from beginning of file.
-- zconf.h:244
SEEK_CUR : constant := 1; -- zconf.h:245
-- Seek from current position.
-- zconf.h:245
SEEK_END : constant := 2; -- zconf.h:246
-- Set file pointer to EOF plus "offset"
-- zconf.h:246
type Byte is new Interfaces.C.unsigned_char; -- 8 bits
-- zconf.h:214
type UInt is new Interfaces.C.unsigned; -- 16 bits or more
-- zconf.h:216
type Int is new Interfaces.C.int;
type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more
-- zconf.h:217
subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;
type ULong_Access is access ULong;
type Int_Access is access Int;
subtype Voidp is System.Address; -- zconf.h:232
subtype Byte_Access is Voidp;
Nul : constant Voidp := System.Null_Address;
-- end from zconf
Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125
-- zlib.h:125
Z_PARTIAL_FLUSH : constant := 1; -- zlib.h:126
-- will be removed, use
-- Z_SYNC_FLUSH instead
-- zlib.h:126
Z_SYNC_FLUSH : constant := 2; -- zlib.h:127
-- zlib.h:127
Z_FULL_FLUSH : constant := 3; -- zlib.h:128
-- zlib.h:128
Z_FINISH : constant := 4; -- zlib.h:129
-- zlib.h:129
Z_OK : constant := 8#0000#; -- zlib.h:132
-- zlib.h:132
Z_STREAM_END : constant := 1; -- zlib.h:133
-- zlib.h:133
Z_NEED_DICT : constant := 2; -- zlib.h:134
-- zlib.h:134
Z_ERRNO : constant := -1; -- zlib.h:135
-- zlib.h:135
Z_STREAM_ERROR : constant := -2; -- zlib.h:136
-- zlib.h:136
Z_DATA_ERROR : constant := -3; -- zlib.h:137
-- zlib.h:137
Z_MEM_ERROR : constant := -4; -- zlib.h:138
-- zlib.h:138
Z_BUF_ERROR : constant := -5; -- zlib.h:139
-- zlib.h:139
Z_VERSION_ERROR : constant := -6; -- zlib.h:140
-- zlib.h:140
Z_NO_COMPRESSION : constant := 8#0000#; -- zlib.h:145
-- zlib.h:145
Z_BEST_SPEED : constant := 1; -- zlib.h:146
-- zlib.h:146
Z_BEST_COMPRESSION : constant := 9; -- zlib.h:147
-- zlib.h:147
Z_DEFAULT_COMPRESSION : constant := -1; -- zlib.h:148
-- zlib.h:148
Z_FILTERED : constant := 1; -- zlib.h:151
-- zlib.h:151
Z_HUFFMAN_ONLY : constant := 2; -- zlib.h:152
-- zlib.h:152
Z_DEFAULT_STRATEGY : constant := 8#0000#; -- zlib.h:153
-- zlib.h:153
Z_BINARY : constant := 8#0000#; -- zlib.h:156
-- zlib.h:156
Z_ASCII : constant := 1; -- zlib.h:157
-- zlib.h:157
Z_UNKNOWN : constant := 2; -- zlib.h:158
-- zlib.h:158
Z_DEFLATED : constant := 8; -- zlib.h:161
-- zlib.h:161
Z_NULL : constant := 8#0000#; -- zlib.h:164
-- for initializing zalloc, zfree, opaque
-- zlib.h:164
type gzFile is new Voidp; -- zlib.h:646
type Z_Stream is private;
type Z_Streamp is access all Z_Stream; -- zlib.h:89
type alloc_func is access function
(Opaque : Voidp;
Items : UInt;
Size : UInt)
return Voidp; -- zlib.h:63
type free_func is access procedure (opaque : Voidp; address : Voidp);
function zlibVersion return Chars_Ptr;
function Deflate (strm : Z_Streamp; flush : Int) return Int;
function DeflateEnd (strm : Z_Streamp) return Int;
function Inflate (strm : Z_Streamp; flush : Int) return Int;
function InflateEnd (strm : Z_Streamp) return Int;
function deflateSetDictionary
(strm : Z_Streamp;
dictionary : Byte_Access;
dictLength : UInt)
return Int;
function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
-- zlib.h:478
function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495
function deflateParams
(strm : Z_Streamp;
level : Int;
strategy : Int)
return Int; -- zlib.h:506
function inflateSetDictionary
(strm : Z_Streamp;
dictionary : Byte_Access;
dictLength : UInt)
return Int; -- zlib.h:548
function inflateSync (strm : Z_Streamp) return Int; -- zlib.h:565
function inflateReset (strm : Z_Streamp) return Int; -- zlib.h:580
function compress
(dest : Byte_Access;
destLen : ULong_Access;
source : Byte_Access;
sourceLen : ULong)
return Int; -- zlib.h:601
function compress2
(dest : Byte_Access;
destLen : ULong_Access;
source : Byte_Access;
sourceLen : ULong;
level : Int)
return Int; -- zlib.h:615
function uncompress
(dest : Byte_Access;
destLen : ULong_Access;
source : Byte_Access;
sourceLen : ULong)
return Int;
function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;
function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;
function gzsetparams
(file : gzFile;
level : Int;
strategy : Int)
return Int;
function gzread
(file : gzFile;
buf : Voidp;
len : UInt)
return Int;
function gzwrite
(file : in gzFile;
buf : in Voidp;
len : in UInt)
return Int;
function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;
function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;
function gzgets
(file : gzFile;
buf : Chars_Ptr;
len : Int)
return Chars_Ptr;
function gzputc (file : gzFile; char : Int) return Int;
function gzgetc (file : gzFile) return Int;
function gzflush (file : gzFile; flush : Int) return Int;
function gzseek
(file : gzFile;
offset : Int;
whence : Int)
return Int;
function gzrewind (file : gzFile) return Int;
function gztell (file : gzFile) return Int;
function gzeof (file : gzFile) return Int;
function gzclose (file : gzFile) return Int;
function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;
function adler32
(adler : ULong;
buf : Byte_Access;
len : UInt)
return ULong;
function crc32
(crc : ULong;
buf : Byte_Access;
len : UInt)
return ULong;
function deflateInit
(strm : Z_Streamp;
level : Int;
version : Chars_Ptr;
stream_size : Int)
return Int;
function deflateInit2
(strm : Z_Streamp;
level : Int;
method : Int;
windowBits : Int;
memLevel : Int;
strategy : Int;
version : Chars_Ptr;
stream_size : Int)
return Int;
function Deflate_Init
(strm : Z_Streamp;
level : Int;
method : Int;
windowBits : Int;
memLevel : Int;
strategy : Int)
return Int;
pragma Inline (Deflate_Init);
function inflateInit
(strm : Z_Streamp;
version : Chars_Ptr;
stream_size : Int)
return Int;
function inflateInit2
(strm : in Z_Streamp;
windowBits : in Int;
version : in Chars_Ptr;
stream_size : in Int)
return Int;
function inflateBackInit
(strm : in Z_Streamp;
windowBits : in Int;
window : in Byte_Access;
version : in Chars_Ptr;
stream_size : in Int)
return Int;
-- Size of window have to be 2**windowBits.
function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
pragma Inline (Inflate_Init);
function zError (err : Int) return Chars_Ptr;
function inflateSyncPoint (z : Z_Streamp) return Int;
function get_crc_table return ULong_Access;
-- Interface to the available fields of the z_stream structure.
-- The application must update next_in and avail_in when avail_in has
-- dropped to zero. It must update next_out and avail_out when avail_out
-- has dropped to zero. The application must initialize zalloc, zfree and
-- opaque before calling the init function.
procedure Set_In
(Strm : in out Z_Stream;
Buffer : in Voidp;
Size : in UInt);
pragma Inline (Set_In);
procedure Set_Out
(Strm : in out Z_Stream;
Buffer : in Voidp;
Size : in UInt);
pragma Inline (Set_Out);
procedure Set_Mem_Func
(Strm : in out Z_Stream;
Opaque : in Voidp;
Alloc : in alloc_func;
Free : in free_func);
pragma Inline (Set_Mem_Func);
function Last_Error_Message (Strm : in Z_Stream) return String;
pragma Inline (Last_Error_Message);
function Avail_Out (Strm : in Z_Stream) return UInt;
pragma Inline (Avail_Out);
function Avail_In (Strm : in Z_Stream) return UInt;
pragma Inline (Avail_In);
function Total_In (Strm : in Z_Stream) return ULong;
pragma Inline (Total_In);
function Total_Out (Strm : in Z_Stream) return ULong;
pragma Inline (Total_Out);
function inflateCopy
(dest : in Z_Streamp;
Source : in Z_Streamp)
return Int;
function compressBound (Source_Len : in ULong) return ULong;
function deflateBound
(Strm : in Z_Streamp;
Source_Len : in ULong)
return ULong;
function gzungetc (C : in Int; File : in gzFile) return Int;
function zlibCompileFlags return ULong;
private
type Z_Stream is record -- zlib.h:68
Next_In : Voidp := Nul; -- next input byte
Avail_In : UInt := 0; -- number of bytes available at next_in
Total_In : ULong := 0; -- total nb of input bytes read so far
Next_Out : Voidp := Nul; -- next output byte should be put there
Avail_Out : UInt := 0; -- remaining free space at next_out
Total_Out : ULong := 0; -- total nb of bytes output so far
msg : Chars_Ptr; -- last error message, NULL if no error
state : Voidp; -- not visible by applications
zalloc : alloc_func := null; -- used to allocate the internal state
zfree : free_func := null; -- used to free the internal state
opaque : Voidp; -- private data object passed to
-- zalloc and zfree
data_type : Int; -- best guess about the data type:
-- ascii or binary
adler : ULong; -- adler32 value of the uncompressed
-- data
reserved : ULong; -- reserved for future use
end record;
pragma Convention (C, Z_Stream);
pragma Import (C, zlibVersion, "zlibVersion");
pragma Import (C, Deflate, "deflate");
pragma Import (C, DeflateEnd, "deflateEnd");
pragma Import (C, Inflate, "inflate");
pragma Import (C, InflateEnd, "inflateEnd");
pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
pragma Import (C, deflateCopy, "deflateCopy");
pragma Import (C, deflateReset, "deflateReset");
pragma Import (C, deflateParams, "deflateParams");
pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
pragma Import (C, inflateSync, "inflateSync");
pragma Import (C, inflateReset, "inflateReset");
pragma Import (C, compress, "compress");
pragma Import (C, compress2, "compress2");
pragma Import (C, uncompress, "uncompress");
pragma Import (C, gzopen, "gzopen");
pragma Import (C, gzdopen, "gzdopen");
pragma Import (C, gzsetparams, "gzsetparams");
pragma Import (C, gzread, "gzread");
pragma Import (C, gzwrite, "gzwrite");
pragma Import (C, gzprintf, "gzprintf");
pragma Import (C, gzputs, "gzputs");
pragma Import (C, gzgets, "gzgets");
pragma Import (C, gzputc, "gzputc");
pragma Import (C, gzgetc, "gzgetc");
pragma Import (C, gzflush, "gzflush");
pragma Import (C, gzseek, "gzseek");
pragma Import (C, gzrewind, "gzrewind");
pragma Import (C, gztell, "gztell");
pragma Import (C, gzeof, "gzeof");
pragma Import (C, gzclose, "gzclose");
pragma Import (C, gzerror, "gzerror");
pragma Import (C, adler32, "adler32");
pragma Import (C, crc32, "crc32");
pragma Import (C, deflateInit, "deflateInit_");
pragma Import (C, inflateInit, "inflateInit_");
pragma Import (C, deflateInit2, "deflateInit2_");
pragma Import (C, inflateInit2, "inflateInit2_");
pragma Import (C, zError, "zError");
pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
pragma Import (C, get_crc_table, "get_crc_table");
-- since zlib 1.2.0:
pragma Import (C, inflateCopy, "inflateCopy");
pragma Import (C, compressBound, "compressBound");
pragma Import (C, deflateBound, "deflateBound");
pragma Import (C, gzungetc, "gzungetc");
pragma Import (C, zlibCompileFlags, "zlibCompileFlags");
pragma Import (C, inflateBackInit, "inflateBackInit_");
-- I stopped binding the inflateBack routines, because realize that
-- it does not support zlib and gzip headers for now, and have no
-- symmetric deflateBack routines.
-- ZLib-Ada is symmetric regarding deflate/inflate data transformation
-- and has a similar generic callback interface for the
-- deflate/inflate transformation based on the regular Deflate/Inflate
-- routines.
-- pragma Import (C, inflateBack, "inflateBack");
-- pragma Import (C, inflateBackEnd, "inflateBackEnd");
end ZLib.Thin;

701
vendor/tcl/compat/zlib/contrib/ada/zlib.adb vendored Normal file
View file

@ -0,0 +1,701 @@
----------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
-- --
-- Open source license information is in the zlib.ads file. --
----------------------------------------------------------------
-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C.Strings;
with ZLib.Thin;
package body ZLib is
use type Thin.Int;
type Z_Stream is new Thin.Z_Stream;
type Return_Code_Enum is
(OK,
STREAM_END,
NEED_DICT,
ERRNO,
STREAM_ERROR,
DATA_ERROR,
MEM_ERROR,
BUF_ERROR,
VERSION_ERROR);
type Flate_Step_Function is access
function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
pragma Convention (C, Flate_Step_Function);
type Flate_End_Function is access
function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
pragma Convention (C, Flate_End_Function);
type Flate_Type is record
Step : Flate_Step_Function;
Done : Flate_End_Function;
end record;
subtype Footer_Array is Stream_Element_Array (1 .. 8);
Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
:= (16#1f#, 16#8b#, -- Magic header
16#08#, -- Z_DEFLATED
16#00#, -- Flags
16#00#, 16#00#, 16#00#, 16#00#, -- Time
16#00#, -- XFlags
16#03# -- OS code
);
-- The simplest gzip header is not for informational, but just for
-- gzip format compatibility.
-- Note that some code below is using assumption
-- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
-- Simple_GZip_Header'Last <= Footer_Array'Last.
Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
:= (0 => OK,
1 => STREAM_END,
2 => NEED_DICT,
-1 => ERRNO,
-2 => STREAM_ERROR,
-3 => DATA_ERROR,
-4 => MEM_ERROR,
-5 => BUF_ERROR,
-6 => VERSION_ERROR);
Flate : constant array (Boolean) of Flate_Type
:= (True => (Step => Thin.Deflate'Access,
Done => Thin.DeflateEnd'Access),
False => (Step => Thin.Inflate'Access,
Done => Thin.InflateEnd'Access));
Flush_Finish : constant array (Boolean) of Flush_Mode
:= (True => Finish, False => No_Flush);
procedure Raise_Error (Stream : in Z_Stream);
pragma Inline (Raise_Error);
procedure Raise_Error (Message : in String);
pragma Inline (Raise_Error);
procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
procedure Free is new Ada.Unchecked_Deallocation
(Z_Stream, Z_Stream_Access);
function To_Thin_Access is new Ada.Unchecked_Conversion
(Z_Stream_Access, Thin.Z_Streamp);
procedure Translate_GZip
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode);
-- Separate translate routine for make gzip header.
procedure Translate_Auto
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode);
-- translate routine without additional headers.
-----------------
-- Check_Error --
-----------------
procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
use type Thin.Int;
begin
if Code /= Thin.Z_OK then
Raise_Error
(Return_Code_Enum'Image (Return_Code (Code))
& ": " & Last_Error_Message (Stream));
end if;
end Check_Error;
-----------
-- Close --
-----------
procedure Close
(Filter : in out Filter_Type;
Ignore_Error : in Boolean := False)
is
Code : Thin.Int;
begin
if not Ignore_Error and then not Is_Open (Filter) then
raise Status_Error;
end if;
Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
if Ignore_Error or else Code = Thin.Z_OK then
Free (Filter.Strm);
else
declare
Error_Message : constant String
:= Last_Error_Message (Filter.Strm.all);
begin
Free (Filter.Strm);
Ada.Exceptions.Raise_Exception
(ZLib_Error'Identity,
Return_Code_Enum'Image (Return_Code (Code))
& ": " & Error_Message);
end;
end if;
end Close;
-----------
-- CRC32 --
-----------
function CRC32
(CRC : in Unsigned_32;
Data : in Ada.Streams.Stream_Element_Array)
return Unsigned_32
is
use Thin;
begin
return Unsigned_32 (crc32 (ULong (CRC),
Data'Address,
Data'Length));
end CRC32;
procedure CRC32
(CRC : in out Unsigned_32;
Data : in Ada.Streams.Stream_Element_Array) is
begin
CRC := CRC32 (CRC, Data);
end CRC32;
------------------
-- Deflate_Init --
------------------
procedure Deflate_Init
(Filter : in out Filter_Type;
Level : in Compression_Level := Default_Compression;
Strategy : in Strategy_Type := Default_Strategy;
Method : in Compression_Method := Deflated;
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
Memory_Level : in Memory_Level_Type := Default_Memory_Level;
Header : in Header_Type := Default)
is
use type Thin.Int;
Win_Bits : Thin.Int := Thin.Int (Window_Bits);
begin
if Is_Open (Filter) then
raise Status_Error;
end if;
-- We allow ZLib to make header only in case of default header type.
-- Otherwise we would either do header by ourselves, or do not do
-- header at all.
if Header = None or else Header = GZip then
Win_Bits := -Win_Bits;
end if;
-- For the GZip CRC calculation and make headers.
if Header = GZip then
Filter.CRC := 0;
Filter.Offset := Simple_GZip_Header'First;
else
Filter.Offset := Simple_GZip_Header'Last + 1;
end if;
Filter.Strm := new Z_Stream;
Filter.Compression := True;
Filter.Stream_End := False;
Filter.Header := Header;
if Thin.Deflate_Init
(To_Thin_Access (Filter.Strm),
Level => Thin.Int (Level),
method => Thin.Int (Method),
windowBits => Win_Bits,
memLevel => Thin.Int (Memory_Level),
strategy => Thin.Int (Strategy)) /= Thin.Z_OK
then
Raise_Error (Filter.Strm.all);
end if;
end Deflate_Init;
-----------
-- Flush --
-----------
procedure Flush
(Filter : in out Filter_Type;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode)
is
No_Data : Stream_Element_Array := (1 .. 0 => 0);
Last : Stream_Element_Offset;
begin
Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
end Flush;
-----------------------
-- Generic_Translate --
-----------------------
procedure Generic_Translate
(Filter : in out ZLib.Filter_Type;
In_Buffer_Size : in Integer := Default_Buffer_Size;
Out_Buffer_Size : in Integer := Default_Buffer_Size)
is
In_Buffer : Stream_Element_Array
(1 .. Stream_Element_Offset (In_Buffer_Size));
Out_Buffer : Stream_Element_Array
(1 .. Stream_Element_Offset (Out_Buffer_Size));
Last : Stream_Element_Offset;
In_Last : Stream_Element_Offset;
In_First : Stream_Element_Offset;
Out_Last : Stream_Element_Offset;
begin
Main : loop
Data_In (In_Buffer, Last);
In_First := In_Buffer'First;
loop
Translate
(Filter => Filter,
In_Data => In_Buffer (In_First .. Last),
In_Last => In_Last,
Out_Data => Out_Buffer,
Out_Last => Out_Last,
Flush => Flush_Finish (Last < In_Buffer'First));
if Out_Buffer'First <= Out_Last then
Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
end if;
exit Main when Stream_End (Filter);
-- The end of in buffer.
exit when In_Last = Last;
In_First := In_Last + 1;
end loop;
end loop Main;
end Generic_Translate;
------------------
-- Inflate_Init --
------------------
procedure Inflate_Init
(Filter : in out Filter_Type;
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
Header : in Header_Type := Default)
is
use type Thin.Int;
Win_Bits : Thin.Int := Thin.Int (Window_Bits);
procedure Check_Version;
-- Check the latest header types compatibility.
procedure Check_Version is
begin
if Version <= "1.1.4" then
Raise_Error
("Inflate header type " & Header_Type'Image (Header)
& " incompatible with ZLib version " & Version);
end if;
end Check_Version;
begin
if Is_Open (Filter) then
raise Status_Error;
end if;
case Header is
when None =>
Check_Version;
-- Inflate data without headers determined
-- by negative Win_Bits.
Win_Bits := -Win_Bits;
when GZip =>
Check_Version;
-- Inflate gzip data defined by flag 16.
Win_Bits := Win_Bits + 16;
when Auto =>
Check_Version;
-- Inflate with automatic detection
-- of gzip or native header defined by flag 32.
Win_Bits := Win_Bits + 32;
when Default => null;
end case;
Filter.Strm := new Z_Stream;
Filter.Compression := False;
Filter.Stream_End := False;
Filter.Header := Header;
if Thin.Inflate_Init
(To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
then
Raise_Error (Filter.Strm.all);
end if;
end Inflate_Init;
-------------
-- Is_Open --
-------------
function Is_Open (Filter : in Filter_Type) return Boolean is
begin
return Filter.Strm /= null;
end Is_Open;
-----------------
-- Raise_Error --
-----------------
procedure Raise_Error (Message : in String) is
begin
Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
end Raise_Error;
procedure Raise_Error (Stream : in Z_Stream) is
begin
Raise_Error (Last_Error_Message (Stream));
end Raise_Error;
----------
-- Read --
----------
procedure Read
(Filter : in out Filter_Type;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode := No_Flush)
is
In_Last : Stream_Element_Offset;
Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
V_Flush : Flush_Mode := Flush;
begin
pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
loop
if Rest_Last = Buffer'First - 1 then
V_Flush := Finish;
elsif Rest_First > Rest_Last then
Read (Buffer, Rest_Last);
Rest_First := Buffer'First;
if Rest_Last < Buffer'First then
V_Flush := Finish;
end if;
end if;
Translate
(Filter => Filter,
In_Data => Buffer (Rest_First .. Rest_Last),
In_Last => In_Last,
Out_Data => Item (Item_First .. Item'Last),
Out_Last => Last,
Flush => V_Flush);
Rest_First := In_Last + 1;
exit when Stream_End (Filter)
or else Last = Item'Last
or else (Last >= Item'First and then Allow_Read_Some);
Item_First := Last + 1;
end loop;
end Read;
----------------
-- Stream_End --
----------------
function Stream_End (Filter : in Filter_Type) return Boolean is
begin
if Filter.Header = GZip and Filter.Compression then
return Filter.Stream_End
and then Filter.Offset = Footer_Array'Last + 1;
else
return Filter.Stream_End;
end if;
end Stream_End;
--------------
-- Total_In --
--------------
function Total_In (Filter : in Filter_Type) return Count is
begin
return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
end Total_In;
---------------
-- Total_Out --
---------------
function Total_Out (Filter : in Filter_Type) return Count is
begin
return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
end Total_Out;
---------------
-- Translate --
---------------
procedure Translate
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode) is
begin
if Filter.Header = GZip and then Filter.Compression then
Translate_GZip
(Filter => Filter,
In_Data => In_Data,
In_Last => In_Last,
Out_Data => Out_Data,
Out_Last => Out_Last,
Flush => Flush);
else
Translate_Auto
(Filter => Filter,
In_Data => In_Data,
In_Last => In_Last,
Out_Data => Out_Data,
Out_Last => Out_Last,
Flush => Flush);
end if;
end Translate;
--------------------
-- Translate_Auto --
--------------------
procedure Translate_Auto
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode)
is
use type Thin.Int;
Code : Thin.Int;
begin
if not Is_Open (Filter) then
raise Status_Error;
end if;
if Out_Data'Length = 0 and then In_Data'Length = 0 then
raise Constraint_Error;
end if;
Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
Code := Flate (Filter.Compression).Step
(To_Thin_Access (Filter.Strm),
Thin.Int (Flush));
if Code = Thin.Z_STREAM_END then
Filter.Stream_End := True;
else
Check_Error (Filter.Strm.all, Code);
end if;
In_Last := In_Data'Last
- Stream_Element_Offset (Avail_In (Filter.Strm.all));
Out_Last := Out_Data'Last
- Stream_Element_Offset (Avail_Out (Filter.Strm.all));
end Translate_Auto;
--------------------
-- Translate_GZip --
--------------------
procedure Translate_GZip
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode)
is
Out_First : Stream_Element_Offset;
procedure Add_Data (Data : in Stream_Element_Array);
-- Add data to stream from the Filter.Offset till necessary,
-- used for add gzip headr/footer.
procedure Put_32
(Item : in out Stream_Element_Array;
Data : in Unsigned_32);
pragma Inline (Put_32);
--------------
-- Add_Data --
--------------
procedure Add_Data (Data : in Stream_Element_Array) is
Data_First : Stream_Element_Offset renames Filter.Offset;
Data_Last : Stream_Element_Offset;
Data_Len : Stream_Element_Offset; -- -1
Out_Len : Stream_Element_Offset; -- -1
begin
Out_First := Out_Last + 1;
if Data_First > Data'Last then
return;
end if;
Data_Len := Data'Last - Data_First;
Out_Len := Out_Data'Last - Out_First;
if Data_Len <= Out_Len then
Out_Last := Out_First + Data_Len;
Data_Last := Data'Last;
else
Out_Last := Out_Data'Last;
Data_Last := Data_First + Out_Len;
end if;
Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
Data_First := Data_Last + 1;
Out_First := Out_Last + 1;
end Add_Data;
------------
-- Put_32 --
------------
procedure Put_32
(Item : in out Stream_Element_Array;
Data : in Unsigned_32)
is
D : Unsigned_32 := Data;
begin
for J in Item'First .. Item'First + 3 loop
Item (J) := Stream_Element (D and 16#FF#);
D := Shift_Right (D, 8);
end loop;
end Put_32;
begin
Out_Last := Out_Data'First - 1;
if not Filter.Stream_End then
Add_Data (Simple_GZip_Header);
Translate_Auto
(Filter => Filter,
In_Data => In_Data,
In_Last => In_Last,
Out_Data => Out_Data (Out_First .. Out_Data'Last),
Out_Last => Out_Last,
Flush => Flush);
CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
end if;
if Filter.Stream_End and then Out_Last <= Out_Data'Last then
-- This detection method would work only when
-- Simple_GZip_Header'Last > Footer_Array'Last
if Filter.Offset = Simple_GZip_Header'Last + 1 then
Filter.Offset := Footer_Array'First;
end if;
declare
Footer : Footer_Array;
begin
Put_32 (Footer, Filter.CRC);
Put_32 (Footer (Footer'First + 4 .. Footer'Last),
Unsigned_32 (Total_In (Filter)));
Add_Data (Footer);
end;
end if;
end Translate_GZip;
-------------
-- Version --
-------------
function Version return String is
begin
return Interfaces.C.Strings.Value (Thin.zlibVersion);
end Version;
-----------
-- Write --
-----------
procedure Write
(Filter : in out Filter_Type;
Item : in Ada.Streams.Stream_Element_Array;
Flush : in Flush_Mode := No_Flush)
is
Buffer : Stream_Element_Array (1 .. Buffer_Size);
In_Last : Stream_Element_Offset;
Out_Last : Stream_Element_Offset;
In_First : Stream_Element_Offset := Item'First;
begin
if Item'Length = 0 and Flush = No_Flush then
return;
end if;
loop
Translate
(Filter => Filter,
In_Data => Item (In_First .. Item'Last),
In_Last => In_Last,
Out_Data => Buffer,
Out_Last => Out_Last,
Flush => Flush);
if Out_Last >= Buffer'First then
Write (Buffer (1 .. Out_Last));
end if;
exit when In_Last = Item'Last or Stream_End (Filter);
In_First := In_Last + 1;
end loop;
end Write;
end ZLib;

328
vendor/tcl/compat/zlib/contrib/ada/zlib.ads vendored Normal file
View file

@ -0,0 +1,328 @@
------------------------------------------------------------------------------
-- ZLib for Ada thick binding. --
-- --
-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
-- --
-- This library 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. --
-- --
-- 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 --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $
with Ada.Streams;
with Interfaces;
package ZLib is
ZLib_Error : exception;
Status_Error : exception;
type Compression_Level is new Integer range -1 .. 9;
type Flush_Mode is private;
type Compression_Method is private;
type Window_Bits_Type is new Integer range 8 .. 15;
type Memory_Level_Type is new Integer range 1 .. 9;
type Unsigned_32 is new Interfaces.Unsigned_32;
type Strategy_Type is private;
type Header_Type is (None, Auto, Default, GZip);
-- Header type usage have a some limitation for inflate.
-- See comment for Inflate_Init.
subtype Count is Ada.Streams.Stream_Element_Count;
Default_Memory_Level : constant Memory_Level_Type := 8;
Default_Window_Bits : constant Window_Bits_Type := 15;
----------------------------------
-- Compression method constants --
----------------------------------
Deflated : constant Compression_Method;
-- Only one method allowed in this ZLib version
---------------------------------
-- Compression level constants --
---------------------------------
No_Compression : constant Compression_Level := 0;
Best_Speed : constant Compression_Level := 1;
Best_Compression : constant Compression_Level := 9;
Default_Compression : constant Compression_Level := -1;
--------------------------
-- Flush mode constants --
--------------------------
No_Flush : constant Flush_Mode;
-- Regular way for compression, no flush
Partial_Flush : constant Flush_Mode;
-- Will be removed, use Z_SYNC_FLUSH instead
Sync_Flush : constant Flush_Mode;
-- All pending output is flushed to the output buffer and the output
-- is aligned on a byte boundary, so that the decompressor can get all
-- input data available so far. (In particular avail_in is zero after the
-- call if enough output space has been provided before the call.)
-- Flushing may degrade compression for some compression algorithms and so
-- it should be used only when necessary.
Block_Flush : constant Flush_Mode;
-- Z_BLOCK requests that inflate() stop
-- if and when it get to the next deflate block boundary. When decoding the
-- zlib or gzip format, this will cause inflate() to return immediately
-- after the header and before the first block. When doing a raw inflate,
-- inflate() will go ahead and process the first block, and will return
-- when it gets to the end of that block, or when it runs out of data.
Full_Flush : constant Flush_Mode;
-- All output is flushed as with SYNC_FLUSH, and the compression state
-- is reset so that decompression can restart from this point if previous
-- compressed data has been damaged or if random access is desired. Using
-- Full_Flush too often can seriously degrade the compression.
Finish : constant Flush_Mode;
-- Just for tell the compressor that input data is complete.
------------------------------------
-- Compression strategy constants --
------------------------------------
-- RLE strategy could be used only in version 1.2.0 and later.
Filtered : constant Strategy_Type;
Huffman_Only : constant Strategy_Type;
RLE : constant Strategy_Type;
Default_Strategy : constant Strategy_Type;
Default_Buffer_Size : constant := 4096;
type Filter_Type is tagged limited private;
-- The filter is for compression and for decompression.
-- The usage of the type is depend of its initialization.
function Version return String;
pragma Inline (Version);
-- Return string representation of the ZLib version.
procedure Deflate_Init
(Filter : in out Filter_Type;
Level : in Compression_Level := Default_Compression;
Strategy : in Strategy_Type := Default_Strategy;
Method : in Compression_Method := Deflated;
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
Memory_Level : in Memory_Level_Type := Default_Memory_Level;
Header : in Header_Type := Default);
-- Compressor initialization.
-- When Header parameter is Auto or Default, then default zlib header
-- would be provided for compressed data.
-- When Header is GZip, then gzip header would be set instead of
-- default header.
-- When Header is None, no header would be set for compressed data.
procedure Inflate_Init
(Filter : in out Filter_Type;
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
Header : in Header_Type := Default);
-- Decompressor initialization.
-- Default header type mean that ZLib default header is expecting in the
-- input compressed stream.
-- Header type None mean that no header is expecting in the input stream.
-- GZip header type mean that GZip header is expecting in the
-- input compressed stream.
-- Auto header type mean that header type (GZip or Native) would be
-- detected automatically in the input stream.
-- Note that header types parameter values None, GZip and Auto are
-- supported for inflate routine only in ZLib versions 1.2.0.2 and later.
-- Deflate_Init is supporting all header types.
function Is_Open (Filter : in Filter_Type) return Boolean;
pragma Inline (Is_Open);
-- Is the filter opened for compression or decompression.
procedure Close
(Filter : in out Filter_Type;
Ignore_Error : in Boolean := False);
-- Closing the compression or decompressor.
-- If stream is closing before the complete and Ignore_Error is False,
-- The exception would be raised.
generic
with procedure Data_In
(Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
with procedure Data_Out
(Item : in Ada.Streams.Stream_Element_Array);
procedure Generic_Translate
(Filter : in out Filter_Type;
In_Buffer_Size : in Integer := Default_Buffer_Size;
Out_Buffer_Size : in Integer := Default_Buffer_Size);
-- Compress/decompress data fetch from Data_In routine and pass the result
-- to the Data_Out routine. User should provide Data_In and Data_Out
-- for compression/decompression data flow.
-- Compression or decompression depend on Filter initialization.
function Total_In (Filter : in Filter_Type) return Count;
pragma Inline (Total_In);
-- Returns total number of input bytes read so far
function Total_Out (Filter : in Filter_Type) return Count;
pragma Inline (Total_Out);
-- Returns total number of bytes output so far
function CRC32
(CRC : in Unsigned_32;
Data : in Ada.Streams.Stream_Element_Array)
return Unsigned_32;
pragma Inline (CRC32);
-- Compute CRC32, it could be necessary for make gzip format
procedure CRC32
(CRC : in out Unsigned_32;
Data : in Ada.Streams.Stream_Element_Array);
pragma Inline (CRC32);
-- Compute CRC32, it could be necessary for make gzip format
-------------------------------------------------
-- Below is more complex low level routines. --
-------------------------------------------------
procedure Translate
(Filter : in out Filter_Type;
In_Data : in Ada.Streams.Stream_Element_Array;
In_Last : out Ada.Streams.Stream_Element_Offset;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode);
-- Compress/decompress the In_Data buffer and place the result into
-- Out_Data. In_Last is the index of last element from In_Data accepted by
-- the Filter. Out_Last is the last element of the received data from
-- Filter. To tell the filter that incoming data are complete put the
-- Flush parameter to Finish.
function Stream_End (Filter : in Filter_Type) return Boolean;
pragma Inline (Stream_End);
-- Return the true when the stream is complete.
procedure Flush
(Filter : in out Filter_Type;
Out_Data : out Ada.Streams.Stream_Element_Array;
Out_Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode);
pragma Inline (Flush);
-- Flushing the data from the compressor.
generic
with procedure Write
(Item : in Ada.Streams.Stream_Element_Array);
-- User should provide this routine for accept
-- compressed/decompressed data.
Buffer_Size : in Ada.Streams.Stream_Element_Offset
:= Default_Buffer_Size;
-- Buffer size for Write user routine.
procedure Write
(Filter : in out Filter_Type;
Item : in Ada.Streams.Stream_Element_Array;
Flush : in Flush_Mode := No_Flush);
-- Compress/Decompress data from Item to the generic parameter procedure
-- Write. Output buffer size could be set in Buffer_Size generic parameter.
generic
with procedure Read
(Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- User should provide data for compression/decompression
-- thru this routine.
Buffer : in out Ada.Streams.Stream_Element_Array;
-- Buffer for keep remaining data from the previous
-- back read.
Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
-- Rest_First have to be initialized to Buffer'Last + 1
-- Rest_Last have to be initialized to Buffer'Last
-- before usage.
Allow_Read_Some : in Boolean := False;
-- Is it allowed to return Last < Item'Last before end of data.
procedure Read
(Filter : in out Filter_Type;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
Flush : in Flush_Mode := No_Flush);
-- Compress/Decompress data from generic parameter procedure Read to the
-- Item. User should provide Buffer and initialized Rest_First, Rest_Last
-- indicators. If Allow_Read_Some is True, Read routines could return
-- Last < Item'Last only at end of stream.
private
use Ada.Streams;
pragma Assert (Ada.Streams.Stream_Element'Size = 8);
pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8);
type Flush_Mode is new Integer range 0 .. 5;
type Compression_Method is new Integer range 8 .. 8;
type Strategy_Type is new Integer range 0 .. 3;
No_Flush : constant Flush_Mode := 0;
Partial_Flush : constant Flush_Mode := 1;
Sync_Flush : constant Flush_Mode := 2;
Full_Flush : constant Flush_Mode := 3;
Finish : constant Flush_Mode := 4;
Block_Flush : constant Flush_Mode := 5;
Filtered : constant Strategy_Type := 1;
Huffman_Only : constant Strategy_Type := 2;
RLE : constant Strategy_Type := 3;
Default_Strategy : constant Strategy_Type := 0;
Deflated : constant Compression_Method := 8;
type Z_Stream;
type Z_Stream_Access is access all Z_Stream;
type Filter_Type is tagged limited record
Strm : Z_Stream_Access;
Compression : Boolean;
Stream_End : Boolean;
Header : Header_Type;
CRC : Unsigned_32;
Offset : Stream_Element_Offset;
-- Offset for gzip header/footer output.
end record;
end ZLib;

20
vendor/tcl/compat/zlib/contrib/ada/zlib.gpr vendored Normal file
View file

@ -0,0 +1,20 @@
project Zlib is
for Languages use ("Ada");
for Source_Dirs use (".");
for Object_Dir use ".";
for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");
package Compiler is
for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
end Compiler;
package Linker is
for Default_Switches ("ada") use ("-lz");
end Linker;
package Builder is
for Default_Switches ("ada") use ("-s", "-gnatQ");
end Builder;
end Zlib;

357
vendor/tcl/compat/zlib/contrib/asm686/match.S vendored Normal file
View file

@ -0,0 +1,357 @@
/* match.S -- x86 assembly version of the zlib longest_match() function.
* Optimized for the Intel 686 chips (PPro and later).
*
* Copyright (C) 1998, 2007 Brian Raiter <breadbox@muppetlabs.com>
*
* This software is provided 'as-is', without any express or implied
* warranty. In no event will the author 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.
*/
#ifndef NO_UNDERLINE
#define match_init _match_init
#define longest_match _longest_match
#endif
#define MAX_MATCH (258)
#define MIN_MATCH (3)
#define MIN_LOOKAHEAD (MAX_MATCH + MIN_MATCH + 1)
#define MAX_MATCH_8 ((MAX_MATCH + 7) & ~7)
/* stack frame offsets */
#define chainlenwmask 0 /* high word: current chain len */
/* low word: s->wmask */
#define window 4 /* local copy of s->window */
#define windowbestlen 8 /* s->window + bestlen */
#define scanstart 16 /* first two bytes of string */
#define scanend 12 /* last two bytes of string */
#define scanalign 20 /* dword-misalignment of string */
#define nicematch 24 /* a good enough match size */
#define bestlen 28 /* size of best match so far */
#define scan 32 /* ptr to string wanting match */
#define LocalVarsSize (36)
/* saved ebx 36 */
/* saved edi 40 */
/* saved esi 44 */
/* saved ebp 48 */
/* return address 52 */
#define deflatestate 56 /* the function arguments */
#define curmatch 60
/* All the +zlib1222add offsets are due to the addition of fields
* in zlib in the deflate_state structure since the asm code was first written
* (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
* (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
* if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").
*/
#define zlib1222add (8)
#define dsWSize (36+zlib1222add)
#define dsWMask (44+zlib1222add)
#define dsWindow (48+zlib1222add)
#define dsPrev (56+zlib1222add)
#define dsMatchLen (88+zlib1222add)
#define dsPrevMatch (92+zlib1222add)
#define dsStrStart (100+zlib1222add)
#define dsMatchStart (104+zlib1222add)
#define dsLookahead (108+zlib1222add)
#define dsPrevLen (112+zlib1222add)
#define dsMaxChainLen (116+zlib1222add)
#define dsGoodMatch (132+zlib1222add)
#define dsNiceMatch (136+zlib1222add)
.file "match.S"
.globl match_init, longest_match
.text
/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */
.cfi_sections .debug_frame
longest_match:
.cfi_startproc
/* Save registers that the compiler may be using, and adjust %esp to */
/* make room for our stack frame. */
pushl %ebp
.cfi_def_cfa_offset 8
.cfi_offset ebp, -8
pushl %edi
.cfi_def_cfa_offset 12
pushl %esi
.cfi_def_cfa_offset 16
pushl %ebx
.cfi_def_cfa_offset 20
subl $LocalVarsSize, %esp
.cfi_def_cfa_offset LocalVarsSize+20
/* Retrieve the function arguments. %ecx will hold cur_match */
/* throughout the entire function. %edx will hold the pointer to the */
/* deflate_state structure during the function's setup (before */
/* entering the main loop). */
movl deflatestate(%esp), %edx
movl curmatch(%esp), %ecx
/* uInt wmask = s->w_mask; */
/* unsigned chain_length = s->max_chain_length; */
/* if (s->prev_length >= s->good_match) { */
/* chain_length >>= 2; */
/* } */
movl dsPrevLen(%edx), %eax
movl dsGoodMatch(%edx), %ebx
cmpl %ebx, %eax
movl dsWMask(%edx), %eax
movl dsMaxChainLen(%edx), %ebx
jl LastMatchGood
shrl $2, %ebx
LastMatchGood:
/* chainlen is decremented once beforehand so that the function can */
/* use the sign flag instead of the zero flag for the exit test. */
/* It is then shifted into the high word, to make room for the wmask */
/* value, which it will always accompany. */
decl %ebx
shll $16, %ebx
orl %eax, %ebx
movl %ebx, chainlenwmask(%esp)
/* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; */
movl dsNiceMatch(%edx), %eax
movl dsLookahead(%edx), %ebx
cmpl %eax, %ebx
jl LookaheadLess
movl %eax, %ebx
LookaheadLess: movl %ebx, nicematch(%esp)
/* Bytef *scan = s->window + s->strstart; */
movl dsWindow(%edx), %esi
movl %esi, window(%esp)
movl dsStrStart(%edx), %ebp
lea (%esi,%ebp), %edi
movl %edi, scan(%esp)
/* Determine how many bytes the scan ptr is off from being */
/* dword-aligned. */
movl %edi, %eax
negl %eax
andl $3, %eax
movl %eax, scanalign(%esp)
/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ? */
/* s->strstart - (IPos)MAX_DIST(s) : NIL; */
movl dsWSize(%edx), %eax
subl $MIN_LOOKAHEAD, %eax
subl %eax, %ebp
jg LimitPositive
xorl %ebp, %ebp
LimitPositive:
/* int best_len = s->prev_length; */
movl dsPrevLen(%edx), %eax
movl %eax, bestlen(%esp)
/* Store the sum of s->window + best_len in %esi locally, and in %esi. */
addl %eax, %esi
movl %esi, windowbestlen(%esp)
/* ush scan_start = *(ushf*)scan; */
/* ush scan_end = *(ushf*)(scan+best_len-1); */
/* Posf *prev = s->prev; */
movzwl (%edi), %ebx
movl %ebx, scanstart(%esp)
movzwl -1(%edi,%eax), %ebx
movl %ebx, scanend(%esp)
movl dsPrev(%edx), %edi
/* Jump into the main loop. */
movl chainlenwmask(%esp), %edx
jmp LoopEntry
.balign 16
/* do {
* match = s->window + cur_match;
* if (*(ushf*)(match+best_len-1) != scan_end ||
* *(ushf*)match != scan_start) continue;
* [...]
* } while ((cur_match = prev[cur_match & wmask]) > limit
* && --chain_length != 0);
*
* Here is the inner loop of the function. The function will spend the
* majority of its time in this loop, and majority of that time will
* be spent in the first ten instructions.
*
* Within this loop:
* %ebx = scanend
* %ecx = curmatch
* %edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
* %esi = windowbestlen - i.e., (window + bestlen)
* %edi = prev
* %ebp = limit
*/
LookupLoop:
andl %edx, %ecx
movzwl (%edi,%ecx,2), %ecx
cmpl %ebp, %ecx
jbe LeaveNow
subl $0x00010000, %edx
js LeaveNow
LoopEntry: movzwl -1(%esi,%ecx), %eax
cmpl %ebx, %eax
jnz LookupLoop
movl window(%esp), %eax
movzwl (%eax,%ecx), %eax
cmpl scanstart(%esp), %eax
jnz LookupLoop
/* Store the current value of chainlen. */
movl %edx, chainlenwmask(%esp)
/* Point %edi to the string under scrutiny, and %esi to the string we */
/* are hoping to match it up with. In actuality, %esi and %edi are */
/* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is */
/* initialized to -(MAX_MATCH_8 - scanalign). */
movl window(%esp), %esi
movl scan(%esp), %edi
addl %ecx, %esi
movl scanalign(%esp), %eax
movl $(-MAX_MATCH_8), %edx
lea MAX_MATCH_8(%edi,%eax), %edi
lea MAX_MATCH_8(%esi,%eax), %esi
/* Test the strings for equality, 8 bytes at a time. At the end,
* adjust %edx so that it is offset to the exact byte that mismatched.
*
* We already know at this point that the first three bytes of the
* strings match each other, and they can be safely passed over before
* starting the compare loop. So what this code does is skip over 0-3
* bytes, as much as necessary in order to dword-align the %edi
* pointer. (%esi will still be misaligned three times out of four.)
*
* It should be confessed that this loop usually does not represent
* much of the total running time. Replacing it with a more
* straightforward "rep cmpsb" would not drastically degrade
* performance.
*/
LoopCmps:
movl (%esi,%edx), %eax
xorl (%edi,%edx), %eax
jnz LeaveLoopCmps
movl 4(%esi,%edx), %eax
xorl 4(%edi,%edx), %eax
jnz LeaveLoopCmps4
addl $8, %edx
jnz LoopCmps
jmp LenMaximum
LeaveLoopCmps4: addl $4, %edx
LeaveLoopCmps: testl $0x0000FFFF, %eax
jnz LenLower
addl $2, %edx
shrl $16, %eax
LenLower: subb $1, %al
adcl $0, %edx
/* Calculate the length of the match. If it is longer than MAX_MATCH, */
/* then automatically accept it as the best possible match and leave. */
lea (%edi,%edx), %eax
movl scan(%esp), %edi
subl %edi, %eax
cmpl $MAX_MATCH, %eax
jge LenMaximum
/* If the length of the match is not longer than the best match we */
/* have so far, then forget it and return to the lookup loop. */
movl deflatestate(%esp), %edx
movl bestlen(%esp), %ebx
cmpl %ebx, %eax
jg LongerMatch
movl windowbestlen(%esp), %esi
movl dsPrev(%edx), %edi
movl scanend(%esp), %ebx
movl chainlenwmask(%esp), %edx
jmp LookupLoop
/* s->match_start = cur_match; */
/* best_len = len; */
/* if (len >= nice_match) break; */
/* scan_end = *(ushf*)(scan+best_len-1); */
LongerMatch: movl nicematch(%esp), %ebx
movl %eax, bestlen(%esp)
movl %ecx, dsMatchStart(%edx)
cmpl %ebx, %eax
jge LeaveNow
movl window(%esp), %esi
addl %eax, %esi
movl %esi, windowbestlen(%esp)
movzwl -1(%edi,%eax), %ebx
movl dsPrev(%edx), %edi
movl %ebx, scanend(%esp)
movl chainlenwmask(%esp), %edx
jmp LookupLoop
/* Accept the current string, with the maximum possible length. */
LenMaximum: movl deflatestate(%esp), %edx
movl $MAX_MATCH, bestlen(%esp)
movl %ecx, dsMatchStart(%edx)
/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len; */
/* return s->lookahead; */
LeaveNow:
movl deflatestate(%esp), %edx
movl bestlen(%esp), %ebx
movl dsLookahead(%edx), %eax
cmpl %eax, %ebx
jg LookaheadRet
movl %ebx, %eax
LookaheadRet:
/* Restore the stack and return from whence we came. */
addl $LocalVarsSize, %esp
.cfi_def_cfa_offset 20
popl %ebx
.cfi_def_cfa_offset 16
popl %esi
.cfi_def_cfa_offset 12
popl %edi
.cfi_def_cfa_offset 8
popl %ebp
.cfi_def_cfa_offset 4
.cfi_endproc
match_init: ret

166
vendor/tcl/compat/zlib/contrib/blast/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,166 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast
VERSION 1.3.0
LANGUAGES C
DESCRIPTION "A library for creating zipfiles based in zlib"
HOMEPAGE_URL "https://www.zlib.net")
option(ZLIB_BLAST_BUILD_SHARED "Enable building blast shared library" ON)
option(ZLIB_BLAST_BUILD_STATIC "Enable building blast static library" ON)
option(ZLIB_BLAST_BUILD_TESTING "Enable building tests for blast" ON)
option(ZLIB_BLAST_INSTALL "Enable installation of blast" ON)
include(GNUInstallDirs)
include(CMakePackageConfigHelpers)
if(WIN32 OR CYGWIN)
set(zlibblast_static_suffix "s")
set(CMAKE_DEBUG_POSTFIX "d")
set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS ON)
endif(WIN32 OR CYGWIN)
function(blast_findTestEnv testName)
set(testEnv "PATH=")
if(MSVC OR MINGW)
set(separator "\\\;")
else()
set(separator ":")
endif()
string(APPEND testEnv "$<TARGET_FILE_DIR:BLAST::BLAST>${separator}")
string(APPEND testEnv "$ENV{PATH}")
set_tests_properties(${testName} PROPERTIES ENVIRONMENT "${testEnv}")
endfunction(blast_findTestEnv testName)
if(ZLIB_BLAST_BUILD_SHARED)
add_library(zlib_blast_blast SHARED
blast.c
blast.h)
add_library(BLAST::BLAST ALIAS zlib_blast_blast)
if(NOT CYGWIN)
set_target_properties(zlib_blast_blast
PROPERTIES
SOVERSION ${blast_VERSION_MAJOR}
VERSION ${blast_VERSION})
endif(NOT CYGWIN)
set_target_properties(zlib_blast_blast
PROPERTIES
EXPORT_NAME BLAST
OUTPUT_NAME blast)
if(ZLIB_BLAST_BUILD_TESTING)
enable_testing()
add_executable(zlib_blast_blast-test blast-test.c)
target_link_libraries(zlib_blast_blast-test PRIVATE zlib_blast_blast)
add_test(NAME zlib_blast_blast-test
COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/tester.cmake
"$<TARGET_FILE:zlib_blast_blast-test>"
"${CMAKE_CURRENT_SOURCE_DIR}"
"${CMAKE_CURRENT_BINARY_DIR}")
if(MSVC
OR MSYS
OR MINGW
OR CYGWIN)
blast_findtestenv(zlib_blast_blast-test)
endif(
MSVC
OR MSYS
OR MINGW
OR CYGWIN)
endif(ZLIB_BLAST_BUILD_TESTING)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
add_library(zlib_blast_blastStatic STATIC
blast.c
blast.h)
add_library(BLAST::BLASTSTATIC ALIAS zlib_blast_blastStatic)
set_target_properties(zlib_blast_blastStatic
PROPERTIES
EXPORT_NAME BLASTSTATIC
OUTPUT_NAME blast${zlibblast_static_suffix})
if(ZLIB_BLAST_BUILD_TESTING)
enable_testing()
add_executable(zlib_blast_testStatic blast-test.c)
target_link_libraries(zlib_blast_testStatic
PRIVATE zlib_blast_blastStatic)
add_test(NAME zlib_blast_testStatic
COMMAND ${CMAKE_COMMAND} -P ${CMAKE_CURRENT_SOURCE_DIR}/tester.cmake
"$<TARGET_FILE:zlib_blast_testStatic>"
"${CMAKE_CURRENT_SOURCE_DIR}"
"${CMAKE_CURRENT_BINARY_DIR}")
endif(ZLIB_BLAST_BUILD_TESTING)
endif(ZLIB_BLAST_BUILD_STATIC)
if(ZLIB_BLAST_BUILD_TESTING)
add_subdirectory(test)
endif(ZLIB_BLAST_BUILD_TESTING)
if(ZLIB_BLAST_INSTALL)
if(ZLIB_BLAST_BUILD_SHARED)
install(
TARGETS zlib_blast_blast
COMPONENT Runtime
EXPORT zlibBlastSharedExport
RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}"
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}")
install(
EXPORT zlibBlastSharedExport
FILE blast-shared.cmake
NAMESPACE BLAST::
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/blast)
if(MSVC)
install(
FILES $<TARGET_PDB_FILE:zlib_blast_blast>
COMPONENT Development
DESTINATION ${CMAKE_INSTALL_BINDIR}
CONFIGURATIONS Debug OR RelWithDebInfo
OPTIONAL)
endif(MSVC)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
install(
TARGETS zlib_blast_blastStatic
COMPONENT Development
EXPORT zlibBlastStaticExport
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}")
install(
EXPORT zlibBlastStaticExport
FILE blast-static.cmake
NAMESPACE BLAST::
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/blast)
endif(ZLIB_BLAST_BUILD_STATIC)
configure_package_config_file(
${blast_SOURCE_DIR}/blastConfig.cmake.in
${blast_BINARY_DIR}/blastConfig.cmake
INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/blast)
write_basic_package_version_file(
"${blast_BINARY_DIR}/blastConfigVersion.cmake"
VERSION "${blast_VERSION}"
COMPATIBILITY AnyNewerVersion)
install(FILES ${blast_BINARY_DIR}/blastConfig.cmake
${blast_BINARY_DIR}/blastConfigVersion.cmake
DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/blast)
install(
FILES blast.h
COMPONENT Development
DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}")
endif(ZLIB_BLAST_INSTALL)

14
vendor/tcl/compat/zlib/contrib/blast/Makefile vendored Normal file
View file

@ -0,0 +1,14 @@
all: test
libblast.so: blast.c blast.h
cc -o libblast.so -shared blast.c
blast-test: libblast.so
cc -o blast-test.o -c blast-test.c
cc -o blast-test blast-test.o libblast.so
test: blast-test
LD_LIBRARY_PATH=./ ./blast-test < test.pk | cmp - test.txt
clean:
rm -f libblast.so blast-test blast-test.o

4
vendor/tcl/compat/zlib/contrib/blast/README vendored Normal file
View file

@ -0,0 +1,4 @@
Read blast.h for purpose and usage.
Mark Adler
madler@alumni.caltech.edu

42
vendor/tcl/compat/zlib/contrib/blast/blast-test.c vendored Normal file
View file

@ -0,0 +1,42 @@
#include "blast.h" /* prototype for blast() */
/* Example of how to use blast() */
#include <stdio.h>
#include <stdlib.h>
#define CHUNK 16384
local unsigned inf(void *how, unsigned char **buf)
{
static unsigned char hold[CHUNK];
*buf = hold;
return fread(hold, 1, CHUNK, (FILE *)how);
}
local int outf(void *how, unsigned char *buf, unsigned len)
{
return fwrite(buf, 1, len, (FILE *)how) != len;
}
/* Decompress a PKWare Compression Library stream from stdin to stdout */
int main(void)
{
int ret;
unsigned left;
/* decompress to stdout */
left = 0;
ret = blast(inf, stdin, outf, stdout, &left, NULL);
if (ret != 0)
fprintf(stderr, "blast error: %d\n", ret);
/* count any leftover bytes */
while (getchar() != EOF)
left++;
if (left)
fprintf(stderr, "blast warning: %u unused bytes of input\n", left);
/* return blast() error code */
return ret;
}

422
vendor/tcl/compat/zlib/contrib/blast/blast.c vendored Normal file
View file

@ -0,0 +1,422 @@
/* blast.c
* Copyright (C) 2003, 2012, 2013 Mark Adler
* For conditions of distribution and use, see copyright notice in blast.h
* version 1.3, 24 Aug 2013
*
* blast.c decompresses data compressed by the PKWare Compression Library.
* This function provides functionality similar to the explode() function of
* the PKWare library, hence the name "blast".
*
* This decompressor is based on the excellent format description provided by
* Ben Rudiak-Gould in comp.compression on August 13, 2001. Interestingly, the
* example Ben provided in the post is incorrect. The distance 110001 should
* instead be 111000. When corrected, the example byte stream becomes:
*
* 00 04 82 24 25 8f 80 7f
*
* which decompresses to "AIAIAIAIAIAIA" (without the quotes).
*/
/*
* Change history:
*
* 1.0 12 Feb 2003 - First version
* 1.1 16 Feb 2003 - Fixed distance check for > 4 GB uncompressed data
* 1.2 24 Oct 2012 - Add note about using binary mode in stdio
* - Fix comparisons of differently signed integers
* 1.3 24 Aug 2013 - Return unused input from blast()
* - Fix test code to correctly report unused input
* - Enable the provision of initial input to blast()
*/
#include <stddef.h> /* for NULL */
#include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */
#include "blast.h" /* prototype for blast() */
#define MAXBITS 13 /* maximum code length */
#define MAXWIN 4096 /* maximum window size */
/* input and output state */
struct state {
/* input state */
blast_in infun; /* input function provided by user */
void *inhow; /* opaque information passed to infun() */
unsigned char *in; /* next input location */
unsigned left; /* available input at in */
int bitbuf; /* bit buffer */
int bitcnt; /* number of bits in bit buffer */
/* input limit error return state for bits() and decode() */
jmp_buf env;
/* output state */
blast_out outfun; /* output function provided by user */
void *outhow; /* opaque information passed to outfun() */
unsigned next; /* index of next write location in out[] */
int first; /* true to check distances (for first 4K) */
unsigned char out[MAXWIN]; /* output buffer and sliding window */
};
/*
* Return need bits from the input stream. This always leaves less than
* eight bits in the buffer. bits() works properly for need == 0.
*
* Format notes:
*
* - Bits are stored in bytes from the least significant bit to the most
* significant bit. Therefore bits are dropped from the bottom of the bit
* buffer, using shift right, and new bytes are appended to the top of the
* bit buffer, using shift left.
*/
local int bits(struct state *s, int need)
{
int val; /* bit accumulator */
/* load at least need bits into val */
val = s->bitbuf;
while (s->bitcnt < need) {
if (s->left == 0) {
s->left = s->infun(s->inhow, &(s->in));
if (s->left == 0) longjmp(s->env, 1); /* out of input */
}
val |= (int)(*(s->in)++) << s->bitcnt; /* load eight bits */
s->left--;
s->bitcnt += 8;
}
/* drop need bits and update buffer, always zero to seven bits left */
s->bitbuf = val >> need;
s->bitcnt -= need;
/* return need bits, zeroing the bits above that */
return val & ((1 << need) - 1);
}
/*
* Huffman code decoding tables. count[1..MAXBITS] is the number of symbols of
* each length, which for a canonical code are stepped through in order.
* symbol[] are the symbol values in canonical order, where the number of
* entries is the sum of the counts in count[]. The decoding process can be
* seen in the function decode() below.
*/
struct huffman {
short *count; /* number of symbols of each length */
short *symbol; /* canonically ordered symbols */
};
/*
* Decode a code from the stream s using huffman table h. Return the symbol or
* a negative value if there is an error. If all of the lengths are zero, i.e.
* an empty code, or if the code is incomplete and an invalid code is received,
* then -9 is returned after reading MAXBITS bits.
*
* Format notes:
*
* - The codes as stored in the compressed data are bit-reversed relative to
* a simple integer ordering of codes of the same lengths. Hence below the
* bits are pulled from the compressed data one at a time and used to
* build the code value reversed from what is in the stream in order to
* permit simple integer comparisons for decoding.
*
* - The first code for the shortest length is all ones. Subsequent codes of
* the same length are simply integer decrements of the previous code. When
* moving up a length, a one bit is appended to the code. For a complete
* code, the last code of the longest length will be all zeros. To support
* this ordering, the bits pulled during decoding are inverted to apply the
* more "natural" ordering starting with all zeros and incrementing.
*/
local int decode(struct state *s, struct huffman *h)
{
int len; /* current number of bits in code */
int code; /* len bits being decoded */
int first; /* first code of length len */
int count; /* number of codes of length len */
int index; /* index of first code of length len in symbol table */
int bitbuf; /* bits from stream */
int left; /* bits left in next or left to process */
short *next; /* next number of codes */
bitbuf = s->bitbuf;
left = s->bitcnt;
code = first = index = 0;
len = 1;
next = h->count + 1;
while (1) {
while (left--) {
code |= (bitbuf & 1) ^ 1; /* invert code */
bitbuf >>= 1;
count = *next++;
if (code < first + count) { /* if length len, return symbol */
s->bitbuf = bitbuf;
s->bitcnt = (s->bitcnt - len) & 7;
return h->symbol[index + (code - first)];
}
index += count; /* else update for next length */
first += count;
first <<= 1;
code <<= 1;
len++;
}
left = (MAXBITS+1) - len;
if (left == 0) break;
if (s->left == 0) {
s->left = s->infun(s->inhow, &(s->in));
if (s->left == 0) longjmp(s->env, 1); /* out of input */
}
bitbuf = *(s->in)++;
s->left--;
if (left > 8) left = 8;
}
return -9; /* ran out of codes */
}
/*
* Given a list of repeated code lengths rep[0..n-1], where each byte is a
* count (high four bits + 1) and a code length (low four bits), generate the
* list of code lengths. This compaction reduces the size of the object code.
* Then given the list of code lengths length[0..n-1] representing a canonical
* Huffman code for n symbols, construct the tables required to decode those
* codes. Those tables are the number of codes of each length, and the symbols
* sorted by length, retaining their original order within each length. The
* return value is zero for a complete code set, negative for an over-
* subscribed code set, and positive for an incomplete code set. The tables
* can be used if the return value is zero or positive, but they cannot be used
* if the return value is negative. If the return value is zero, it is not
* possible for decode() using that table to return an error--any stream of
* enough bits will resolve to a symbol. If the return value is positive, then
* it is possible for decode() using that table to return an error for received
* codes past the end of the incomplete lengths.
*/
local int construct(struct huffman *h, const unsigned char *rep, int n)
{
int symbol; /* current symbol when stepping through length[] */
int len; /* current length when stepping through h->count[] */
int left; /* number of possible codes left of current length */
short offs[MAXBITS+1]; /* offsets in symbol table for each length */
short length[256]; /* code lengths */
/* convert compact repeat counts into symbol bit length list */
symbol = 0;
do {
len = *rep++;
left = (len >> 4) + 1;
len &= 15;
do {
length[symbol++] = len;
} while (--left);
} while (--n);
n = symbol;
/* count number of codes of each length */
for (len = 0; len <= MAXBITS; len++)
h->count[len] = 0;
for (symbol = 0; symbol < n; symbol++)
(h->count[length[symbol]])++; /* assumes lengths are within bounds */
if (h->count[0] == n) /* no codes! */
return 0; /* complete, but decode() will fail */
/* check for an over-subscribed or incomplete set of lengths */
left = 1; /* one possible code of zero length */
for (len = 1; len <= MAXBITS; len++) {
left <<= 1; /* one more bit, double codes left */
left -= h->count[len]; /* deduct count from possible codes */
if (left < 0) return left; /* over-subscribed--return negative */
} /* left > 0 means incomplete */
/* generate offsets into symbol table for each length for sorting */
offs[1] = 0;
for (len = 1; len < MAXBITS; len++)
offs[len + 1] = offs[len] + h->count[len];
/*
* put symbols in table sorted by length, by symbol order within each
* length
*/
for (symbol = 0; symbol < n; symbol++)
if (length[symbol] != 0)
h->symbol[offs[length[symbol]]++] = symbol;
/* return zero for complete set, positive for incomplete set */
return left;
}
/*
* Decode PKWare Compression Library stream.
*
* Format notes:
*
* - First byte is 0 if literals are uncoded or 1 if they are coded. Second
* byte is 4, 5, or 6 for the number of extra bits in the distance code.
* This is the base-2 logarithm of the dictionary size minus six.
*
* - Compressed data is a combination of literals and length/distance pairs
* terminated by an end code. Literals are either Huffman coded or
* uncoded bytes. A length/distance pair is a coded length followed by a
* coded distance to represent a string that occurs earlier in the
* uncompressed data that occurs again at the current location.
*
* - A bit preceding a literal or length/distance pair indicates which comes
* next, 0 for literals, 1 for length/distance.
*
* - If literals are uncoded, then the next eight bits are the literal, in the
* normal bit order in the stream, i.e. no bit-reversal is needed. Similarly,
* no bit reversal is needed for either the length extra bits or the distance
* extra bits.
*
* - Literal bytes are simply written to the output. A length/distance pair is
* an instruction to copy previously uncompressed bytes to the output. The
* copy is from distance bytes back in the output stream, copying for length
* bytes.
*
* - Distances pointing before the beginning of the output data are not
* permitted.
*
* - Overlapped copies, where the length is greater than the distance, are
* allowed and common. For example, a distance of one and a length of 518
* simply copies the last byte 518 times. A distance of four and a length of
* twelve copies the last four bytes three times. A simple forward copy
* ignoring whether the length is greater than the distance or not implements
* this correctly.
*/
local int decomp(struct state *s)
{
int lit; /* true if literals are coded */
int dict; /* log2(dictionary size) - 6 */
int symbol; /* decoded symbol, extra bits for distance */
int len; /* length for copy */
unsigned dist; /* distance for copy */
int copy; /* copy counter */
unsigned char *from, *to; /* copy pointers */
static int virgin = 1; /* build tables once */
static short litcnt[MAXBITS+1], litsym[256]; /* litcode memory */
static short lencnt[MAXBITS+1], lensym[16]; /* lencode memory */
static short distcnt[MAXBITS+1], distsym[64]; /* distcode memory */
static struct huffman litcode = {litcnt, litsym}; /* length code */
static struct huffman lencode = {lencnt, lensym}; /* length code */
static struct huffman distcode = {distcnt, distsym};/* distance code */
/* bit lengths of literal codes */
static const unsigned char litlen[] = {
11, 124, 8, 7, 28, 7, 188, 13, 76, 4, 10, 8, 12, 10, 12, 10, 8, 23, 8,
9, 7, 6, 7, 8, 7, 6, 55, 8, 23, 24, 12, 11, 7, 9, 11, 12, 6, 7, 22, 5,
7, 24, 6, 11, 9, 6, 7, 22, 7, 11, 38, 7, 9, 8, 25, 11, 8, 11, 9, 12,
8, 12, 5, 38, 5, 38, 5, 11, 7, 5, 6, 21, 6, 10, 53, 8, 7, 24, 10, 27,
44, 253, 253, 253, 252, 252, 252, 13, 12, 45, 12, 45, 12, 61, 12, 45,
44, 173};
/* bit lengths of length codes 0..15 */
static const unsigned char lenlen[] = {2, 35, 36, 53, 38, 23};
/* bit lengths of distance codes 0..63 */
static const unsigned char distlen[] = {2, 20, 53, 230, 247, 151, 248};
static const short base[16] = { /* base for length codes */
3, 2, 4, 5, 6, 7, 8, 9, 10, 12, 16, 24, 40, 72, 136, 264};
static const char extra[16] = { /* extra bits for length codes */
0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8};
/* set up decoding tables (once--might not be thread-safe) */
if (virgin) {
construct(&litcode, litlen, sizeof(litlen));
construct(&lencode, lenlen, sizeof(lenlen));
construct(&distcode, distlen, sizeof(distlen));
virgin = 0;
}
/* read header */
lit = bits(s, 8);
if (lit > 1) return -1;
dict = bits(s, 8);
if (dict < 4 || dict > 6) return -2;
/* decode literals and length/distance pairs */
do {
if (bits(s, 1)) {
/* get length */
symbol = decode(s, &lencode);
len = base[symbol] + bits(s, extra[symbol]);
if (len == 519) break; /* end code */
/* get distance */
symbol = len == 2 ? 2 : dict;
dist = decode(s, &distcode) << symbol;
dist += bits(s, symbol);
dist++;
if (s->first && dist > s->next)
return -3; /* distance too far back */
/* copy length bytes from distance bytes back */
do {
to = s->out + s->next;
from = to - dist;
copy = MAXWIN;
if (s->next < dist) {
from += copy;
copy = dist;
}
copy -= s->next;
if (copy > len) copy = len;
len -= copy;
s->next += copy;
do {
*to++ = *from++;
} while (--copy);
if (s->next == MAXWIN) {
if (s->outfun(s->outhow, s->out, s->next)) return 1;
s->next = 0;
s->first = 0;
}
} while (len != 0);
}
else {
/* get literal and write it */
symbol = lit ? decode(s, &litcode) : bits(s, 8);
s->out[s->next++] = symbol;
if (s->next == MAXWIN) {
if (s->outfun(s->outhow, s->out, s->next)) return 1;
s->next = 0;
s->first = 0;
}
}
} while (1);
return 0;
}
/* See comments in blast.h */
int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow,
unsigned *left, unsigned char **in)
{
struct state s; /* input/output state */
int err; /* return value */
/* initialize input state */
s.infun = infun;
s.inhow = inhow;
if (left != NULL && *left) {
s.left = *left;
s.in = *in;
}
else
s.left = 0;
s.bitbuf = 0;
s.bitcnt = 0;
/* initialize output state */
s.outfun = outfun;
s.outhow = outhow;
s.next = 0;
s.first = 1;
/* return if bits() or decode() tries to read past available input */
if (setjmp(s.env) != 0) /* if came back here via longjmp(), */
err = 2; /* then skip decomp(), return error */
else
err = decomp(&s); /* decompress */
/* return unused input */
if (left != NULL)
*left = s.left;
if (in != NULL)
*in = s.left ? s.in : NULL;
/* write any leftover output and update the error code if needed */
if (err != 1 && s.next && s.outfun(s.outhow, s.out, s.next) && err == 0)
err = 1;
return err;
}

84
vendor/tcl/compat/zlib/contrib/blast/blast.h vendored Normal file
View file

@ -0,0 +1,84 @@
/* blast.h -- interface for blast.c
Copyright (C) 2003, 2012, 2013 Mark Adler
version 1.3, 24 Aug 2013
This software is provided 'as-is', without any express or implied
warranty. In no event will the author 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.
Mark Adler madler@alumni.caltech.edu
*/
#define local static /* for local function definitions */
/*
* blast() decompresses the PKWare Data Compression Library (DCL) compressed
* format. It provides the same functionality as the explode() function in
* that library. (Note: PKWare overused the "implode" verb, and the format
* used by their library implode() function is completely different and
* incompatible with the implode compression method supported by PKZIP.)
*
* The binary mode for stdio functions should be used to assure that the
* compressed data is not corrupted when read or written. For example:
* fopen(..., "rb") and fopen(..., "wb").
*/
typedef unsigned (*blast_in)(void *how, unsigned char **buf);
typedef int (*blast_out)(void *how, unsigned char *buf, unsigned len);
/* Definitions for input/output functions passed to blast(). See below for
* what the provided functions need to do.
*/
int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow,
unsigned *left, unsigned char **in);
/* Decompress input to output using the provided infun() and outfun() calls.
* On success, the return value of blast() is zero. If there is an error in
* the source data, i.e. it is not in the proper format, then a negative value
* is returned. If there is not enough input available or there is not enough
* output space, then a positive error is returned.
*
* The input function is invoked: len = infun(how, &buf), where buf is set by
* infun() to point to the input buffer, and infun() returns the number of
* available bytes there. If infun() returns zero, then blast() returns with
* an input error. (blast() only asks for input if it needs it.) inhow is for
* use by the application to pass an input descriptor to infun(), if desired.
*
* If left and in are not NULL and *left is not zero when blast() is called,
* then the *left bytes at *in are consumed for input before infun() is used.
*
* The output function is invoked: err = outfun(how, buf, len), where the bytes
* to be written are buf[0..len-1]. If err is not zero, then blast() returns
* with an output error. outfun() is always called with len <= 4096. outhow
* is for use by the application to pass an output descriptor to outfun(), if
* desired.
*
* If there is any unused input, *left is set to the number of bytes that were
* read and *in points to them. Otherwise *left is set to zero and *in is set
* to NULL. If left or in are NULL, then they are not set.
*
* The return codes are:
*
* 2: ran out of input before completing decompression
* 1: output error before completing decompression
* 0: successful decompression
* -1: literal flag not zero or one
* -2: dictionary size not in 4..6
* -3: distance is too far back
*
* At the bottom of blast.c is an example program that uses blast() that can be
* compiled to produce a command-line decompression filter by defining TEST.
*/

18
vendor/tcl/compat/zlib/contrib/blast/blastConfig.cmake.in vendored Normal file
View file

@ -0,0 +1,18 @@
@PACKAGE_INIT@
set(_blast_supported_components "shared" "static")
if(blast_FIND_COMPONENTS)
foreach(_comp ${blast_FIND_COMPONENTS})
if(NOT _comp IN_LIST _blast_supported_components)
set(blast_FOUND False)
set(blast_NOT_FOUND_MESSAGE "Unsupported component: ${_comp}")
endif(NOT _comp IN_LIST _blast_supported_components)
include("${CMAKE_CURRENT_LIST_DIR}/blast-${_comp}.cmake")
endforeach(_comp ${blast_FIND_COMPONENTS})
else(blast_FIND_COMPONENTS)
foreach(_component_config IN LISTS _blast_supported_components)
include("${CMAKE_CURRENT_LIST_DIR}/blast-${_component_config}.cmake")
endforeach(_component_config IN LISTS _blast_supported_components)
endif(blast_FIND_COMPONENTS)

BIN
vendor/tcl/compat/zlib/contrib/blast/test.pk vendored Normal file
View file

Binary file not shown.

1
vendor/tcl/compat/zlib/contrib/blast/test.txt vendored Normal file
View file

@ -0,0 +1 @@
AIAIAIAIAIAIA

193
vendor/tcl/compat/zlib/contrib/blast/test/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,193 @@
# if we are built from with zlib, use this path's)
if(DEFINED ZLIB_BUILD_BLAST)
set(WORK_DIR ${zlib_BINARY_DIR})
set(inst_setup zlib_install)
else(DEFINED ZLIB_BUILD_BLAST)
set(WORK_DIR ${blast_BINARY_DIR})
set(inst_setup zlib_blast_install)
set(ZLIB_ARG "-DZLIB_DIR=${ZLIB_DIR}")
add_test(
NAME zlib_blast_install
COMMAND ${CMAKE_COMMAND} --install ${blast_BINARY_DIR} --prefix
${CMAKE_CURRENT_BINARY_DIR}/test_install --config $<CONFIG>
WORKING_DIRECTORY ${blast_BINARY_DIR})
set_tests_properties(zlib_blast_install
PROPERTIES
FIXTURES_SETUP zlib_blast_install)
endif(DEFINED ZLIB_BUILD_BLAST)
file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/findpackage_test)
file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_test)
file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_exclude_test)
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/find_package_test.cmake.in
${CMAKE_CURRENT_BINARY_DIR}/findpackage_test/CMakeLists.txt @ONLY)
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/add_subdirectory_test.cmake.in
${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_test/CMakeLists.txt @ONLY)
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/add_subdirectory_exclude_test.cmake.in
${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_exclude_test/CMakeLists.txt
@ONLY)
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/find_package_no_components_test.cmake.in
${CMAKE_CURRENT_BINARY_DIR}/findpackage_no_components_test/CMakeLists.txt
@ONLY)
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/find_package_wrong_components_test.cmake.in
${CMAKE_CURRENT_BINARY_DIR}/findpackage_wrong_components_test/CMakeLists.txt
@ONLY)
# CMAKE_GENERATOR_PLATFORM doesn't work in the if
set(GENERATOR ${CMAKE_GENERATOR_PLATFORM})
if(GENERATOR)
set(PLATFORM "-A ${GENERATOR}")
endif(GENERATOR)
#
# findpackage_test
#
add_test(
NAME zlib_blast_find_package_configure
COMMAND
${CMAKE_COMMAND} ${PLATFORM}
-B${CMAKE_CURRENT_BINARY_DIR}/findpackage_test_build
-DCMAKE_BUILD_TYPE=$<CONFIG>
-DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
-DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
-DCMAKE_INSTALL_PREFIX=${WORK_DIR}/test/test_install ${ZLIB_ARG}
--fresh
-G "${CMAKE_GENERATOR}"
-S${CMAKE_CURRENT_BINARY_DIR}/findpackage_test)
add_test(
NAME zlib_blast_find_package_build
COMMAND ${CMAKE_COMMAND} --build . --config $<CONFIG>
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/findpackage_test_build)
set_tests_properties(
zlib_blast_find_package_configure
PROPERTIES
FIXTURES_REQUIRED ${inst_setup}
FIXTURES_SETUP blast_fp_config)
set_tests_properties(zlib_blast_find_package_build
PROPERTIES
FIXTURES_REQUIRED blast_fp_config)
#
# add_subdirectory_test
#
add_test(
NAME zlib_blast_add_subdirectory_configure
COMMAND
${CMAKE_COMMAND} ${PLATFORM}
-B${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_test_build
-DCMAKE_BUILD_TYPE=$<CONFIG>
-DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
-DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
-DCMAKE_INSTALL_PREFIX=${WORK_DIR}/test/test_install ${ZLIB_ARG}
--fresh
-G "${CMAKE_GENERATOR}"
-S${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_test)
add_test(
NAME zlib_blast_add_subdirectory_build
COMMAND ${CMAKE_COMMAND} --build . --config $<CONFIG>
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_test_build)
set_tests_properties(
zlib_blast_add_subdirectory_configure
PROPERTIES
FIXTURES_REQUIRED ${inst_setup}
FIXTURES_SETUP blast_as_config)
set_tests_properties(zlib_blast_add_subdirectory_build
PROPERTIES
FIXTURES_REQUIRED blast_as_config)
#
# add_subdirectory_exclude_test
#
add_test(
NAME zlib_blast_add_subdirectory_exclude_configure
COMMAND
${CMAKE_COMMAND} ${PLATFORM}
-B${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_exclude_test_build
-DCMAKE_BUILD_TYPE=$<CONFIG>
-DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
-DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
-DCMAKE_INSTALL_PREFIX=${WORK_DIR}/test/test_install ${ZLIB_ARG}
--fresh
-G "${CMAKE_GENERATOR}"
-S${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_exclude_test)
add_test(
NAME zlib_blast_add_subdirectory_exclude_build
COMMAND ${CMAKE_COMMAND} --build . --config $<CONFIG>
WORKING_DIRECTORY
${CMAKE_CURRENT_BINARY_DIR}/add_subdirectory_exclude_test_build)
set_tests_properties(zlib_blast_add_subdirectory_exclude_configure
PROPERTIES
FIXTURES_REQUIRED ${inst_setup}
FIXTURES_SETUP blast_asx_config)
set_tests_properties(zlib_blast_add_subdirectory_exclude_build
PROPERTIES
FIXTURES_REQUIRED blast_asx_config)
#
# findpackage_no_components_test
#
add_test(
NAME zlib_blast_find_package_no_components_configure
COMMAND
${CMAKE_COMMAND} ${PLATFORM}
-B${CMAKE_CURRENT_BINARY_DIR}/findpackage_no_components_test_build
-DCMAKE_BUILD_TYPE=$<CONFIG> -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
-DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
-DCMAKE_INSTALL_PREFIX=${WORK_DIR}/test/test_install ${ZLIB_ARG}
--fresh
-G "${CMAKE_GENERATOR}"
-S${CMAKE_CURRENT_BINARY_DIR}/findpackage_no_components_test)
set_tests_properties(
zlib_blast_find_package_no_components_configure
PROPERTIES
FIXTURES_REQUIRED ${inst_setup})
if(NOT ZLIB_BLAST_BUILD_SHARED OR NOT ZLIB_BLAST_BUILD_STATIC)
set_tests_properties(zlib_blast_find_package_no_components_configure
PROPERTIES
WILL_FAIL TRUE)
endif(NOT ZLIB_BLAST_BUILD_SHARED OR NOT ZLIB_BLAST_BUILD_STATIC)
#
# findpackage_wrong_components_test
#
add_test(
NAME zlib_blast_find_package_wrong_components_configure
COMMAND
${CMAKE_COMMAND} ${PLATFORM}
-B${CMAKE_CURRENT_BINARY_DIR}/findpackage_wrong_components_test_build
-DCMAKE_BUILD_TYPE=$<CONFIG> -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER}
-DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
-DCMAKE_INSTALL_PREFIX=${WORK_DIR}/test/test_install ${ZLIB_ARG}
--fresh
-G "${CMAKE_GENERATOR}"
-S${CMAKE_CURRENT_BINARY_DIR}/findpackage_wrong_components_test)
set_tests_properties(zlib_blast_find_package_wrong_components_configure
PROPERTIES
FIXTURES_REQUIRED ${inst_setup}
WILL_FAIL TRUE)

27
vendor/tcl/compat/zlib/contrib/blast/test/add_subdirectory_exclude_test.cmake.in vendored Normal file
View file

@ -0,0 +1,27 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast_find_package
LANGUAGES C
VERSION @blast_VERSION@)
option(ZLIB_BLAST_BUILD_SHARED "" @ZLIB_BLAST_BUILD_SHARED@)
option(ZLIB_BLAST_BUILD_STATIC "" @ZLIB_BLAST_BUILD_STATIC@)
option(ZLIB_BLAST_BUILD_TESTING "" @ZLIB_BLAST_BUILD_TESTING@)
add_subdirectory(@blast_SOURCE_DIR@
${CMAKE_CURRENT_BINARY_DIR}/blast
EXCLUDE_FROM_ALL)
set(BLAST_SRCS
@blast_SOURCE_DIR@/blast-test.c)
if(ZLIB_BLAST_BUILD_SHARED)
add_executable(test_example ${BLAST_SRCS})
target_link_libraries(test_example BLAST::BLAST)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
add_executable(test_example_static ${BLAST_SRCS})
target_link_libraries(test_example_static BLAST::BLASTSTATIC)
endif(ZLIB_BLAST_BUILD_STATIC)

25
vendor/tcl/compat/zlib/contrib/blast/test/add_subdirectory_test.cmake.in vendored Normal file
View file

@ -0,0 +1,25 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast_find_package
LANGUAGES C
VERSION @blast_VERSION@)
option(ZLIB_BLAST_BUILD_SHARED "" @ZLIB_BLAST_BUILD_SHARED@)
option(ZLIB_BLAST_BUILD_STATIC "" @ZLIB_BLAST_BUILD_STATIC@)
option(ZLIB_BLAST_BUILD_TESTING "" @ZLIB_BLAST_BUILD_TESTING@)
add_subdirectory(@blast_SOURCE_DIR@ ${CMAKE_CURRENT_BINARY_DIR}/blast)
set(BLAST_SRCS
@blast_SOURCE_DIR@/blast-test.c)
if(ZLIB_BLAST_BUILD_SHARED)
add_executable(test_example ${BLAST_SRCS})
target_link_libraries(test_example BLAST::BLAST)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
add_executable(test_example_static ${BLAST_SRCS})
target_link_libraries(test_example_static BLAST::BLASTSTATIC)
endif(ZLIB_BLAST_BUILD_STATIC)

24
vendor/tcl/compat/zlib/contrib/blast/test/find_package_no_components_test.cmake.in vendored Normal file
View file

@ -0,0 +1,24 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast_find_package
LANGUAGES C
VERSION @blast_VERSION@)
option(ZLIB_BLAST_BUILD_SHARED "" @ZLIB_BLAST_BUILD_SHARED@)
option(ZLIB_BLAST_BUILD_STATIC "" @ZLIB_BLAST_BUILD_STATIC@)
find_package(blast REQUIRED CONFIG)
set(BLAST_SRCS
@blast_SOURCE_DIR@/blast-test.c)
if(ZLIB_BLAST_BUILD_SHARED)
add_executable(test_example ${BLAST_SRCS})
target_link_libraries(test_example BLAST::BLAST)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
add_executable(test_example_static ${BLAST_SRCS})
target_link_libraries(test_example_static BLAST::BLASTSTATIC)
endif(ZLIB_BLAST_BUILD_STATIC)

24
vendor/tcl/compat/zlib/contrib/blast/test/find_package_test.cmake.in vendored Normal file
View file

@ -0,0 +1,24 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast_find_package
LANGUAGES C
VERSION @blast_VERSION@)
option(ZLIB_BLAST_BUILD_SHARED "" @ZLIB_BLAST_BUILD_SHARED@)
option(ZLIB_BLAST_BUILD_STATIC "" @ZLIB_BLAST_BUILD_STATIC@)
set(BLAST_SRCS
@blast_SOURCE_DIR@/blast-test.c)
if(ZLIB_BLAST_BUILD_SHARED)
find_package(blast REQUIRED COMPONENTS shared CONFIG)
add_executable(test_example ${BLAST_SRCS})
target_link_libraries(test_example BLAST::BLAST)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
find_package(blast REQUIRED COMPONENTS static CONFIG)
add_executable(test_example_static ${BLAST_SRCS})
target_link_libraries(test_example_static BLAST::BLASTSTATIC)
endif(ZLIB_BLAST_BUILD_STATIC)

24
vendor/tcl/compat/zlib/contrib/blast/test/find_package_wrong_components_test.cmake.in vendored Normal file
View file

@ -0,0 +1,24 @@
cmake_minimum_required(VERSION 3.12...3.31)
project(
blast_find_package
LANGUAGES C
VERSION @blast_VERSION@)
option(ZLIB_BLAST_BUILD_SHARED "" @ZLIB_BLAST_BUILD_SHARED@)
option(ZLIB_BLAST_BUILD_STATIC "" @ZLIB_BLAST_BUILD_STATIC@)
find_package(blast REQUIRED COMPONENTS wrong CONFIG)
set(BLAST_SRCS
@blast_SOURCE_DIR@/blast-test.c)
if(ZLIB_BLAST_BUILD_SHARED)
add_executable(test_example ${BLAST_SRCS})
target_link_libraries(test_example BLAST::BLAST)
endif(ZLIB_BLAST_BUILD_SHARED)
if(ZLIB_BLAST_BUILD_STATIC)
add_executable(test_example_static ${BLAST_SRCS})
target_link_libraries(test_example_static BLAST::BLASTSTATIC)
endif(ZLIB_BLAST_BUILD_STATIC)

28
vendor/tcl/compat/zlib/contrib/blast/tester.cmake vendored Normal file
View file

@ -0,0 +1,28 @@
cmake_minimum_required(VERSION 3.12...3.31)
#CMAKE_ARGV0 = ${CMAKE_COMMAND}
#CMAKE_ARGV1 = -P
#CMAKE_ARGV2 = ${CMAKE_CURRENT_SOURCE_DIR}/tester.cmake
#CMAKE_ARGV3 = "$<TARGET_FILE:blast-test>"
#CMAKE_ARGV4 = "${CMAKE_CURRENT_SOURCE_DIR}"
#CMAKE_ARGV5 = "${CMAKE_CURRENT_BINARY_DIR}")
execute_process(COMMAND ${CMAKE_ARGV3}
INPUT_FILE "${CMAKE_ARGV4}/test.pk"
OUTPUT_FILE "${CMAKE_ARGV5}/output.txt"
RESULT_VARIABLE RESULT)
if(RESULT)
message(FATAL_ERROR "Command exitited with: ${RESULT}")
endif(RESULT)
execute_process(COMMAND ${CMAKE_ARGV0} -E compare_files
"${CMAKE_ARGV4}/test.txt"
"${CMAKE_ARGV5}/output.txt"
RESULT_VARIABLE RESULT)
file(REMOVE "${CMAKE_ARGV5}/output.txt")
if(RESULT)
message(FATAL_ERROR "Files differ")
endif(RESULT)

67
vendor/tcl/compat/zlib/contrib/crc32vx/CMakeLists.txt vendored Normal file
View file

@ -0,0 +1,67 @@
# check if we compile for IBM s390x
#
CHECK_C_SOURCE_COMPILES("
#ifndef __s390x__
#error
#endif
int main() {return 0;}
" HAS_S390X_SUPPORT)
#
# Check for IBM S390X - VX extensions
#
if(ZLIB_WITH_CRC32VX AND HAS_S390X_SUPPORT)
# preset the compiler specific flags
if (CMAKE_C_COMPILER_ID STREQUAL "Clang")
set(VGFMAFLAG "-fzvector")
else()
set(VGFMAFLAG "-mzarch")
endif(CMAKE_C_COMPILER_ID STREQUAL "Clang")
set(S390X_VX_TEST
"#ifndef __s390x__ \n\
#error \n\
#endif \n\
#include <vecintrin.h> \n\
int main(void) { \
unsigned long long a __attribute__((vector_size(16))) = { 0 }; \
unsigned long long b __attribute__((vector_size(16))) = { 0 }; \
unsigned char c __attribute__((vector_size(16))) = { 0 }; \
c = vec_gfmsum_accum_128(a, b, c); \
return c[0]; \
}")
# cflags already contains a valid march
set(CMAKE_REQUIRED_FLAGS "${VGFMAFLAG}")
check_c_source_compiles("${S390X_VX_TEST}" HAS_S390X_VX_SUPPORT)
unset(CMAKE_REQUIRED_FLAGS)
# or set march for our compile units
if(NOT HAS_S390X_VX_SUPPORT)
set(CMAKE_REQUIRED_FLAGS "${VGFMAFLAG} -march=z13")
check_c_source_compiles("${S390X_VX_TEST}" HAS_Z13_S390X_VX_SUPPORT)
unset(CMAKE_REQUIRED_FLAGS )
list(APPEND VGFMAFLAG "-march=z13")
endif(NOT HAS_S390X_VX_SUPPORT)
# prepare compiling for s390x
if(HAS_S390X_VX_SUPPORT OR HAS_Z13_S390X_VX_SUPPORT)
if(ZLIB_BUILD_SHARED)
target_sources(zlib
PRIVATE
crc32_vx.c
crc32_vx_hooks.h)
target_compile_definitions(zlib PUBLIC -DHAVE_S390X_VX=1)
endif(ZLIB_BUILD_SHARED)
if(ZLIB_BUILD_STATIC)
target_sources(zlibstatic
PRIVATE
crc32_vx.c
crc32_vx_hooks.h)
target_compile_definitions(zlibstatic PUBLIC -DHAVE_S390X_VX=1)
endif(ZLIB_BUILD_STATIC)
set_source_files_properties(
crc32_vx.c
PROPERTIES COMPILE_OPTIONS "${VGFMAFLAG}")
endif(HAS_S390X_VX_SUPPORT OR HAS_Z13_S390X_VX_SUPPORT)
endif(ZLIB_WITH_CRC32VX AND HAS_S390X_SUPPORT)

9
vendor/tcl/compat/zlib/contrib/crc32vx/README vendored Normal file
View file

@ -0,0 +1,9 @@
IBM Z mainframes starting from version z13 provide vector instructions, which
allows vectorization of crc32. This extension is build by default when targeting
ibm s390x. However this extension can disabled if desired:
# for configure build
$ ./configure --disable-crcvx
# for cmake build
$ cmake .. -DZLIB_CRC32VX=off

254
vendor/tcl/compat/zlib/contrib/crc32vx/crc32_vx.c vendored Normal file
View file

@ -0,0 +1,254 @@
/*
* Hardware-accelerated CRC-32 variants for Linux on z Systems
*
* Use the z/Architecture Vector Extension Facility to accelerate the
* computing of bitreflected CRC-32 checksums.
*
* This CRC-32 implementation algorithm is bitreflected and processes
* the least-significant bit first (Little-Endian).
*
* This code was originally written by Hendrik Brueckner
* <brueckner@linux.vnet.ibm.com> for use in the Linux kernel and has been
* relicensed under the zlib license.
*/
#define Z_ONCE
#include "../../zutil.h"
#include "crc32_vx_hooks.h"
#include <stdint.h>
#include <stdio.h>
#include <vecintrin.h>
#include <sys/auxv.h>
#ifdef __clang__
# if ((__clang_major__ == 18) || (__clang_major__ == 19 && (__clang_minor__ < 1 || (__clang_minor__ == 1 && __clang_patchlevel__ < 2))))
# error crc32_vx optimizations are broken due to compiler bug in Clang versions: 18.0.0 <= clang_version < 19.1.2. \
Either disable the zlib crc32_vx optimization, or switch to another compiler/compiler version.
# endif
#endif
#define VX_MIN_LEN 64
#define VX_ALIGNMENT 16L
#define VX_ALIGN_MASK (VX_ALIGNMENT - 1)
typedef unsigned char uv16qi __attribute__((vector_size(16)));
typedef unsigned int uv4si __attribute__((vector_size(16)));
typedef unsigned long long uv2di __attribute__((vector_size(16)));
local uint32_t crc32_le_vgfm_16(uint32_t crc, const unsigned char *buf, size_t len) {
/*
* The CRC-32 constant block contains reduction constants to fold and
* process particular chunks of the input data stream in parallel.
*
* For the CRC-32 variants, the constants are precomputed according to
* these definitions:
*
* R1 = [(x4*128+32 mod P'(x) << 32)]' << 1
* R2 = [(x4*128-32 mod P'(x) << 32)]' << 1
* R3 = [(x128+32 mod P'(x) << 32)]' << 1
* R4 = [(x128-32 mod P'(x) << 32)]' << 1
* R5 = [(x64 mod P'(x) << 32)]' << 1
* R6 = [(x32 mod P'(x) << 32)]' << 1
*
* The bitreflected Barret reduction constant, u', is defined as
* the bit reversal of floor(x**64 / P(x)).
*
* where P(x) is the polynomial in the normal domain and the P'(x) is the
* polynomial in the reversed (bitreflected) domain.
*
* CRC-32 (IEEE 802.3 Ethernet, ...) polynomials:
*
* P(x) = 0x04C11DB7
* P'(x) = 0xEDB88320
*/
const uv16qi perm_le2be = {15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0}; /* BE->LE mask */
const uv2di r2r1 = {0x1C6E41596, 0x154442BD4}; /* R2, R1 */
const uv2di r4r3 = {0x0CCAA009E, 0x1751997D0}; /* R4, R3 */
const uv2di r5 = {0, 0x163CD6124}; /* R5 */
const uv2di ru_poly = {0, 0x1F7011641}; /* u' */
const uv2di crc_poly = {0, 0x1DB710641}; /* P'(x) << 1 */
/*
* Load the initial CRC value.
*
* The CRC value is loaded into the rightmost word of the
* vector register and is later XORed with the LSB portion
* of the loaded input data.
*/
uv2di v0 = {0, 0};
v0 = (uv2di)vec_insert(crc, (uv4si)v0, 3);
/* Load a 64-byte data chunk and XOR with CRC */
uv2di v1 = vec_perm(((uv2di *)buf)[0], ((uv2di *)buf)[0], perm_le2be);
uv2di v2 = vec_perm(((uv2di *)buf)[1], ((uv2di *)buf)[1], perm_le2be);
uv2di v3 = vec_perm(((uv2di *)buf)[2], ((uv2di *)buf)[2], perm_le2be);
uv2di v4 = vec_perm(((uv2di *)buf)[3], ((uv2di *)buf)[3], perm_le2be);
v1 ^= v0;
buf += 64;
len -= 64;
while (len >= 64) {
/* Load the next 64-byte data chunk */
uv16qi part1 = vec_perm(((uv16qi *)buf)[0], ((uv16qi *)buf)[0], perm_le2be);
uv16qi part2 = vec_perm(((uv16qi *)buf)[1], ((uv16qi *)buf)[1], perm_le2be);
uv16qi part3 = vec_perm(((uv16qi *)buf)[2], ((uv16qi *)buf)[2], perm_le2be);
uv16qi part4 = vec_perm(((uv16qi *)buf)[3], ((uv16qi *)buf)[3], perm_le2be);
/*
* Perform a GF(2) multiplication of the doublewords in V1 with
* the R1 and R2 reduction constants in V0. The intermediate result
* is then folded (accumulated) with the next data chunk in PART1 and
* stored in V1. Repeat this step for the register contents
* in V2, V3, and V4 respectively.
*/
v1 = (uv2di)vec_gfmsum_accum_128(r2r1, v1, part1);
v2 = (uv2di)vec_gfmsum_accum_128(r2r1, v2, part2);
v3 = (uv2di)vec_gfmsum_accum_128(r2r1, v3, part3);
v4 = (uv2di)vec_gfmsum_accum_128(r2r1, v4, part4);
buf += 64;
len -= 64;
}
/*
* Fold V1 to V4 into a single 128-bit value in V1. Multiply V1 with R3
* and R4 and accumulating the next 128-bit chunk until a single 128-bit
* value remains.
*/
v1 = (uv2di)vec_gfmsum_accum_128(r4r3, v1, (uv16qi)v2);
v1 = (uv2di)vec_gfmsum_accum_128(r4r3, v1, (uv16qi)v3);
v1 = (uv2di)vec_gfmsum_accum_128(r4r3, v1, (uv16qi)v4);
while (len >= 16) {
/* Load next data chunk */
v2 = vec_perm(*(uv2di *)buf, *(uv2di *)buf, perm_le2be);
/* Fold next data chunk */
v1 = (uv2di)vec_gfmsum_accum_128(r4r3, v1, (uv16qi)v2);
buf += 16;
len -= 16;
}
/*
* Set up a vector register for byte shifts. The shift value must
* be loaded in bits 1-4 in byte element 7 of a vector register.
* Shift by 8 bytes: 0x40
* Shift by 4 bytes: 0x20
*/
uv16qi v9 = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
v9 = vec_insert((unsigned char)0x40, v9, 7);
/*
* Prepare V0 for the next GF(2) multiplication: shift V0 by 8 bytes
* to move R4 into the rightmost doubleword and set the leftmost
* doubleword to 0x1.
*/
v0 = vec_srb(r4r3, (uv2di)v9);
v0[0] = 1;
/*
* Compute GF(2) product of V1 and V0. The rightmost doubleword
* of V1 is multiplied with R4. The leftmost doubleword of V1 is
* multiplied by 0x1 and is then XORed with rightmost product.
* Implicitly, the intermediate leftmost product becomes padded
*/
v1 = (uv2di)vec_gfmsum_128(v0, v1);
/*
* Now do the final 32-bit fold by multiplying the rightmost word
* in V1 with R5 and XOR the result with the remaining bits in V1.
*
* To achieve this by a single VGFMAG, right shift V1 by a word
* and store the result in V2 which is then accumulated. Use the
* vector unpack instruction to load the rightmost half of the
* doubleword into the rightmost doubleword element of V1; the other
* half is loaded in the leftmost doubleword.
* The vector register with CONST_R5 contains the R5 constant in the
* rightmost doubleword and the leftmost doubleword is zero to ignore
* the leftmost product of V1.
*/
v9 = vec_insert((unsigned char)0x20, v9, 7);
v2 = vec_srb(v1, (uv2di)v9);
v1 = vec_unpackl((uv4si)v1); /* Split rightmost doubleword */
v1 = (uv2di)vec_gfmsum_accum_128(r5, v1, (uv16qi)v2);
/*
* Apply a Barret reduction to compute the final 32-bit CRC value.
*
* The input values to the Barret reduction are the degree-63 polynomial
* in V1 (R(x)), degree-32 generator polynomial, and the reduction
* constant u. The Barret reduction result is the CRC value of R(x) mod
* P(x).
*
* The Barret reduction algorithm is defined as:
*
* 1. T1(x) = floor( R(x) / x^32 ) GF2MUL u
* 2. T2(x) = floor( T1(x) / x^32 ) GF2MUL P(x)
* 3. C(x) = R(x) XOR T2(x) mod x^32
*
* Note: The leftmost doubleword of vector register containing
* CONST_RU_POLY is zero and, thus, the intermediate GF(2) product
* is zero and does not contribute to the final result.
*/
/* T1(x) = floor( R(x) / x^32 ) GF2MUL u */
v2 = vec_unpackl((uv4si)v1);
v2 = (uv2di)vec_gfmsum_128(ru_poly, v2);
/*
* Compute the GF(2) product of the CRC polynomial with T1(x) in
* V2 and XOR the intermediate result, T2(x), with the value in V1.
* The final result is stored in word element 2 of V2.
*/
v2 = vec_unpackl((uv4si)v2);
v2 = (uv2di)vec_gfmsum_accum_128(crc_poly, v2, (uv16qi)v1);
return ((uv4si)v2)[2];
}
local unsigned long s390_crc32_vx(unsigned long crc, const unsigned char FAR *buf, z_size_t len)
{
uintptr_t prealign, aligned, remaining;
if (buf == Z_NULL) return 0UL;
if (len < VX_MIN_LEN + VX_ALIGN_MASK)
return crc32_z(crc, buf, len);
if ((uintptr_t)buf & VX_ALIGN_MASK) {
prealign = VX_ALIGNMENT - ((uintptr_t)buf & VX_ALIGN_MASK);
len -= prealign;
crc = crc32_z(crc, buf, prealign);
buf += prealign;
}
aligned = len & ~VX_ALIGN_MASK;
remaining = len & VX_ALIGN_MASK;
crc = crc32_le_vgfm_16(crc ^ 0xffffffff, buf, (size_t)aligned) ^ 0xffffffff;
if (remaining)
crc = crc32_z(crc, buf + aligned, remaining);
return crc;
}
local z_once_t s390_crc32_made = Z_ONCE_INIT;
local void s390_crc32_setup() {
unsigned long hwcap = getauxval(AT_HWCAP);
if (hwcap & HWCAP_S390_VX)
crc32_z_hook = s390_crc32_vx;
else
crc32_z_hook = crc32_z;
}
local unsigned long s390_crc32_init(unsigned long crc, const unsigned char FAR *buf, z_size_t len)
{
z_once(&s390_crc32_made,s390_crc32_setup);
return crc32_z_hook(crc, buf, len);
}
ZLIB_INTERNAL unsigned long (*crc32_z_hook)(unsigned long crc, const unsigned char FAR *buf, z_size_t len) = s390_crc32_init;

9
vendor/tcl/compat/zlib/contrib/crc32vx/crc32_vx_hooks.h vendored Normal file
View file

@ -0,0 +1,9 @@
#ifndef CRC32_VX_HOOKS_H
#define CRC32_VX_HOOKS_H
/**
* CRC HOOKS
*/
ZLIB_INTERNAL extern unsigned long (*crc32_z_hook)(unsigned long crc, const unsigned char FAR *buf, z_size_t len);
#endif /* CRC32_VX_HOOKS_H */

557
vendor/tcl/compat/zlib/contrib/delphi/ZLib.pas vendored Normal file
View file

@ -0,0 +1,557 @@
{*******************************************************}
{ }
{ Borland Delphi Supplemental Components }
{ ZLIB Data Compression Interface Unit }
{ }
{ Copyright (c) 1997,99 Borland Corporation }
{ }
{*******************************************************}
{ Updated for zlib 1.2.x by Cosmin Truta <cosmint@cs.ubbcluj.ro> }
unit ZLib;
interface
uses SysUtils, Classes;
type
TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
TFree = procedure (AppData, Block: Pointer); cdecl;
// Internal structure. Ignore.
TZStreamRec = packed record
next_in: PChar; // next input byte
avail_in: Integer; // number of bytes available at next_in
total_in: Longint; // total nb of input bytes read so far
next_out: PChar; // next output byte should be put here
avail_out: Integer; // remaining free space at next_out
total_out: Longint; // total nb of bytes output so far
msg: PChar; // last error message, NULL if no error
internal: Pointer; // not visible by applications
zalloc: TAlloc; // used to allocate the internal state
zfree: TFree; // used to free the internal state
AppData: Pointer; // private data object passed to zalloc and zfree
data_type: Integer; // best guess about the data type: ascii or binary
adler: Longint; // adler32 value of the uncompressed data
reserved: Longint; // reserved for future use
end;
// Abstract ancestor class
TCustomZlibStream = class(TStream)
private
FStrm: TStream;
FStrmPos: Integer;
FOnProgress: TNotifyEvent;
FZRec: TZStreamRec;
FBuffer: array [Word] of Char;
protected
procedure Progress(Sender: TObject); dynamic;
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
constructor Create(Strm: TStream);
end;
{ TCompressionStream compresses data on the fly as data is written to it, and
stores the compressed data to another stream.
TCompressionStream is write-only and strictly sequential. Reading from the
stream will raise an exception. Using Seek to move the stream pointer
will raise an exception.
Output data is cached internally, written to the output stream only when
the internal output buffer is full. All pending output data is flushed
when the stream is destroyed.
The Position property returns the number of uncompressed bytes of
data that have been written to the stream so far.
CompressionRate returns the on-the-fly percentage by which the original
data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
If raw data size = 100 and compressed data size = 25, the CompressionRate
is 75%
The OnProgress event is called each time the output buffer is filled and
written to the output stream. This is useful for updating a progress
indicator when you are writing a large chunk of data to the compression
stream in a single call.}
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
TCompressionStream = class(TCustomZlibStream)
private
function GetCompressionRate: Single;
public
constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property CompressionRate: Single read GetCompressionRate;
property OnProgress;
end;
{ TDecompressionStream decompresses data on the fly as data is read from it.
Compressed data comes from a separate source stream. TDecompressionStream
is read-only and unidirectional; you can seek forward in the stream, but not
backwards. The special case of setting the stream position to zero is
allowed. Seeking forward decompresses data until the requested position in
the uncompressed data has been reached. Seeking backwards, seeking relative
to the end of the stream, requesting the size of the stream, and writing to
the stream will raise an exception.
The Position property returns the number of bytes of uncompressed data that
have been read from the stream so far.
The OnProgress event is called each time the internal input buffer of
compressed data is exhausted and the next block is read from the input stream.
This is useful for updating a progress indicator when you are reading a
large chunk of data from the decompression stream in a single call.}
TDecompressionStream = class(TCustomZlibStream)
public
constructor Create(Source: TStream);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property OnProgress;
end;
{ CompressBuf compresses data, buffer to buffer, in one call.
In: InBuf = ptr to compressed data
InBytes = number of bytes in InBuf
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
OutBytes = number of bytes in OutBuf }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
out OutBuf: Pointer; out OutBytes: Integer);
{ DecompressBuf decompresses data, buffer to buffer, in one call.
In: InBuf = ptr to compressed data
InBytes = number of bytes in InBuf
OutEstimate = zero, or est. size of the decompressed data
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
OutBytes = number of bytes in OutBuf }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
{ DecompressToUserBuf decompresses data, buffer to buffer, in one call.
In: InBuf = ptr to compressed data
InBytes = number of bytes in InBuf
Out: OutBuf = ptr to user-allocated buffer to contain decompressed data
BufSize = number of bytes in OutBuf }
procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
const OutBuf: Pointer; BufSize: Integer);
const
zlib_version = '1.3.2';
type
EZlibError = class(Exception);
ECompressionError = class(EZlibError);
EDecompressionError = class(EZlibError);
implementation
uses ZLibConst;
const
Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
Z_OK = 0;
Z_STREAM_END = 1;
Z_NEED_DICT = 2;
Z_ERRNO = (-1);
Z_STREAM_ERROR = (-2);
Z_DATA_ERROR = (-3);
Z_MEM_ERROR = (-4);
Z_BUF_ERROR = (-5);
Z_VERSION_ERROR = (-6);
Z_NO_COMPRESSION = 0;
Z_BEST_SPEED = 1;
Z_BEST_COMPRESSION = 9;
Z_DEFAULT_COMPRESSION = (-1);
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_RLE = 3;
Z_DEFAULT_STRATEGY = 0;
Z_BINARY = 0;
Z_ASCII = 1;
Z_UNKNOWN = 2;
Z_DEFLATED = 8;
{$L adler32.obj}
{$L compress.obj}
{$L crc32.obj}
{$L deflate.obj}
{$L infback.obj}
{$L inffast.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L trees.obj}
{$L uncompr.obj}
{$L zutil.obj}
procedure adler32; external;
procedure compressBound; external;
procedure crc32; external;
procedure deflateInit2_; external;
procedure deflateParams; external;
function _malloc(Size: Integer): Pointer; cdecl;
begin
Result := AllocMem(Size);
end;
procedure _free(Block: Pointer); cdecl;
begin
FreeMem(Block);
end;
procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
FillChar(P^, count, B);
end;
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
Move(source^, dest^, count);
end;
// deflate compresses data
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;
// inflate decompresses data
function inflateInit_(var strm: TZStreamRec; version: PChar;
recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
begin
// GetMem(Result, Items*Size);
Result := AllocMem(Items * Size);
end;
procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
begin
FreeMem(Block);
end;
{function zlibCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise EZlibError.Create('error'); //!!
end;}
function CCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise ECompressionError.Create('error'); //!!
end;
function DCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise EDecompressionError.Create('error'); //!!
end;
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
out OutBuf: Pointer; out OutBytes: Integer);
var
strm: TZStreamRec;
P: Pointer;
begin
FillChar(strm, sizeof(strm), 0);
strm.zalloc := zlibAllocMem;
strm.zfree := zlibFreeMem;
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
GetMem(OutBuf, OutBytes);
try
strm.next_in := InBuf;
strm.avail_in := InBytes;
strm.next_out := OutBuf;
strm.avail_out := OutBytes;
CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
try
while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, 256);
ReallocMem(OutBuf, OutBytes);
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
strm.avail_out := 256;
end;
finally
CCheck(deflateEnd(strm));
end;
ReallocMem(OutBuf, strm.total_out);
OutBytes := strm.total_out;
except
FreeMem(OutBuf);
raise
end;
end;
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
strm: TZStreamRec;
P: Pointer;
BufInc: Integer;
begin
FillChar(strm, sizeof(strm), 0);
strm.zalloc := zlibAllocMem;
strm.zfree := zlibFreeMem;
BufInc := (InBytes + 255) and not 255;
if OutEstimate = 0 then
OutBytes := BufInc
else
OutBytes := OutEstimate;
GetMem(OutBuf, OutBytes);
try
strm.next_in := InBuf;
strm.avail_in := InBytes;
strm.next_out := OutBuf;
strm.avail_out := OutBytes;
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
try
while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, BufInc);
ReallocMem(OutBuf, OutBytes);
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
strm.avail_out := BufInc;
end;
finally
DCheck(inflateEnd(strm));
end;
ReallocMem(OutBuf, strm.total_out);
OutBytes := strm.total_out;
except
FreeMem(OutBuf);
raise
end;
end;
procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
const OutBuf: Pointer; BufSize: Integer);
var
strm: TZStreamRec;
begin
FillChar(strm, sizeof(strm), 0);
strm.zalloc := zlibAllocMem;
strm.zfree := zlibFreeMem;
strm.next_in := InBuf;
strm.avail_in := InBytes;
strm.next_out := OutBuf;
strm.avail_out := BufSize;
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
try
if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then
raise EZlibError.CreateRes(@sTargetBufferTooSmall);
finally
DCheck(inflateEnd(strm));
end;
end;
// TCustomZlibStream
constructor TCustomZLibStream.Create(Strm: TStream);
begin
inherited Create;
FStrm := Strm;
FStrmPos := Strm.Position;
FZRec.zalloc := zlibAllocMem;
FZRec.zfree := zlibFreeMem;
end;
procedure TCustomZLibStream.Progress(Sender: TObject);
begin
if Assigned(FOnProgress) then FOnProgress(Sender);
end;
// TCompressionStream
constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
Dest: TStream);
const
Levels: array [TCompressionLevel] of ShortInt =
(Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
inherited Create(Dest);
FZRec.next_out := FBuffer;
FZRec.avail_out := sizeof(FBuffer);
CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
end;
destructor TCompressionStream.Destroy;
begin
FZRec.next_in := nil;
FZRec.avail_in := 0;
try
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
and (FZRec.avail_out = 0) do
begin
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := FBuffer;
FZRec.avail_out := sizeof(FBuffer);
end;
if FZRec.avail_out < sizeof(FBuffer) then
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
finally
deflateEnd(FZRec);
end;
inherited Destroy;
end;
function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;
function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
FZRec.next_in := @Buffer;
FZRec.avail_in := Count;
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (FZRec.avail_in > 0) do
begin
CCheck(deflate(FZRec, 0));
if FZRec.avail_out = 0 then
begin
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := FBuffer;
FZRec.avail_out := sizeof(FBuffer);
FStrmPos := FStrm.Position;
Progress(Self);
end;
end;
Result := Count;
end;
function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
if (Offset = 0) and (Origin = soFromCurrent) then
Result := FZRec.total_in
else
raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;
function TCompressionStream.GetCompressionRate: Single;
begin
if FZRec.total_in = 0 then
Result := 0
else
Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
end;
// TDecompressionStream
constructor TDecompressionStream.Create(Source: TStream);
begin
inherited Create(Source);
FZRec.next_in := FBuffer;
FZRec.avail_in := 0;
DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
end;
destructor TDecompressionStream.Destroy;
begin
FStrm.Seek(-FZRec.avail_in, 1);
inflateEnd(FZRec);
inherited Destroy;
end;
function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
FZRec.next_out := @Buffer;
FZRec.avail_out := Count;
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
while (FZRec.avail_out > 0) do
begin
if FZRec.avail_in = 0 then
begin
FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
if FZRec.avail_in = 0 then
begin
Result := Count - FZRec.avail_out;
Exit;
end;
FZRec.next_in := FBuffer;
FStrmPos := FStrm.Position;
Progress(Self);
end;
CCheck(inflate(FZRec, 0));
end;
Result := Count;
end;
function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
raise EDecompressionError.CreateRes(@sInvalidStreamOp);
end;
function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
I: Integer;
Buf: array [0..4095] of Char;
begin
if (Offset = 0) and (Origin = soFromBeginning) then
begin
DCheck(inflateReset(FZRec));
FZRec.next_in := FBuffer;
FZRec.avail_in := 0;
FStrm.Position := 0;
FStrmPos := 0;
end
else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
begin
if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
if Offset > 0 then
begin
for I := 1 to Offset div sizeof(Buf) do
ReadBuffer(Buf, sizeof(Buf));
ReadBuffer(Buf, Offset mod sizeof(Buf));
end;
end
else
raise EDecompressionError.CreateRes(@sInvalidStreamOp);
Result := FZRec.total_out;
end;
end.

11
vendor/tcl/compat/zlib/contrib/delphi/ZLibConst.pas vendored Normal file
View file

@ -0,0 +1,11 @@
unit ZLibConst;
interface
resourcestring
sTargetBufferTooSmall = 'ZLib error: target buffer may be too small';
sInvalidStreamOp = 'Invalid stream operation';
implementation
end.

76
vendor/tcl/compat/zlib/contrib/delphi/readme.txt vendored Normal file
View file

@ -0,0 +1,76 @@
Overview
========
This directory contains an update to the ZLib interface unit,
distributed by Borland as a Delphi supplemental component.
The original ZLib unit is Copyright (c) 1997,99 Borland Corp.,
and is based on zlib version 1.0.4. There are a series of bugs
and security problems associated with that old zlib version, and
we recommend the users to update their ZLib unit.
Summary of modifications
========================
- Improved makefile, adapted to zlib version 1.2.1.
- Some field types from TZStreamRec are changed from Integer to
Longint, for consistency with the zlib.h header, and for 64-bit
readiness.
- The zlib_version constant is updated.
- The new Z_RLE strategy has its corresponding symbolic constant.
- The allocation and deallocation functions and function types
(TAlloc, TFree, zlibAllocMem and zlibFreeMem) are now cdecl,
and _malloc and _free are added as C RTL stubs. As a result,
the original C sources of zlib can be compiled out of the box,
and linked to the ZLib unit.
Suggestions for improvements
============================
Currently, the ZLib unit provides only a limited wrapper around
the zlib library, and much of the original zlib functionality is
missing. Handling compressed file formats like ZIP/GZIP or PNG
cannot be implemented without having this functionality.
Applications that handle these formats are either using their own,
duplicated code, or not using the ZLib unit at all.
Here are a few suggestions:
- Checksum class wrappers around adler32() and crc32(), similar
to the Java classes that implement the java.util.zip.Checksum
interface.
- The ability to read and write raw deflate streams, without the
zlib stream header and trailer. Raw deflate streams are used
in the ZIP file format.
- The ability to read and write gzip streams, used in the GZIP
file format, and normally produced by the gzip program.
- The ability to select a different compression strategy, useful
to PNG and MNG image compression, and to multimedia compression
in general. Besides the compression level
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
which, in fact, could have used the 'z' prefix and avoided
TColor-like symbols
TCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
there could be a compression strategy
TCompressionStrategy = (zsDefault, zsFiltered, zsHuffmanOnly, zsRle);
- ZIP and GZIP stream handling via TStreams.
--
Cosmin Truta <cosmint@cs.ubbcluj.ro>

99
vendor/tcl/compat/zlib/contrib/delphi/zlibd32.mak vendored Normal file
View file

@ -0,0 +1,99 @@
# Makefile for zlib
# For use with Delphi and C++ Builder under Win32
# Updated for zlib 1.2.x by Cosmin Truta
# ------------ Borland C++ ------------
# This project uses the Delphi (fastcall/register) calling convention:
LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl
CC = bcc32
LD = bcc32
AR = tlib
# do not use "-pr" in CFLAGS
CFLAGS = -a -d -k- -O2 $(LOC)
LDFLAGS =
# variables
ZLIB_LIB = zlib.lib
OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
# targets
all: $(ZLIB_LIB) example.exe minigzip.exe
.c.obj:
$(CC) -c $(CFLAGS) $*.c
adler32.obj: adler32.c zlib.h zconf.h
compress.obj: compress.c zlib.h zconf.h
crc32.obj: crc32.c zlib.h zconf.h crc32.h
deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h
gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h
gzread.obj: gzread.c zlib.h zconf.h gzguts.h
gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h
infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
inffast.h inffixed.h
inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
inffast.h
inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
inffast.h inffixed.h
inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
uncompr.obj: uncompr.c zlib.h zconf.h
zutil.obj: zutil.c zutil.h zlib.h zconf.h
example.obj: test/example.c zlib.h zconf.h
minigzip.obj: test/minigzip.c zlib.h zconf.h
# For the sake of the old Borland make,
# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
-del $(ZLIB_LIB)
$(AR) $(ZLIB_LIB) $(OBJP1)
$(AR) $(ZLIB_LIB) $(OBJP2)
# testing
test: example.exe minigzip.exe
example
echo hello world | minigzip | minigzip -d
example.exe: example.obj $(ZLIB_LIB)
$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
minigzip.exe: minigzip.obj $(ZLIB_LIB)
$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
# cleanup
clean:
-del *.obj
-del *.exe
-del *.lib
-del *.tds
-del zlib.bak
-del foo.gz

33
vendor/tcl/compat/zlib/contrib/dotzlib/DotZLib.build vendored Normal file
View file

@ -0,0 +1,33 @@
<?xml version="1.0" encoding="utf-8" ?>
<project name="DotZLib" default="build" basedir="./DotZLib">
<description>A .Net wrapper library around ZLib1.dll</description>
<property name="nunit.location" value="c:/program files/NUnit V2.1/bin" />
<property name="build.root" value="bin" />
<property name="debug" value="true" />
<property name="nunit" value="true" />
<property name="build.folder" value="${build.root}/debug/" if="${debug}" />
<property name="build.folder" value="${build.root}/release/" unless="${debug}" />
<target name="clean" description="Remove all generated files">
<delete dir="${build.root}" failonerror="false" />
</target>
<target name="build" description="compiles the source code">
<mkdir dir="${build.folder}" />
<csc target="library" output="${build.folder}DotZLib.dll" debug="${debug}">
<references basedir="${nunit.location}">
<includes if="${nunit}" name="nunit.framework.dll" />
</references>
<sources>
<includes name="*.cs" />
<excludes name="UnitTests.cs" unless="${nunit}" />
</sources>
<arg value="/d:nunit" if="${nunit}" />
</csc>
</target>
</project>

BIN
vendor/tcl/compat/zlib/contrib/dotzlib/DotZLib.chm vendored Normal file
View file

Binary file not shown.

21
vendor/tcl/compat/zlib/contrib/dotzlib/DotZLib.sln vendored Normal file
View file

@ -0,0 +1,21 @@
Microsoft Visual Studio Solution File, Format Version 8.00
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "DotZLib", "DotZLib\DotZLib.csproj", "{BB1EE0B1-1808-46CB-B786-949D91117FC5}"
ProjectSection(ProjectDependencies) = postProject
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfiguration) = preSolution
Debug = Debug
Release = Release
EndGlobalSection
GlobalSection(ProjectConfiguration) = postSolution
{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.ActiveCfg = Debug|.NET
{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.Build.0 = Debug|.NET
{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.ActiveCfg = Release|.NET
{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.Build.0 = Release|.NET
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
EndGlobalSection
GlobalSection(ExtensibilityAddIns) = postSolution
EndGlobalSection
EndGlobal

58
vendor/tcl/compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs vendored Normal file
View file

@ -0,0 +1,58 @@
using System.Reflection;
using System.Runtime.CompilerServices;
//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle("DotZLib")]
[assembly: AssemblyDescription(".Net bindings for ZLib compression dll 1.2.x")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("Henrik Ravn")]
[assembly: AssemblyProduct("")]
[assembly: AssemblyCopyright("(c) 2004 by Henrik Ravn")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
//
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:
[assembly: AssemblyVersion("1.0.*")]
//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
// (*) If no key is specified, the assembly is not signed.
// (*) KeyName refers to a key that has been installed in the Crypto Service
// Provider (CSP) on your machine. KeyFile refers to a file which contains
// a key.
// (*) If the KeyFile and the KeyName values are both specified, the
// following processing occurs:
// (1) If the KeyName can be found in the CSP, that key is used.
// (2) If the KeyName does not exist and the KeyFile does exist, the key
// in the KeyFile is installed into the CSP and used.
// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
// When specifying the KeyFile, the location of the KeyFile should be
// relative to the project output directory which is
// %Project Directory%\obj\<configuration>. For example, if your KeyFile is
// located in the project directory, you would specify the AssemblyKeyFile
// attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
// documentation for more information on this.
//
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyKeyFile("")]
[assembly: AssemblyKeyName("")]

Some files were not shown because too many files have changed in this diff Show more