1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 22:27:41 +00:00

Compare commits

..

1 Commits

Author SHA1 Message Date
Calvin Rose
2739605184 Add support for cuddled symbol shorthand. 2020-03-31 20:39:02 -05:00
111 changed files with 3215 additions and 12829 deletions

View File

@@ -1,23 +0,0 @@
image: archlinux
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- with-epoll: |
cd janet
meson setup with-epoll --buildtype=release
cd with-epoll
meson configure -Depoll=true
ninja
ninja test
- no-epoll: |
cd janet
meson setup no-epoll --buildtype=release
cd no-epoll
meson configure -Depoll=false
ninja
ninja test
sudo ninja install
sudo jpm --verbose install circlet
sudo jpm --verbose install spork

View File

@@ -3,31 +3,10 @@ sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
- meson
tasks:
- gmake: |
- build: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install
- meson_min: |
cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
cd build_meson_min
ninja
- meson_prf: |
cd janet
meson setup build_meson_prf --buildtype=release -Dprf=true
cd build_meson_prf
ninja
ninja test
- meson_default: |
cd janet
meson setup build_meson_default --buildtype=release
cd build_meson_default
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

10
.gitattributes vendored
View File

@@ -1,10 +0,0 @@
*.janet linguist-language=Clojure
*.janet text eol=lf
*.c text eol=lf
*.h text eol=lf
*.md text eol=lf
*.yml text eol=lf
*.build text eol=lf
*.txt text eol=lf
*.sh text eol=lf

12
.gitignore vendored
View File

@@ -32,9 +32,6 @@ lockfile.janet
# Local directory for testing
local
# Common test file I use.
temp.janet
# Emscripten
*.bc
janet.js
@@ -46,7 +43,6 @@ janet.wasm
# Generate test files
*.out
.orig
# Tools
xxd
@@ -54,7 +50,6 @@ xxd.exe
# VSCode
.vs
.clangd
# Swap files
*.swp
@@ -66,10 +61,6 @@ tags
vgcore.*
*.out.*
# Wix artifacts
*.msi
*.wixpdb
# Created by https://www.gitignore.io/api/c
### C ###
@@ -140,6 +131,3 @@ compile_commands.json
CTestTestfile.cmake
# End of https://www.gitignore.io/api/cmake
# Astyle
*.orig

View File

@@ -1,245 +1,6 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.15.4 - 2021-03-16
- Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD`
- Update meson.build
- Add option to automatically add shebang line in installed scripts with `jpm`.
- Add `partition-by` and `group-by` to the core.
- Sort keys in pretty printing output.
## 1.15.3 - 2021-02-28
- Fix a fiber bug that occured in deeply nested fibers
- Add `unref` combinator to pegs.
- Small docstring changes.
## 1.15.2 - 2021-02-15
- Fix bug in windows version of `os/spawn` and `os/execute` with setting environment variables.
- Fix documentation typos.
- Fix peg integer reading combinators when used with capture tags.
## 1.15.0 - 2021-02-08
- Fix `gtim` and `ltim` bytecode instructions on non-integer values.
- Clean up output of flychecking to be the same as the repl.
- Change behavior of `debug/stacktrace` with a nil error value.
- Add optional argument to `parser/produce`.
- Add `no-core` option to creating standalone binaries to make execution faster.
- Fix bug where a buffer overflow could be confused with an out of memory error.
- Change error output to `file:line:column: message`. Column is in bytes - tabs
are considered to have width 1 (instead of 8).
## 1.14.2 - 2021-01-23
- Allow `JANET_PROFILE` env variable to load a profile before loading the repl.
- Update `tracev` macro to allow `def` and `var` inside to work as expected.
- Use `(dyn :peg-grammar)` for passing a default grammar to `peg/compile` instead of loading
`default-peg-grammar` directly from the root environment.
- Add `ev/thread` for combining threading with the event loop.
- Add `ev/do-thread` to make `ev/thread` easier to use.
- Automatically set supervisor channel in `net/accept-loop` and `net/server` correctly.
## 1.14.1 - 2021-01-18
- Add `doc-of` for reverse documentation lookup.
- Add `ev/give-supervsior` to send a message to the supervising channel.
- Add `ev/gather` and `chan` argument to `ev/go`. This new argument allows "supervisor channels"
for fibers to enable structured concurrency.
- Make `-k` flag work on stdin if no files are given.
- Add `flycheck` function to core.
- Make `backmatch` and `backref` more expressive in pegs.
- Fix buggy `string/split`.
- Add `fiber/last-value` to get the value that was last yielded, errored, or signaled
by a fiber.
- Remove `:generate` verb from `loop` macros. Instead, use the `:in` verb
which will now work on fibers as well as other data structures.
- Define `next`, `get`, and `in` for fibers. This lets
`each`, `map`, and similar iteration macros can now iterate over fibers.
- Remove macro `eachy`, which can be replaced by `each`.
- Add `dflt` argument to find-index.
- Deprecate `file/popen` in favor of `os/spawn`.
- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
do not provide any `:line` option as that requires buffering.
- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
to clear the current line buffer, has been moved to Ctrl-Q.
- Importing modules that start with `/` is now the only way to import from project root.
Before, this would import from / on disk. Previous imports that did not start with `.` or `/`
are now unambiguously importing from the syspath, instead of checking both the syspath and
the project root. This is backwards incompatible and dependencies should be updated for this.
- Change hash function for numbers.
- Improve error handling of `dofile`.
- Bug fixes in networking and subprocess code.
- Use markdown formatting in more places for docstrings.
## 1.13.1 - 2020-12-13
- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
in the prototype table to tag the output.
- `match` macro implementation changed to be tail recursive.
- Adds a :preload loader which allows one to manually put things into `module/cache`.
- Add `buffer/push` function.
- Backtick delimited strings and buffers are now reindented based on the column of the
opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
- Argument to `(error)` combinator in PEGs is now optional.
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
This should make error reporting a bit easier.
- Add `merge-module` to core.
- During installation and release, merge janetconf.h into janet.h for easier install.
- Add `upscope` special form.
- `os/execute` and `os/spawn` can take streams for redirecting IO.
- Add `:parser` and `:read` parameters to `run-context`.
- Add `os/open` if ev is enabled.
- Add `os/pipe` if ev is enabled.
- Add `janet_thread_current(void)` to C API
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
for single threaded cooperative scheduling and asynchronous IO.
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
and are more flexible. They also allow further improvements to these utility functions.
- Various small bug fixes.
## 1.12.2 - 2020-09-20
- Add janet\_try and janet\_restore to C API.
- Fix `os/execute` regression on windows.
- Add :pipe option to `os/spawn`.
- Fix docstring typos.
## 1.12.1 - 2020-09-07
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
- Add C++ support to jpm and improve C++ interop in janet.h.
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
- Expose `janet_cfuns_prefix` in C API.
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
- Add `janet_getjfile` to C API.
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
When called like this, `os/execute` returns immediately.
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
- Don't run `main` when flychecking.
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
- Fix import macro to not try and coerce everything to a string.
- Allow passing a second argument to `disasm`.
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
- Allow multi-line paste into built in repl.
- Add `(curenv)`.
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
to raise errors or other signals.
- Update meson build script to fix bug on Debian's version of meson
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
- `net/write` now raises an error message if write fails.
- Fix issue with SIGPIPE on macOS and BSDs.
## 1.11.3 - 2020-08-03
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
- Expose `janet_cryptorand` in C API.
- Properly initialize PRF in default janet program
- Add `index-of` to core library.
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
- Fix defaults on Windows for ARM
- Fix defaults on NetBSD.
## 1.11.1 - 2020-07-25
- Fix jpm and git with multiple git installs on Windows
- Fix importing a .so file in the current directory
- Allow passing byte sequence types directly to typed-array constructors.
- Fix bug sending files between threads.
- Disable PRF by default.
- Update the soname.
## 1.11.0 - 2020-07-18
- Add `forever` macro.
- Add `any?` predicate to core.
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
- Add `jpm list-installed` subcommand to see which packages are installed.
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
- The gc interval is now autotuned, to prevent very bad gc behavior.
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
- Add `math/nan`
- Add `forv` macro
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18
- Expose `janet_table_clear` in API.
- Respect `JANET_NO_PROCESSES` define when building
- Fix `jpm` rules having multiple copies of the same dependency.
- Fix `jpm` install in some cases.
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
to their current length.
## 1.10.0 - 2020-06-14
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
- Add `:no-compile` to `create-executable` option for jpm.
- Fix bug with the `trace` function.
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
By default, threads will now consume much less memory per thread, but sending data between
threads may cost more.
- Fix flychecking when using the `use` macro.
- CTRL-C no longer exits the repl, and instead cancels the current form.
- Various small bug fixes
- New MSI installer instead of NSIS based installer.
- Make `os/realpath` work on windows.
- Add polymorphic `compare` functions for comparing numbers.
- Add `to` and `thru` peg combinators.
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
- Expose current macro form inside macros as (dyn :macro-form)
- Add `tracev` macro.
- Fix compiler bug that emitted incorrect code in some cases for while loops that create closures.
- Add `:fresh` option to `(import ...)` to overwrite the module cache.
- `(range x y 0)` will return an empty array instead of hanging forever.
- Rename `jpm repl` to `jpm debug-repl`.
## 1.9.1 - 2020-05-12
- Add :prefix option to declare-source
- Re-enable minimal builds with the debugger.
- Add several flags for configuring Janet on different platforms.
- Fix broken meson build from 1.9.0 and add meson to CI.
- Fix compilation issue when nanboxing is disabled.
## 1.9.0 - 2020-05-10
- Add `:ldflags` option to many jpm declare functions.
- Add `errorf` to core.
- Add `lenprefix` combinator to PEGs.
- Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the
same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values.
- Add `fiber/root`.
- Add beta `net/` module to core for socket based networking.
- Add the `parse` function to parse strings of source code more conveniently.
- Add `jpm rule-tree` subcommand.
- Add `--offline` flag to jpm to force use of the cache.
- Allow sending pointers and C functions across threads via `thread/send`.
- Fix bug in `getline`.
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
- Add `edefer` macro to core.
- A struct/table literal/constructor with duplicate keys will use the last value given.
Previously, this was inconsistent between tables and structs, literals and constructor functions.
- Add debugger to core. The debugger functions are only available
in a debug repl, and are prefixed by a `.`.
- Add `sort-by` and `sorted-by` to core.
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
- Add `math/erf`
- Add `math/erfc`
- Add `math/log1p`
- Add `math/next`
- Add os/umask
- Add os/perm-int
- Add os/perm-string
- Add :int-permissions option for os/stat.
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
- Various bug fixes.
## 1.8.1 - 2020-03-31
- Fix bugs for big endian systems
- Fix 1.8.0 regression on BSDs

View File

@@ -14,6 +14,7 @@ Please read this document before making contributions.
on how to reproduce it. If it is a compiler or language bug, please try to include a minimal
example. This means don't post all 200 lines of code from your project, but spend some time
distilling the problem to just the relevant code.
* Add the `bug` tag to the issue.
## Contributing Changes
@@ -29,13 +30,13 @@ may require changes before being merged.
the test folder and make sure it is run when`make test` is invoked.
* Be consistent with the style. For C this means follow the indentation and style in
other files (files have MIT license at top, 4 spaces indentation, no trailing
whitespace, cuddled brackets, etc.) Use `make format` to automatically format your C code with
whitespace, cuddled brackets, etc.) Use `make format` to
automatically format your C code with
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
to install this, but it can be installed with most package managers.
For janet code, use lisp indentation with 2 spaces. One can use janet.vim to
do this indentation, or approximate as close as possible. There is a janet formatter
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
do this indentation, or approximate as close as possible.
## C style
@@ -73,3 +74,4 @@ timely manner. In short, if you want extra functionality now, then build it.
* Include a good description of the problem that is being solved
* Include descriptions of potential solutions if you have some in mind.
* Add the appropriate tags to the issue. For new features, add the `enhancement` tag.

133
Makefile
View File

@@ -1,4 +1,4 @@
# Copyright (c) 2021 Calvin Rose
# Copyright (c) 2020 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -27,26 +27,18 @@ PREFIX?=/usr/local
INCLUDEDIR?=$(PREFIX)/include
BINDIR?=$(PREFIX)/bin
LIBDIR?=$(PREFIX)/lib
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
JANET_MANPATH?=$(PREFIX)/share/man/man1/
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
CFLAGS?=-O2
LDFLAGS?=-rdynamic
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
LDFLAGS:=$(LDFLAGS) -rdynamic
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -55,7 +47,6 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
UNAME:=$(shell uname -s)
ifeq ($(UNAME), Darwin)
CLIBS:=$(CLIBS) -ldl
SONAME_SETTER:=-Wl,-install_name,
LDCONFIG:=true
else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl
@@ -66,8 +57,8 @@ ifeq ($(UNAME), Haiku)
LDFLAGS=-Wl,--export-dynamic
endif
$(shell mkdir -p build/core build/c build/boot)
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
######################
##### Name Files #####
@@ -97,14 +88,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/corelib.c \
src/core/debug.c \
src/core/emit.c \
src/core/ev.c \
src/core/fiber.c \
src/core/gc.c \
src/core/inttypes.c \
src/core/io.c \
src/core/marsh.c \
src/core/math.c \
src/core/net.c \
src/core/os.c \
src/core/parse.c \
src/core/peg.c \
@@ -139,56 +128,52 @@ JANET_BOOT_HEADERS=src/boot/tests.h
##########################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
# Now the reason we bootstrap in the first place
build/c/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
cksum $@
build/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
########################
##### Amalgamation #####
########################
SONAME=libjanet.so.1.15
build/c/shell.c: src/mainclient/shell.c
build/shell.c: src/mainclient/shell.c
cp $< $@
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
build/janet.h: src/include/janet.h
cp $< $@
build/janetconf.h: src/conf/janetconf.h
cp $< $@
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
build/janet.o: build/janet.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
build/shell.o: build/shell.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(JANET_TARGET): build/janet.o build/shell.o
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): build/janet.o build/shell.o
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(HOSTAR) rcs $@ $^
$(AR) rcs $@ $^
###################
##### Testing #####
###################
# Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet)
repl: $(JANET_TARGET)
@@ -205,12 +190,12 @@ valgrind: $(JANET_TARGET)
test: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
./$(JANET_TARGET) -k jpm
./$(JANET_TARGET) -k auxbin/jpm
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
callgrind: $(JANET_TARGET)
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
@@ -222,9 +207,9 @@ callgrind: $(JANET_TARGET)
dist: build/janet-dist.tar.gz
build/janet-%.tar.gz: $(JANET_TARGET) \
build/janet.h \
src/include/janet.h src/conf/janetconf.h \
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
build/doc.html README.md build/c/janet.c build/c/shell.c jpm
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
mkdir -p build/$(JANET_DIST_DIR)
cp -r $^ build/$(JANET_DIST_DIR)/
@@ -243,9 +228,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
##### Installation #####
########################
build/jpm: jpm $(JANET_TARGET)
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
chmod +x build/jpm
SONAME=libjanet.so.1
.INTERMEDIATE: build/janet.pc
build/janet.pc: $(JANET_TARGET)
@@ -259,26 +242,26 @@ build/janet.pc: $(JANET_TARGET)
echo "Description: Library for the Janet programming language." >> $@
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
echo 'Cflags: -I$${includedir}' >> $@
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm build/janet.h
install: $(JANET_TARGET) build/janet.pc
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)'
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
uninstall:
@@ -286,9 +269,9 @@ uninstall:
-rm '$(DESTDIR)$(BINDIR)/jpm'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(MANPATH)/janet.1'
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
#################
@@ -302,13 +285,8 @@ grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb
compiledb make
clean:
-rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath
test-install:
cd test/install \
@@ -318,33 +296,10 @@ test-install:
&& build/testexec \
&& jpm --verbose quickbin testexec.janet build/testexec2 \
&& build/testexec2 \
&& mkdir -p modpath \
&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
help:
@echo
@echo 'Janet: A Dynamic Language & Bytecode VM'
@echo
@echo Usage:
@echo ' make Build Janet'
@echo ' make repl Start a REPL from a built Janet'
@echo
@echo ' make test Test a built Janet'
@echo ' make valgrind Assess Janet with Valgrind'
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
@echo ' make dist Create a distribution tarball'
@echo ' make docs Generate documentation'
@echo ' make debug Run janet with GDB or LLDB'
@echo ' make install Install into the current filesystem'
@echo ' make uninstall Uninstall from the current filesystem'
@echo ' make clean Clean intermediate build artifacts'
@echo " make format Format Janet's own source files"
@echo ' make grammar Generate a TextMate language grammar'
@echo
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
.PHONY: clean install repl debug valgrind test \
valtest dist uninstall docs grammar format help compile-commands
valtest emscripten dist uninstall docs grammar format

View File

@@ -2,19 +2,19 @@
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
lisp-like language, but lists are replaced
modern lisp, but lists are replaced
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
There is a REPL for trying out the language, as well as the ability
There is a repl for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
Janet can be embedded in other programs. Try Janet in your browser at
Janet can be embedded into other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<br>
@@ -28,23 +28,23 @@ Lua, but smaller than GNU Guile or Python.
## Features
* Minimal setup - one binary and you are good to go!
* First-class closures
* First class closures
* Garbage collection
* First-class green threads (continuations)
* Python-style generators (implemented as a plain macro)
* First class green threads (continuations)
* Python style generators (implemented as a plain macro)
* Mutable and immutable arrays (array/tuple)
* Mutable and immutable hashtables (table/struct)
* Mutable and immutable strings (buffer/string)
* Macros
* Lisp Macros
* Byte code interpreter with an assembly interface, as well as bytecode verification
* Tail call Optimization
* Tailcall Optimization
* Direct interop with C via abstract types and C functions
* Dynamically load C libraries
* Functional and imperative standard library
* Lexical scoping
* Imperative programming as well as functional
* REPL
* Parsing Expression Grammars built into the core library
* Parsing Expression Grammars built in to the core library
* 400+ functions and macros in the core library
* Embedding Janet in other programs
* Interactive environment with detailed stack traces
@@ -54,17 +54,17 @@ Lua, but smaller than GNU Guile or Python.
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
Documentation is also available locally in the REPL.
Documentation is also available locally in the repl.
Use the `(doc symbol-name)` macro to get API
documentation for symbols in the core library. For example,
```
(doc apply)
(doc doc)
```
Shows documentation for the `apply` function.
Shows documentation for the doc macro.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function. You
can also use the `(doc)` macro with no arguments if you are in the REPL
can also use the `(doc)` macro with no arguments if you are in the repl
to show bound symbols.
## Source
@@ -75,7 +75,7 @@ the SourceHut mirror is actively maintained.
## Building
### macOS and Unix-like
### macos and Unix-like
The Makefile is non-portable and requires GNU-flavored make.
@@ -86,11 +86,9 @@ make test
make repl
```
Find out more about the available make targets by running `make help`.
### 32-bit Haiku
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
32-bit Haiku build instructions are the same as the unix-like build instructions,
but you need to specify an alternative compiler, such as `gcc-x86`.
```
@@ -102,7 +100,7 @@ make repl
### FreeBSD
FreeBSD build instructions are the same as the UNIX-like build instructions,
FreeBSD build instructions are the same as the unix-like build instuctions,
but you need `gmake` to compile. Alternatively, install directly from
packages, using `pkg install lang/janet`.
@@ -113,11 +111,6 @@ gmake test
gmake repl
```
### NetBSD
NetBSD build instructions are the same as the FreeBSD build instructions.
Alternatively, install directly from packages, using `pkgin install janet`.
### Windows
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
@@ -125,20 +118,13 @@ Alternatively, install directly from packages, using `pkgin install janet`.
3. Run `build_win` to compile janet.
4. Run `build_win test` to make sure everything is working.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
6. run `build_win dist`
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
### Meson
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross-platform build
system. Although Meson has a Python dependency, Meson is a very complete build system that
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
system. Although Meson has a python dependency, Meson is a very complete build system that
is maybe more convenient and flexible for integrating into existing pipelines.
Meson also provides much better IDE integration than Make or batch files, as well as support
for cross-compilation.
for cross compilation.
For the impatient, building with Meson is as follows. The options provided to
`meson setup` below emulate Janet's Makefile.
@@ -149,7 +135,6 @@ cd janet
meson setup build \
--buildtype release \
--optimization 2 \
--libdir /usr/local/lib \
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
ninja -C build
@@ -175,11 +160,11 @@ to try out the language, you don't need to install anything. You can also move t
## Usage
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
A repl is launched when the binary is invoked with no arguments. Pass the -h flag
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
If you are looking to explore, you can print a list of all available macros, functions, and constants
by entering the command `(all-bindings)` into the REPL.
by entering the command `(all-bindings)` into the repl.
```
$ janet
@@ -197,13 +182,13 @@ Options are:
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-r : Enter the REPL after running all scripts
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide prompt, logo, and REPL output (quiet)
-r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent)
-q : Hide prompt, logo, and repl output (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-n : Disable ANSI color output in the REPL
-n : Disable ANSI color output in the repl
-l path : Execute code in a file before running the main script
-- : Stop handling options
```
@@ -215,7 +200,7 @@ If installed, you can also run `man janet` and `man jpm` to get usage informatio
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
project and compiled into the project. Janet should be compiled with `-std=c99`
on most compilers, and will need to be linked to the math library, `-lm`, and
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
@@ -230,16 +215,16 @@ See the examples directory for some example janet code.
## Discussion
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
## FAQ
### Why is my terminal spitting out junk when I run the REPL?
### Why is my terminal is spitting out junk when I run the repl?
Make sure your terminal supports ANSI escape codes. Most modern terminals will
support these, but some older terminals, Windows consoles, or embedded terminals
will not. If your terminal does not support ANSI escape codes, run the REPL with
support these, but some older terminals, windows consoles, or embedded terminals
will not. If your terminal does not support ANSI escape codes, run the repl with
the `-n` flag, which disables color output. You can also try the `-s` if further issues
ensue.

View File

@@ -4,6 +4,7 @@ image:
- Visual Studio 2019
configuration:
- Release
- Debug
platform:
- x64
- x86
@@ -19,13 +20,17 @@ init:
install:
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
- choco install nsis -y -pre --version 3.05
# Replace makensis.exe and files with special long string build. This should
# prevent issues when setting PATH during installation.
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
- build_win all
- refreshenv
# We need to reload vcvars after refreshing
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
- build_win test-install
- set janet_outname=%appveyor_repo_tag_name%
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
- if "%janet_outname%"=="" set janet_outname=v1.8.1
build: off
artifacts:
@@ -35,13 +40,17 @@ artifacts:
- name: janet.h
path: dist\janet.h
type: File
- name: janetconf.h
path: dist\janetconf.h
type: File
- name: shell.c
path: dist\shell.c
type: File
- name: "janet-$(janet_outname)-windows-%platform%"
path: dist
type: Zip
- path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
- path: "janet-$(janet_outname)-windows-installer.exe"
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
type: File
deploy:

File diff suppressed because it is too large Load Diff

View File

@@ -28,10 +28,10 @@ if not "%JANET_BUILD%" == "" (
@set JANET_COMPILE=%JANET_COMPILE% /DJANET_BUILD="\"%JANET_BUILD%\""
)
if not exist build mkdir build
if not exist build\core mkdir build\core
if not exist build\c mkdir build\c
if not exist build\boot mkdir build\boot
mkdir build
mkdir build\core
mkdir build\mainclient
mkdir build\boot
@rem Build the bootstrap interpreter
for %%f in (src\core\*.c) do (
@@ -44,10 +44,10 @@ for %%f in (src\boot\*.c) do (
)
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL
build\janet_boot . > build\c\janet.c
build\janet_boot . > build\janet.c
@rem Build the sources
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
@if errorlevel 1 goto :BUILDFAIL
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
@if errorlevel 1 goto :BUILDFAIL
@@ -102,9 +102,8 @@ exit /b 0
mkdir dist
janet.exe tools\gendoc.janet > dist\doc.html
janet.exe tools\removecr.janet dist\doc.html
janet.exe tools\removecr.janet build\c\janet.c
copy build\c\janet.c dist\janet.c
copy build\janet.c dist\janet.c
copy src\mainclient\shell.c dist\shell.c
copy janet.exe dist\janet.exe
copy LICENSE dist\LICENSE
@@ -113,37 +112,27 @@ copy README.md dist\README.md
copy janet.lib dist\janet.lib
copy janet.exp dist\janet.exp
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
copy build\janet.h dist\janet.h
copy src\include\janet.h dist\janet.h
copy src\conf\janetconf.h dist\janetconf.h
copy build\libjanet.lib dist\libjanet.lib
copy .\jpm dist\jpm
copy auxbin\jpm dist\jpm
copy tools\jpm.bat dist\jpm.bat
@rem Create installer
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
janet.exe -e "(print (os/arch))" > build\arch.txt
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
set /p JANET_VERSION= < build\version.txt
set /p BUILDARCH= < build\arch.txt
set /p SIXTYFOUR= < build\64bit.txt
echo "JANET_VERSION is %JANET_VERSION%"
if defined APPVEYOR_REPO_TAG_NAME (
set RELEASE_VERSION=%APPVEYOR_REPO_TAG_NAME%
) else (
set RELEASE_VERSION=%JANET_VERSION%
)
if defined CI (
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
) else (
set WIXBIN=
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
exit /b 0
@rem Run the installer. (Installs to the local user with default settings)
:INSTALL
FOR %%a in (janet-*-windows-*-installer.msi) DO (
@echo Running Installer %%a...
%%a /QN
@echo Running Installer...
FOR %%a in (janet-*-windows-installer.exe) DO (
%%a /S /CurrentUser
)
exit /b 0

View File

@@ -1,22 +1,23 @@
# Example of dst bytecode assembly
# Fibonacci sequence, implemented with naive recursion.
(def fibasm
(asm
'{:arity 1
:bytecode @[(ltim 1 0 0x2) # $1 = $0 < 2
(jmpif 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0), push argument for next function call
(call 2 1) # $2 = call($1)
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)
(call 0 1) # $0 = call($1)
(add 0 0 2) # $0 = $0 + $2 (integers)
:done
(ret 0) # return $0
]}))
(def fibasm (asm '{
arity 1
bytecode [
(ltim 1 0 0x2) # $1 = $0 < 2
(jmpif 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0), push argument for next function call
(call 2 1) # $2 = call($1)
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)
(call 0 1) # $0 = call($1)
(add 0 0 2) # $0 = $0 + $2 (integers)
:done
(ret 0) # return $0
]
}))
# Test it

View File

@@ -1,22 +0,0 @@
(defn dowork [name n]
(print name " starting work...")
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
(print name " finished work!"))
# Will be done in parallel
(print "starting group A")
(ev/call dowork "A 2" 2)
(ev/call dowork "A 1" 1)
(ev/call dowork "A 3" 3)
(ev/sleep 4)
# Will also be done in parallel
(print "starting group B")
(ev/call dowork "B 2" 2)
(ev/call dowork "B 1" 1)
(ev/call dowork "B 3" 3)
(ev/sleep 4)
(print "all work done")

View File

@@ -1,15 +0,0 @@
(def c (ev/chan 4))
(defn writer []
(for i 0 10
(ev/sleep 0.1)
(print "writer giving item " i "...")
(ev/give c (string "item " i))))
(defn reader [name]
(forever
(print "reader " name " got " (ev/take c))))
(ev/call writer)
(each letter [:a :b :c :d :e :f :g]
(ev/call reader letter))

View File

@@ -1,18 +1,20 @@
###
### A useful debugger library for Janet. Should be used
### inside a debug repl. This has been moved into the core.
### inside a debug repl.
###
(defn .fiber
"Get the current fiber being debugged."
[]
(dyn :fiber))
(if-let [entry (dyn '_fiber)]
(entry :value)
(dyn :fiber)))
(defn .stack
"Print the current fiber stack"
[]
(print)
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
(debug/stacktrace (.fiber) "")
(print))
(defn .frame

View File

@@ -1,5 +0,0 @@
(with [conn (net/connect "127.0.0.1" 8000)]
(print "writing abcdefg...")
(:write conn "abcdefg")
(print "reading...")
(printf "got: %v" (:read conn 1024)))

View File

@@ -1,15 +0,0 @@
(defn handler
"Simple handler for connections."
[stream]
(defer (:close stream)
(def id (gensym))
(def b @"")
(print "Connection " id "!")
(while (:read stream 1024 b)
(printf " %v -> %v" id b)
(:write stream b)
(buffer/clear b))
(printf "Done %v!" id)
(ev/sleep 0.5)))
(net/server "127.0.0.1" "8000" handler)

View File

@@ -1,12 +0,0 @@
(defn worker
"Run for a number of iterations."
[name iterations]
(for i 0 iterations
(ev/sleep 1)
(print "worker " name " iteration " i)))
(ev/call worker :a 10)
(ev/sleep 0.2)
(ev/call worker :b 5)
(ev/sleep 0.3)
(ev/call worker :c 12)

View File

@@ -1,19 +0,0 @@
(def f
(coro
(for i 0 10
(yield (string "yield " i))
(os/sleep 0))))
(print "simple yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(def f
(coro
(for i 0 10
(yield (string "yield " i))
(ev/sleep 0))))
(print "complex yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(print (fiber/status f))

View File

@@ -1,4 +1,10 @@
(import build/numarray)
(import cook)
(cook/make-native
:name "numarray"
:source @["numarray.c"])
(import build/numarray :as numarray)
(def a (numarray/new 30))
(print (get a 20))

View File

@@ -23,7 +23,7 @@ static int num_array_gc(void *p, size_t s) {
return 0;
}
int num_array_get(void *p, Janet key, Janet *out);
Janet num_array_get(void *p, Janet key);
void num_array_put(void *p, Janet key, Janet value);
static const JanetAbstractType num_array_type = {
@@ -31,8 +31,7 @@ static const JanetAbstractType num_array_type = {
num_array_gc,
NULL,
num_array_get,
num_array_put,
JANET_ATEND_PUT
num_array_put
};
static Janet num_array_new(int32_t argc, Janet *argv) {
@@ -82,20 +81,21 @@ static const JanetMethod methods[] = {
{NULL, NULL}
};
int num_array_get(void *p, Janet key, Janet *out) {
Janet num_array_get(void *p, Janet key) {
size_t index;
Janet value;
num_array *array = (num_array *)p;
if (janet_checktype(key, JANET_KEYWORD))
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
return janet_getmethod(janet_unwrap_keyword(key), methods);
if (!janet_checkint(key))
janet_panic("expected integer key");
index = (size_t)janet_unwrap_integer(key);
if (index >= array->size) {
return 0;
value = janet_wrap_nil();
} else {
*out = janet_wrap_number(array->data[index]);
value = janet_wrap_number(array->data[index]);
}
return 1;
return value;
}
static const JanetReg cfuns[] = {

View File

@@ -1,7 +0,0 @@
(declare-project
:name "numarray"
:description "Example c lib with abstract type")
(declare-native
:name "numarray"
:source @["numarray.c"])

View File

@@ -1,23 +0,0 @@
(def channels
(seq [:repeat 5] (ev/chan 4)))
(defn writer [c]
(for i 0 3
(def item (string i ":" (mod (hash c) 999)))
(ev/sleep 0.1)
(print "writer giving item " item " to " c "...")
(ev/give c item))
(print "Done!"))
(defn reader [name]
(forever
(def [_ c x] (ev/rselect ;channels))
(print "reader " name " got " x " from " c)))
# Readers
(each letter [:a :b :c :d :e :f :g]
(ev/call reader letter))
# Writers
(each c channels
(ev/call writer c))

View File

@@ -1,37 +0,0 @@
###
### examples/select2.janet
###
### Mix reads and writes in select.
###
(def c1 (ev/chan 40))
(def c2 (ev/chan 40))
(def c3 (ev/chan 40))
(def c4 (ev/chan 40))
(def c5 (ev/chan 4))
(defn worker
[c n x]
(forever
(ev/sleep n)
(ev/give c x)))
(defn writer-worker
[c]
(forever
(ev/sleep 0.2)
(print "writing " (ev/take c))))
(ev/call worker c1 1 :item1)
(ev/sleep 0.2)
(ev/call worker c2 1 :item2)
(ev/sleep 0.1)
(ev/call worker c3 1 :item3)
(ev/sleep 0.2)
(ev/call worker c4 1 :item4)
(ev/sleep 0.1)
(ev/call worker c4 1 :item5)
(ev/call writer-worker c5)
(forever (pp (ev/rselect c1 c2 c3 c4 [c5 :thing])))

View File

@@ -1,6 +0,0 @@
(with [conn (net/connect "127.0.0.1" "8000")]
(printf "Connected to %q!" conn)
(:write conn "Echo...")
(print "Wrote to connection...")
(def res (:read conn 1024))
(pp res))

View File

@@ -1,20 +0,0 @@
(defn handler
"Simple handler for connections."
[stream]
(defer (:close stream)
(def id (gensym))
(def b @"")
(print "Connection " id "!")
(while (:read stream 1024 b)
(repeat 10 (print "work for " id " ...") (ev/sleep 0.1))
(:write stream b)
(buffer/clear b))
(printf "Done %v!" id)))
# Run server.
(let [server (net/server "127.0.0.1" "8000")]
(print "Starting echo server on 127.0.0.1:8000")
(forever
(if-let [conn (:accept server)]
(ev/call handler conn)
(print "no new connections"))))

View File

@@ -1,5 +0,0 @@
(def conn (net/connect "127.0.0.1" "8009" :datagram))
(:write conn (string/format "%q" (os/cryptorand 16)))
(def x (:read conn 1024))
(pp x)

View File

@@ -1,6 +0,0 @@
(def server (net/listen "127.0.0.1" "8009" :datagram))
(while true
(def buf @"")
(def who (:recv-from server 1024 buf))
(printf "got %q from %v, echoing!" buf who)
(:send-to server who buf))

210
janet-installer.nsi Normal file
View File

@@ -0,0 +1,210 @@
Unicode True
!echo "Program Files: ${PROGRAMFILES}"
!addplugindir "tools\"
# Version
!define PRODUCT_VERSION "${VERSION}.0"
VIProductVersion "${PRODUCT_VERSION}"
VIFileVersion "${PRODUCT_VERSION}"
# Use the modern UI
!define MULTIUSER_EXECUTIONLEVEL Highest
!define MULTIUSER_MUI
!define MULTIUSER_INSTALLMODE_COMMANDLINE
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
!if ${SIXTYFOUR} == "true"
!define MULTIUSER_USE_PROGRAMFILES64
!endif
# Includes
!include "MultiUser.nsh"
!include "MUI2.nsh"
!include "LogicLib.nsh"
# Basics
Name "Janet"
# Do some NSIS-fu to figure out at compile time if we are in appveyor
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
!define "CHECK_${OUTNAME}"
!define DOLLAR "$"
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
# We are not in the appveyor environment, use version name
!define OUTNAME_PART v${VERSION}
!else
# We are in appveyor, use git tag name for installer
!define OUTNAME_PART ${OUTNAME}
!endif
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
# Some Configuration
!define APPNAME "Janet"
!define DESCRIPTION "The Janet Programming Language"
!define HELPURL "http://janet-lang.org"
BrandingText "The Janet Programming Language"
# Macros for setting registry values
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
!macro WriteEnv key value
${If} $MultiUser.InstallMode == "AllUsers"
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
${Else}
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
${EndIf}
!macroend
!macro DelEnv key
${If} $MultiUser.InstallMode == "AllUsers"
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
${Else}
DeleteRegValue HKCU "Environment" "${key}"
${EndIf}
!macroend
# MUI Configuration
!define MUI_ICON "assets\icon.ico"
!define MUI_UNICON "assets\icon.ico"
!define MUI_HEADERIMAGE
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
!define MUI_HEADERIMAGE_RIGHT
!define MUI_ABORTWARNING
# Show a welcome page first
!insertmacro MUI_PAGE_WELCOME
!insertmacro MUI_PAGE_LICENSE "LICENSE"
# Pick Install Directory
!insertmacro MULTIUSER_PAGE_INSTALLMODE
!insertmacro MUI_PAGE_DIRECTORY
!insertmacro MUI_PAGE_INSTFILES
# Done
!insertmacro MUI_PAGE_FINISH
# Need to set a language.
!insertmacro MUI_LANGUAGE "English"
function .onInit
!insertmacro MULTIUSER_INIT
functionEnd
section "Janet" BfWSection
createDirectory "$INSTDIR\Library"
createDirectory "$INSTDIR\C"
createDirectory "$INSTDIR\bin"
createDirectory "$INSTDIR\docs"
setOutPath "$INSTDIR"
# Bin files
file /oname=bin\janet.exe dist\janet.exe
file /oname=logo.ico assets\icon.ico
file /oname=bin\jpm.janet auxbin\jpm
file /oname=bin\jpm.bat tools\jpm.bat
# C headers and library files
file /oname=C\janet.h dist\janet.h
file /oname=C\janetconf.h dist\janetconf.h
file /oname=C\janet.lib dist\janet.lib
file /oname=C\janet.exp dist\janet.exp
file /oname=C\janet.c dist\janet.c
file /oname=C\libjanet.lib dist\libjanet.lib
# Documentation
file /oname=docs\docs.html dist\doc.html
# Other
file README.md
file LICENSE
# Uninstaller - See function un.onInit and section "uninstall" for configuration
writeUninstaller "$INSTDIR\uninstall.exe"
# Start Menu
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
# Update path
${If} $MultiUser.InstallMode == "AllUsers"
EnVar::SetHKLM
${Else}
EnVar::SetHKCU
${EndIf}
EnVar::AddValue "PATH" "$INSTDIR\bin"
Pop $0
# Set up Environment variables
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Registry information for add/remove programs
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
# Add uninstall
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
sectionEnd
# Uninstaller
function un.onInit
!insertmacro MULTIUSER_UNINIT
functionEnd
section "uninstall"
# Remove Start Menu launcher
delete "$SMPROGRAMS\Janet.lnk"
# Remove files
delete "$INSTDIR\logo.ico"
delete "$INSTDIR\README.md"
delete "$INSTDIR\LICENSE"
rmdir /r "$INSTDIR\Library"
rmdir /r "$INSTDIR\bin"
rmdir /r "$INSTDIR\C"
rmdir /r "$INSTDIR\docs"
# Remove env vars
!insertmacro DelEnv JANET_PATH
!insertmacro DelEnv JANET_HEADERPATH
!insertmacro DelEnv JANET_LIBPATH
!insertmacro DelEnv JANET_BINPATH
# Unset PATH
${If} $MultiUser.InstallMode == "AllUsers"
EnVar::SetHKLM
${Else}
EnVar::SetHKCU
${EndIf}
EnVar::DeleteValue "PATH" "$INSTDIR\bin"
Pop $0
# make sure windows knows about the change
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Always delete uninstaller as the last action
delete "$INSTDIR\uninstall.exe"
# Remove uninstaller information from the registry
DeleteRegKey SHCTX "${UNINST_KEY}"
sectionEnd

46
janet.1
View File

@@ -13,8 +13,8 @@ janet \- run the Janet language abstract machine
.BR args ...
.SH DESCRIPTION
Janet is a functional and imperative programming language and bytecode interpreter.
It is a Lisp-like language, but lists are replaced by other data structures
(arrays, tables, structs, tuples). The language also features bridging
It is a modern lisp, but lists are replaced by other data structures with better utility
and performance (arrays, tables, structs, tuples). The language also features bridging
to native code written in C, meta-programming with macros, and bytecode assembly.
There is a repl for trying out the language, as well as the ability to run script files.
@@ -64,10 +64,6 @@ Move cursor to the beginning of input line.
.BR Ctrl\-B
Move cursor one character to the left.
.TP 16
.BR Ctrl\-D
If on a newline, indicate end of stream and exit the repl.
.TP 16
.BR Ctrl\-E
Move cursor to the end of input line.
@@ -100,14 +96,6 @@ Delete everything before the cursor on the input line.
.BR Ctrl\-W
Delete one word before the cursor.
.TP 16
.BR Ctrl\-G
Show documentation for the current symbol under the cursor.
.TP 16
.BR Ctrl\-Q
Clear the current command, including already typed lines.
.TP 16
.BR Alt\-B/Alt\-F
Move cursor backwards and forwards one word.
@@ -160,12 +148,6 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
arguments are executed before later ones.
.TP
.BR \-d
Enable debug mode. On all terminating signals as well the debug signal, this will
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
default repl.
.TP
.BR \-n
Disable ANSI colors in the repl. Has no effect if no repl is run.
@@ -175,10 +157,6 @@ Disable ANSI colors in the repl. Has no effect if no repl is run.
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
arguments, a REPL is opened.
.TP
.BR \-R
If using the REPL, disable loading the user profile from the JANET_PROFILE environment variable.
.TP
.BR \-p
Turn on the persistent flag. By default, when Janet is executing commands from a file and encounters an error,
@@ -187,7 +165,7 @@ after an error. Persistent mode can be good for debugging and testing.
.TP
.BR \-q
Hide the logo in the repl.
Quiet output. Don't print a repl prompt or expression results to stdout.
.TP
.BR \-k
@@ -206,8 +184,8 @@ Source should be a path to the Janet module to compile, and output should be the
resulting image. Output should usually end with the .jimage extension.
.TP
.BR \-l\ lib
Import a Janet module before running a script or repl. Multiple files can be loaded
.BR \-l\ path
Load a Janet file before running a script or repl. Multiple files can be loaded
in this manner, and exports from each file will be made available to the script
or repl.
@@ -225,19 +203,5 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time.
.RE
.B JANET_PROFILE
.RS
Path to a profile file that the interpreter will load before entering the REPL. This profile file will
not run for scripts, though. This behavior can be disabled with the -R option.
.RE
.B JANET_HASHSEED
.RS
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
cannot be defined for this variable to have an effect.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

86
jpm.1
View File

@@ -24,10 +24,6 @@ More interesting are the local commands. For more information on jpm usage, see
.SH FLAGS
.TP
.BR \-\-nocolor
Disable color in the jpm debug repl.
.TP
.BR \-\-verbose
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
@@ -36,16 +32,6 @@ Print detailed messages of what jpm is doing, including compilation commands and
.BR \-\-test
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
.TP
.BR \-\-offline
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
the network, for example, a build script that invokes curl will still have network access.
.TP
.BR \-\-auto\-shebang
Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH.
.SH OPTIONS
.TP
@@ -75,14 +61,9 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
.TP
.BR \-\-compiler=$CC
Sets the C compiler used for compiling native modules and standalone executables. Defaults
Sets the compiler used for compiling native modules and standalone executables. Defaults
to cc.
.TP
.BR \-\-cpp\-compiler=$CXX
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
to c++..
.TP
.BR \-\-linker
Sets the linker used to create native modules and executables. Only used on windows, where
@@ -109,19 +90,19 @@ Builds all artifacts specified in the project.janet file in the current director
be created in the ./build/ directory.
.TP
.BR install\ [\fBrepo...\fR]
.BR install\ [\fBrepo\fR]
When run with no arguments, installs all installable artifacts in the current project to
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
take an optional git repository URL and will install all artifacts in that repository instead.
When run with an argument, install does not need to be run from a jpm project directory. Will also
install multiple dependencies in one command.
When run with an argument, install does not need to be run from a jpm project directory.
.TP
.BR uninstall\ [\fBname...\fR]
.BR uninstall\ [\fBname\fR]
Uninstall a project installed with install. uninstall expects the name of the project, not the
repository url, path to installed file, or executable name. The name of the project must be specified
repository url, path to installed file or executable name. The name of the project must be specified
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
the current project if installed. Will also uninstall multiple packages in one command.
the current project if installed.
.TP
.BR clean
@@ -147,23 +128,6 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
when needed. clear-cache is a global command, so a project.janet is not
required.
.TP
.BR list-installed
List all installed packages in the current syspath.
.TP
.BR list-pkgs\ [\fBsearch\fR]
List all package aliases in the current package listing that contain the given search string.
If no search string is given, prints the entire listing.
.TP
.BR clear-manifest
jpm creates a manifest directory that contains a list of all installed files.
By deleting this directory, jpm will think that nothing is installed and will
try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with
this command, as it may leave extra files on your system and shouldn't be needed
most of the time in a healthy install.
.TP
.BR run\ [\fBrule\fR]
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
@@ -175,12 +139,6 @@ like make. run will run a single rule or build a single file.
.BR rules
List all rules that can be run via run. This is useful for exploring rules in the project.
.TP
.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
root, as well as a max depth to print. By default, prints the full tree for all rules. This
can be quite long, so it is recommended to give a root rule.
.TP
.BR show-paths
Show all of the paths used when installing and building artifacts.
@@ -190,29 +148,12 @@ Show all of the paths used when installing and building artifacts.
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
.TP
.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
.BR quickbin [\fBentry\fR] [\fBexecutable\fR]
Create a standalone, statically linked executable from a Janet source file that contains a main function.
The main function is the entry point of the program and will receive command line arguments
as function arguments. The entry file can import other modules, including native C modules, and
jpm will attempt to include the dependencies into the generated executable.
.TP
.BR debug-repl
Load the current project.janet file and start a repl in it's environment. This lets a user better
debug the project file, as well as run rules manually.
.TP
.BR make-lockfile\ [\fBfilename\fR]
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
time of the lockfile's creation, including exact versions. A lockfile can then be later used
to set up that environment on a different machine via load-lockfile. By default, the lockfile
is created at lockfile.jdn, although any path can be used.
.TP
.BR load-lockfile\ [\fBfilename\fR]
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
for a lockfile at lockfile.jdn, although any path can be used.
.SH ENVIRONMENT
.B JANET_PATH
@@ -226,7 +167,7 @@ the default location set at compile time, which can be determined with (dyn :sys
.RS
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
set this to a different directory if you want to. Doing so would let you import Janet modules
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
This variable is overwritten by the --modpath=/some/path if it is provided.
.RE
@@ -242,7 +183,7 @@ variable.
.B JANET_LIBPATH
.RS
Similar to JANET_HEADERPATH, this path is where jpm will look for
libjanet.a for creating standalone executables. This does not need to be
libjanet.a for creating standalong executables. This does not need to be
set on a normal install.
If not provided, this will default to <jpm script location>/../lib.
The --libpath=/some/path option will override this variable.
@@ -261,13 +202,6 @@ The --binpath=/some/path will override this variable.
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
is mostly a convenience. However, package dependencies can use short names, package listings
can be used to choose a particular set of dependency versions for a whole project.
.RE
.B JANET_GIT
.RS
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
if you have a normal install of git.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

View File

@@ -19,8 +19,8 @@
# IN THE SOFTWARE.
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.15.4')
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.8.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -33,7 +33,7 @@ dl_dep = cc.find_library('dl', required : false)
thread_dep = dependency('threads')
# Link options
if get_option('default_library') != 'static' and build_machine.system() != 'windows'
if build_machine.system() != 'windows'
add_project_link_arguments('-rdynamic', language : 'c')
endif
@@ -59,21 +59,14 @@ conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_NO_NET', not get_option('net'))
conf.set('JANET_NO_EV', not get_option('ev'))
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
conf.set('JANET_PRF', get_option('prf'))
conf.set('JANET_NO_PRF', not get_option('prf'))
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
conf.set('JANET_STACK_MAX', get_option('stack_max'))
conf.set('JANET_NO_UMASK', not get_option('umask'))
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
conf.set('JANET_EV_EPOLL', get_option('epoll'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@@ -113,14 +106,12 @@ core_src = [
'src/core/corelib.c',
'src/core/debug.c',
'src/core/emit.c',
'src/core/ev.c',
'src/core/fiber.c',
'src/core/gc.c',
'src/core/inttypes.c',
'src/core/io.c',
'src/core/marsh.c',
'src/core/math.c',
'src/core/net.c',
'src/core/os.c',
'src/core/parse.c',
'src/core/peg.c',
@@ -176,34 +167,34 @@ janetc = custom_target('janetc',
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
install : true)
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
native_cc = meson.get_compiler('c', native: true)
cross_cc = meson.get_compiler('c', native: false)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
else
extra_cflags = []
extra_native_cflags = []
endif
if cross_cc.has_argument('-fvisibility=hidden')
extra_cross_cflags = ['-fvisibility=hidden']
else
extra_cross_cflags = []
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_cflags,
c_args : extra_native_cflags,
install : true)
if meson.is_cross_build()
native_cc = meson.get_compiler('c', native: true)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
else
extra_native_cflags = []
endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_native_cflags,
c_args : extra_cross_cflags,
native : true)
else
janet_nativeclient = janet_mainclient
@@ -218,17 +209,15 @@ docs = custom_target('docs',
# Tests
test_files = [
'test/suite0000.janet',
'test/suite0001.janet',
'test/suite0002.janet',
'test/suite0003.janet',
'test/suite0004.janet',
'test/suite0005.janet',
'test/suite0006.janet',
'test/suite0007.janet',
'test/suite0008.janet',
'test/suite0009.janet',
'test/suite0010.janet'
'test/suite0.janet',
'test/suite1.janet',
'test/suite2.janet',
'test/suite3.janet',
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet',
'test/suite7.janet',
'test/suite8.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -244,29 +233,14 @@ janet_dep = declare_dependency(include_directories : incdir,
# pkgconfig
pkg = import('pkgconfig')
pkg.generate(libjanet,
subdirs: 'janet',
description: 'Library for the Janet programming language.')
# Installation
install_man('janet.1')
install_man('jpm.1')
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
janet_binscripts = [
'auxbin/jpm'
]
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
patched_janet = custom_target('patched-janeth',
input : ['tools/patch-header.janet', 'src/include/janet.h', jconf],
install : true,
install_dir : join_paths(get_option('includedir'), 'janet'),
build_by_default : true,
output : ['janet.h'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
install_man('jpm.1')
patched_jpm = custom_target('patched-jpm',
input : ['tools/patch-jpm.janet', 'jpm'],
install : true,
install_dir : get_option('bindir'),
build_by_default : true,
output : ['jpm'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
endif

View File

@@ -10,14 +10,7 @@ option('assembler', type : 'boolean', value : true)
option('peg', type : 'boolean', value : true)
option('typed_array', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('prf', type : 'boolean', value : false)
option('net', type : 'boolean', value : true)
option('ev', type : 'boolean', value : true)
option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('prf', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

File diff suppressed because it is too large Load Diff

View File

@@ -23,7 +23,6 @@
#include <janet.h>
#include <assert.h>
#include <stdio.h>
#include <math.h>
#include "tests.h"
@@ -45,31 +44,11 @@ int system_test() {
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
#ifdef NAN
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
#else
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
#endif
assert(NULL != &janet_wrap_nil);
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
Janet *t1 = janet_tuple_begin(3);
t1[0] = janet_wrap_nil();
t1[1] = janet_wrap_integer(4);
t1[2] = janet_cstringv("hi");
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
Janet *t2 = janet_tuple_begin(3);
t2[0] = janet_wrap_nil();
t2[1] = janet_wrap_integer(4);
t2[2] = janet_cstringv("hi");
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
assert(janet_equals(tuple1, tuple2));
return 0;
}

View File

@@ -61,11 +61,5 @@ int table_test() {
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 4);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(t2->count == 3);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 2);
return 0;
}

View File

@@ -1,13 +1,36 @@
/* This will be generated by the build system if this file is not used */
/*
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/* This is an example janetconf.h file. This will be usually generated
* by the build system. */
#ifndef JANETCONF_H
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 15
#define JANET_VERSION_PATCH 4
#define JANET_VERSION_MINOR 8
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.15.4"
#define JANET_VERSION "1.8.1"
/* #define JANET_BUILD "local" */
@@ -18,38 +41,23 @@
/* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is
* built. Any build with these set should be considered non-standard, and
* certain Janet libraries should be expected not to work. */
* built. */
/* #define JANET_NO_DOCSTRINGS */
/* #define JANET_NO_SOURCEMAPS */
/* #define JANET_REDUCED_OS */
/* #define JANET_NO_PROCESSES */
/* #define JANET_NO_ASSEMBLER */
/* #define JANET_NO_PEG */
/* #define JANET_NO_NET */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_EV */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
/* Other settings */
/* #define JANET_DEBUG */
/* #define JANET_PRF */
/* #define JANET_NO_UTC_MKTIME */
/* #define JANET_NO_ASSEMBLER */
/* #define JANET_NO_PEG */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_PRF */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
/* #define JANET_RECURSION_GUARD 1024 */
/* #define JANET_MAX_PROTO_DEPTH 200 */
/* #define JANET_MAX_MACRO_EXPAND 200 */
/* #define JANET_STACK_MAX 16384 */
/* #define JANET_OS_NAME my-custom-os */
/* #define JANET_ARCH_NAME pdp-8 */
/* #define JANET_EV_EPOLL */
/* Main client settings, does not affect library code */
/* #define JANET_SIMPLE_GETLINE */
#endif /* end of include guard: JANETCONF_H */

View File

@@ -270,33 +270,6 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetArray *array = janet_getarray(argv, 0);
if (array->count) {
if (array->count < array->capacity) {
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
array->data = newData;
array->capacity = array->count;
}
} else {
array->capacity = 0;
free(array->data);
array->data = NULL;
}
return argv[0];
}
static Janet cfun_array_clear(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetArray *array = janet_getarray(argv, 0);
array->count = 0;
return argv[0];
}
static const JanetReg array_cfuns[] = {
{
"array/new", cfun_array_new,
@@ -351,16 +324,16 @@ static const JanetReg array_cfuns[] = {
{
"array/concat", cfun_array_concat,
JDOC("(array/concat arr & parts)\n\n"
"Concatenates a variable number of arrays (and tuples) into the first argument "
"which must be an array. If any of the parts are arrays or tuples, their elements will "
"Concatenates a variadic number of arrays (and tuples) into the first argument "
"which must an array. If any of the parts are arrays or tuples, their elements will "
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
"Return the modified array arr.")
},
{
"array/insert", cfun_array_insert,
JDOC("(array/insert arr at & xs)\n\n"
"Insert all xs into array arr at index at. at should be an integer between "
"0 and the length of the array. A negative value for at will index backwards from "
"Insert all of xs into array arr at index at. at should be an integer "
"0 and the length of the array. A negative value for at will index from "
"the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.")
},
@@ -372,17 +345,6 @@ static const JanetReg array_cfuns[] = {
"By default, n is 1. "
"Returns the array.")
},
{
"array/trim", cfun_array_trim,
JDOC("(array/trim arr)\n\n"
"Set the backing capacity of an array to its current length. Returns the modified array.")
},
{
"array/clear", cfun_array_clear,
JDOC("(array/clear arr)\n\n"
"Empties an array, setting it's count to 0 but does not free the backing capacity. "
"Returns the modified array.")
},
{NULL, NULL, NULL}
};

View File

@@ -53,6 +53,7 @@ struct JanetAssembler {
Janet name;
JanetTable labels; /* keyword -> bytecode index */
JanetTable constants; /* symbol -> constant index */
JanetTable slots; /* symbol -> slot index */
JanetTable envs; /* symbol -> environment index */
JanetTable defs; /* symbol -> funcdefs index */
@@ -73,7 +74,6 @@ static const JanetInstructionDef janet_ops[] = {
{"call", JOP_CALL},
{"clo", JOP_CLOSURE},
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
@@ -113,8 +113,6 @@ static const JanetInstructionDef janet_ops[] = {
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
{"mulim", JOP_MULTIPLY_IMMEDIATE},
{"neq", JOP_NOT_EQUALS},
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
{"next", JOP_NEXT},
{"noop", JOP_NOOP},
{"prop", JOP_PROPAGATE},
@@ -174,6 +172,7 @@ static void janet_asm_deinit(JanetAssembler *a) {
janet_table_deinit(&a->slots);
janet_table_deinit(&a->labels);
janet_table_deinit(&a->envs);
janet_table_deinit(&a->constants);
janet_table_deinit(&a->defs);
}
@@ -253,6 +252,9 @@ static int32_t doarg_1(
case JANET_OAT_ENVIRONMENT:
c = &a->envs;
break;
case JANET_OAT_CONSTANT:
c = &a->constants;
break;
case JANET_OAT_LABEL:
c = &a->labels;
break;
@@ -504,6 +506,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
a.defs_capacity = 0;
a.name = janet_wrap_nil();
janet_table_init(&a.labels, 0);
janet_table_init(&a.constants, 0);
janet_table_init(&a.slots, 0);
janet_table_init(&a.envs, 0);
janet_table_init(&a.defs, 0);
@@ -531,34 +534,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
"expected struct or table for assembly source");
/* Check for function name */
a.name = janet_get1(s, janet_ckeywordv("name"));
a.name = janet_get1(s, janet_csymbolv("name"));
if (!janet_checktype(a.name, JANET_NIL)) {
def->name = janet_to_string(a.name);
}
/* Set function arity */
x = janet_get1(s, janet_ckeywordv("arity"));
x = janet_get1(s, janet_csymbolv("arity"));
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
x = janet_get1(s, janet_ckeywordv("max-arity"));
x = janet_get1(s, janet_csymbolv("max-arity"));
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
x = janet_get1(s, janet_ckeywordv("min-arity"));
x = janet_get1(s, janet_csymbolv("min-arity"));
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
/* Check vararg */
x = janet_get1(s, janet_ckeywordv("vararg"));
x = janet_get1(s, janet_csymbolv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Check source */
x = janet_get1(s, janet_ckeywordv("source"));
x = janet_get1(s, janet_csymbolv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
/* Create slot aliases */
x = janet_get1(s, janet_ckeywordv("slots"));
x = janet_get1(s, janet_csymbolv("slots"));
if (janet_indexed_view(x, &arr, &count)) {
for (i = 0; i < count; i++) {
Janet v = arr[i];
@@ -579,7 +582,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse constants */
x = janet_get1(s, janet_ckeywordv("constants"));
x = janet_get1(s, janet_csymbolv("constants"));
if (janet_indexed_view(x, &arr, &count)) {
def->constants_length = count;
def->constants = malloc(sizeof(Janet) * (size_t) count);
@@ -588,7 +591,25 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
for (i = 0; i < count; i++) {
Janet ct = arr[i];
def->constants[i] = ct;
if (janet_checktype(ct, JANET_TUPLE) &&
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
const Janet *t = janet_unwrap_tuple(ct);
int32_t tcount = janet_tuple_length(t);
const uint8_t *macro = janet_unwrap_symbol(t[0]);
if (0 == janet_cstrcmp(macro, "quote")) {
def->constants[i] = t[1];
} else if (tcount == 3 &&
janet_checktype(t[1], JANET_SYMBOL) &&
0 == janet_cstrcmp(macro, "def")) {
def->constants[i] = t[2];
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
} else {
janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct));
}
} else {
def->constants[i] = ct;
}
}
} else {
def->constants = NULL;
@@ -596,7 +617,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse sub funcdefs */
x = janet_get1(s, janet_ckeywordv("closures"));
x = janet_get1(s, janet_csymbolv("closures"));
if (janet_indexed_view(x, &arr, &count)) {
int32_t i;
for (i = 0; i < count; i++) {
@@ -607,7 +628,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
if (subres.status != JANET_ASSEMBLE_OK) {
janet_asm_errorv(&a, subres.error);
}
subname = janet_get1(arr[i], janet_ckeywordv("name"));
subname = janet_get1(arr[i], janet_csymbolv("name"));
if (!janet_checktype(subname, JANET_NIL)) {
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
}
@@ -626,7 +647,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse bytecode and labels */
x = janet_get1(s, janet_ckeywordv("bytecode"));
x = janet_get1(s, janet_csymbolv("bytecode"));
if (janet_indexed_view(x, &arr, &count)) {
/* Do labels and find length */
int32_t blength = 0;
@@ -682,13 +703,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
a.errindex = -1;
/* Check for source mapping */
x = janet_get1(s, janet_ckeywordv("sourcemap"));
x = janet_get1(s, janet_csymbolv("sourcemap"));
if (janet_indexed_view(x, &arr, &count)) {
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
if (NULL == def->sourcemap) {
JANET_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];
@@ -712,18 +730,12 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
/* Set environments */
def->environments =
realloc(def->environments, def->environments_length * sizeof(int32_t));
if (NULL == def->environments) {
JANET_OUT_OF_MEMORY;
}
/* Verify the func def */
if (janet_verify(def)) {
janet_asm_error(&a, "invalid assembly");
}
/* Add final flags */
janet_def_addflags(def);
/* Finish everything and return funcdef */
janet_asm_deinit(&a);
result.error = NULL;
@@ -841,110 +853,92 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
return janet_wrap_nil();
}
/*
* Disasm sections
*/
static Janet janet_disasm_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->arity);
}
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->min_arity);
}
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->max_arity);
}
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
return janet_wrap_integer(def->slotcount);
}
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
Janet janet_disasm(JanetFuncDef *def) {
int32_t i;
JanetArray *bcode = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
JanetArray *constants;
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
if (NULL != def->source) {
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
}
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
}
if (NULL != def->name) {
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
}
/* Add constants */
if (def->constants_length > 0) {
constants = janet_array(def->constants_length);
janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
Janet src = def->constants[i];
Janet dest;
if (janet_checktype(src, JANET_TUPLE)) {
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
} else {
dest = src;
}
constants->data[i] = dest;
}
constants->count = def->constants_length;
}
/* Add bytecode */
for (i = 0; i < def->bytecode_length; i++) {
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
}
bcode->count = def->bytecode_length;
return janet_wrap_array(bcode);
}
static Janet janet_disasm_source(JanetFuncDef *def) {
if (def->source != NULL) return janet_wrap_string(def->source);
return janet_wrap_nil();
}
static Janet janet_disasm_name(JanetFuncDef *def) {
if (def->name != NULL) return janet_wrap_string(def->name);
return janet_wrap_nil();
}
static Janet janet_disasm_vararg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
}
static Janet janet_disasm_constants(JanetFuncDef *def) {
JanetArray *constants = janet_array(def->constants_length);
for (int32_t i = 0; i < def->constants_length; i++) {
constants->data[i] = def->constants[i];
/* Add source map */
if (NULL != def->sourcemap) {
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap));
}
constants->count = def->constants_length;
return janet_wrap_array(constants);
}
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
if (NULL == def->sourcemap) return janet_wrap_nil();
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
/* Add environments */
if (NULL != def->environments) {
JanetArray *envs = janet_array(def->environments_length);
for (i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs));
}
sourcemap->count = def->bytecode_length;
return janet_wrap_array(sourcemap);
}
static Janet janet_disasm_environments(JanetFuncDef *def) {
JanetArray *envs = janet_array(def->environments_length);
for (int32_t i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
/* Add closures */
/* Funcdefs cannot be recursive */
if (NULL != def->defs) {
JanetArray *defs = janet_array(def->defs_length);
for (i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs));
}
envs->count = def->environments_length;
return janet_wrap_array(envs);
}
static Janet janet_disasm_defs(JanetFuncDef *def) {
JanetArray *defs = janet_array(def->defs_length);
for (int32_t i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
return janet_wrap_array(defs);
}
/* Add slotcount */
janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount));
Janet janet_disasm(JanetFuncDef *def) {
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(def));
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
return janet_wrap_struct(janet_table_to_struct(ret));
}
/* C Function for assembly */
static Janet cfun_asm(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
janet_arity(argc, 1, 1);
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
if (res.status != JANET_ASSEMBLE_OK) {
@@ -954,26 +948,9 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
}
static Janet cfun_disasm(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 1);
JanetFunction *f = janet_getfunction(argv, 0);
if (argc == 2) {
JanetKeyword kw = janet_getkeyword(argv, 1);
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(f->def);
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
janet_panicf("unknown disasm key %v", argv[1]);
} else {
return janet_disasm(f->def);
}
return janet_disasm(f->def);
}
static const JanetReg asm_cfuns[] = {
@@ -981,29 +958,15 @@ static const JanetReg asm_cfuns[] = {
"asm", cfun_asm,
JDOC("(asm assembly)\n\n"
"Returns a new function that is the compiled result of the assembly.\n"
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
"to the return value of disasm. Will throw an\n"
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
"error on invalid assembly.")
},
{
"disasm", cfun_disasm,
JDOC("(disasm func &opt field)\n\n"
"Returns assembly that could be used to compile the given function.\n"
JDOC("(disasm func)\n\n"
"Returns assembly that could be used be compile the given function.\n"
"func must be a function, not a c function. Will throw on error on a badly\n"
"typed argument. If given a field name, will only return that part of the function assembly.\n"
"Possible fields are:\n\n"
"* :arity - number of required and optional arguments.\n\n"
"* :min-arity - minimum number of arguments function can be called with.\n\n"
"* :max-arity - maximum number of arguments function can be called with.\n\n"
"* :vararg - true if function can take a variable number of arguments.\n\n"
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n"
"* :source - name of source file that this function was compiled from.\n\n"
"* :name - name of function.\n\n"
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n"
"* :constants - an array of constants referenced by this function.\n\n"
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n"
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n"
"* :defs - other function definitions that this function may instantiate.\n")
"typed argument.")
},
{NULL, NULL, NULL}
};

View File

@@ -31,11 +31,12 @@
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity < 4) capacity = 4;
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
if (capacity > 0) {
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
}
buffer->count = 0;
buffer->capacity = capacity;
@@ -91,7 +92,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
}
int32_t new_size = buffer->count + n;
if (new_size > buffer->capacity) {
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
int32_t new_capacity = new_size * 2;
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
janet_gcpressure(new_capacity - buffer->capacity);
if (NULL == new_data) {
@@ -196,21 +197,6 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count < buffer->capacity) {
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
uint8_t *newData = realloc(buffer->data, newcap);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = newcap;
}
return argv[0];
}
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
@@ -250,26 +236,6 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
for (i = 1; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} else {
JanetByteView view = janet_getbytes(argv, i);
if (view.bytes == buffer->data) {
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
view.bytes = buffer->data;
}
janet_buffer_push_bytes(buffer, view.bytes, view.len);
}
}
return argv[0];
}
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -413,40 +379,24 @@ static const JanetReg buffer_cfuns[] = {
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
"Returns the modified buffer.")
},
{
"buffer/trim", cfun_buffer_trim,
JDOC("(buffer/trim buffer)\n\n"
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
"modified buffer.")
},
{
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer & xs)\n\n"
"Append bytes to a buffer. Will expand the buffer as necessary. "
JDOC("(buffer/push-byte buffer x)\n\n"
"Append a byte to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.")
},
{
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer & xs)\n\n"
"Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
JDOC("(buffer/push-word buffer x)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
"buffer/push-string", cfun_buffer_chars,
JDOC("(buffer/push-string buffer & xs)\n\n"
"Push byte sequences onto the end of a buffer. "
"Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
"buffer/push", cfun_buffer_push,
JDOC("(buffer/push buffer & xs)\n\n"
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
JDOC("(buffer/push-string buffer str)\n\n"
"Push a string onto the end of a buffer. Non string values will be converted "
"to strings before being pushed. Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{

View File

@@ -101,13 +101,10 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NEXT */
JINT_SSS, /* JOP_NOT_EQUALS, */
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
JINT_SSS /* JOP_CANCEL, */
};
/* Verify some bytecode */
int janet_verify(JanetFuncDef *def) {
int32_t janet_verify(JanetFuncDef *def) {
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
int32_t i;
int32_t maxslot = def->arity + vargs;

View File

@@ -27,43 +27,18 @@
#include "fiber.h"
#endif
#ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS
#include <pthread.h>
#else
#include <windows.h>
#endif
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
#ifdef JANET_TOP_LEVEL_SIGNAL
JANET_TOP_LEVEL_SIGNAL(msg);
#else
fputs(msg, stdout);
# ifdef JANET_SINGLE_THREADED
exit(-1);
# elif defined(JANET_WINDOWS)
ExitThread(-1);
# else
pthread_exit(NULL);
# endif
#endif
}
void janet_signalv(JanetSignal sig, Janet message) {
if (janet_vm_return_reg != NULL) {
*janet_vm_return_reg = message;
if (NULL != janet_vm_fiber) {
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
}
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
#if defined(JANET_BSD) || defined(JANET_APPLE)
_longjmp(*janet_vm_jmp_buf, sig);
#else
longjmp(*janet_vm_jmp_buf, sig);
#endif
} else {
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
janet_top_level_signal(str);
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
exit(1);
}
}
@@ -79,7 +54,7 @@ void janet_panicf(const char *format, ...) {
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
janet_formatbv(&buffer, format, args);
janet_formatb(&buffer, format, args);
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
@@ -149,23 +124,6 @@ int janet_getmethod(const uint8_t *method, const JanetMethod *methods, Janet *ou
return 0;
}
Janet janet_nextmethod(const JanetMethod *methods, Janet key) {
if (!janet_checktype(key, JANET_NIL)) {
while (methods->name) {
if (janet_keyeq(key, methods->name)) {
methods++;
break;
}
methods++;
}
}
if (methods->name) {
return janet_ckeywordv(methods->name);
} else {
return janet_wrap_nil();
}
}
DEFINE_GETTER(number, NUMBER, double)
DEFINE_GETTER(array, ARRAY, JanetArray *)
DEFINE_GETTER(tuple, TUPLE, const Janet *)
@@ -277,20 +235,18 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
return not_raw;
if (raw < 0) raw += length + 1;
if (raw < 0 || raw > length)
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
return raw;
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
return not_raw;
if (raw < 0) raw += length;
if (raw < 0 || raw > length)
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
return raw;
}
JanetView janet_getindexed(const Janet *argv, int32_t n) {
@@ -358,10 +314,7 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
}
Janet janet_dyn(const char *name) {
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) return janet_wrap_nil();
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
}
if (!janet_vm_fiber) return janet_wrap_nil();
if (janet_vm_fiber->env) {
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
} else {
@@ -370,15 +323,11 @@ Janet janet_dyn(const char *name) {
}
void janet_setdyn(const char *name, Janet value) {
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
} else {
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
if (!janet_vm_fiber) return;
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

View File

@@ -33,11 +33,6 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
int32_t arity = janet_v_count(args);
return arity == 1 || arity == 2;
}
static int arity2or3(JanetFopts opts, JanetSlot *args) {
(void) opts;
int32_t arity = janet_v_count(args);
return arity == 2 || arity == 3;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@@ -95,67 +90,34 @@ static JanetSlot opfunction(
return t;
}
/* Check if a value can be coerced to an immediate value */
static int can_be_imm(Janet x, int8_t *out) {
if (!janet_checkint(x)) return 0;
int32_t integer = janet_unwrap_integer(x);
if (integer > 127 || integer < -127) return 0;
*out = (int8_t) integer;
return 1;
}
/* Check if a slot can be coerced to an immediate value */
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
return can_be_imm(s.constant, out);
}
/* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
Janet nullary) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
int neg = opim < 0;
if (opim < 0) opim = -opim;
len = janet_v_count(args);
JanetSlot t;
if (len == 0) {
return janetc_cslot(nullary);
} else if (len == 1) {
t = janetc_gettarget(opts);
/* Special case subtract to be times -1 */
if (op == JOP_SUBTRACT) {
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
} else {
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
}
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
return t;
}
t = janetc_gettarget(opts);
if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
for (i = 2; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, t, args[i], 1);
}
}
janetc_emit_sss(c, op, t, args[0], args[1], 1);
for (i = 2; i < len; i++)
janetc_emit_sss(c, op, t, t, args[i], 1);
return t;
}
/* Function optimizers */
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
}
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -172,40 +134,19 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
}
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
if (janet_v_count(args) == 3) {
JanetCompiler *c = opts.compiler;
JanetSlot t = janetc_gettarget(opts);
int target_is_default = janetc_sequal(t, args[2]);
JanetSlot dflt_slot = args[2];
if (target_is_default) {
dflt_slot = janetc_farslot(c);
janetc_copy(c, dflt_slot, t);
}
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
janetc_copy(c, t, dflt_slot);
if (target_is_default) janetc_freeslot(c, dflt_slot);
int32_t current = janet_v_count(c->buffer);
c->buffer[label] |= (current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
}
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
}
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
@@ -231,9 +172,6 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
}
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
}
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
JanetCompiler *c = opts.compiler;
@@ -262,34 +200,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Variadic operators specialization */
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
}
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
}
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
}
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
}
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
}
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
}
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
}
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
}
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
}
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
}
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
@@ -300,11 +238,9 @@ static JanetSlot compreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
int invert) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
len = janet_v_count(args);
int32_t *labels = NULL;
JanetSlot t;
@@ -315,17 +251,19 @@ static JanetSlot compreduce(
}
t = janetc_gettarget(opts);
for (i = 1; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
} else {
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
}
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
if (i != (len - 1)) {
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
janet_v_push(labels, label);
}
}
int32_t end = janet_v_count(c->buffer);
if (invert) {
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
janetc_emit(c, JOP_JUMP | (2 << 8));
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
}
for (i = 0; i < janet_v_count(labels); i++) {
int32_t label = labels[i];
c->buffer[label] |= ((end - label) << 16);
@@ -335,22 +273,22 @@ static JanetSlot compreduce(
}
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
return compreduce(opts, args, JOP_GREATER_THAN, 0);
}
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
return compreduce(opts, args, JOP_LESS_THAN, 0);
}
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
}
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
}
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
return compreduce(opts, args, JOP_EQUALS, 0);
}
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
return compreduce(opts, args, JOP_EQUALS, 1);
}
/* Arranged by tag */
@@ -381,12 +319,10 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_eq},
{NULL, do_neq},
{fixarity2, do_propagate},
{arity2or3, do_get},
{fixarity2, do_get},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{fixarity2, do_cmp},
{fixarity2, do_cancel},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -439,22 +439,22 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
min_arity = -1 - min_arity;
if (min_arity > max && max >= 0) {
const uint8_t *es = janet_formatc(
"%v expects at most %d argument%s, got at least %d",
fun.constant, max, max == 1 ? "" : "s", min_arity);
"%v expects at most %d argument, got at least %d",
fun.constant, max, min_arity);
janetc_error(c, es);
}
} else {
/* Call has no splices */
if (min_arity > max && max >= 0) {
const uint8_t *es = janet_formatc(
"%v expects at most %d argument%s, got %d",
fun.constant, max, max == 1 ? "" : "s", min_arity);
"%v expects at most %d argument, got %d",
fun.constant, max, min_arity);
janetc_error(c, es);
}
if (min_arity < min) {
const uint8_t *es = janet_formatc(
"%v expects at least %d argument%s, got %d",
fun.constant, min, min == 1 ? "" : "s", min_arity);
"%v expects at least %d argument, got %d",
fun.constant, min, min_arity);
janetc_error(c, es);
}
}
@@ -596,11 +596,8 @@ static int macroexpand1(
/* Set env */
fiberp->env = c->env;
int lock = janet_gclock();
Janet mf_kw = janet_ckeywordv("macro-form");
janet_table_put(c->env, mf_kw, x);
Janet tempOut;
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
janet_table_put(c->env, mf_kw, janet_wrap_nil());
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
@@ -698,32 +695,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
return ret;
}
/* Add function flags to janet functions */
void janet_def_addflags(JanetFuncDef *def) {
int32_t set_flags = 0;
int32_t unset_flags = 0;
/* pos checks */
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* negative checks */
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* Update flags */
def->flags |= set_flags;
def->flags &= ~unset_flags;
}
/* Compile a funcdef */
/* Once the various other settings of the FuncDef have been tweaked,
* call janet_def_addflags to set the proper flags for the funcdef */
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
JanetScope *scope = c->scope;
JanetFuncDef *def = janet_funcdef_alloc();
@@ -775,10 +747,8 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Copy upvalue bitset */
if (scope->ua.count) {
/* Number of u32s we need to create a bitmask for all slots */
int32_t slotchunks = (def->slotcount + 31) >> 5;
/* numchunks is min of slotchunks and scope->ua.count */
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
int32_t numchunks = (def->slotcount + 31) >> 5;
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
@@ -786,6 +756,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
}
/* Pop the scope */
@@ -842,7 +813,6 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {
c.result.error_mapping = c.current_mapping;
@@ -872,12 +842,8 @@ static Janet cfun(int32_t argc, Janet *argv) {
} else {
JanetTable *t = janet_table(4);
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
if (res.error_mapping.line > 0) {
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
}
if (res.error_mapping.column > 0) {
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
}
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
if (res.macrofiber) {
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
}
@@ -889,10 +855,10 @@ static const JanetReg compile_cfuns[] = {
{
"compile", cfun,
JDOC("(compile ast &opt env source)\n\n"
"Compiles an Abstract Syntax Tree (ast) into a function. "
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
"Pair the compile function with parsing functionality to implement "
"eval. Returns a new function and does not modify ast. Returns an error "
"struct with keys :line, :column, and :error if compilation fails.")
"eval. Returns a janet function and does not modify ast. Throws an "
"error if the ast cannot be compiled.")
},
{NULL, NULL, NULL}
};

View File

@@ -60,8 +60,6 @@
#define JANET_FUN_NEXT 28
#define JANET_FUN_MODULO 29
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
#define JANET_FUN_CANCEL 32
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@@ -63,29 +63,10 @@ typedef void *Clib;
#define error_clib() dlerror()
#endif
static char *get_processed_name(const char *name) {
if (name[0] == '.') return (char *) name;
const char *c;
for (c = name; *c; c++) {
if (*c == '/') return (char *) name;
}
size_t l = (size_t)(c - name);
char *ret = malloc(l + 3);
if (NULL == ret) {
JANET_OUT_OF_MEMORY;
}
ret[0] = '.';
ret[1] = '/';
memcpy(ret + 2, name, l + 1);
return ret;
}
JanetModule janet_native(const char *name, const uint8_t **error) {
char *processed_name = get_processed_name(name);
Clib lib = load_clib(processed_name);
Clib lib = load_clib(name);
JanetModule init;
JanetModconf getter;
if (name != processed_name) free(processed_name);
if (!lib) {
*error = janet_cstring(error_clib());
return NULL;
@@ -423,11 +404,9 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
size_t s = janet_getsize(argv, 0);
/* limit interval to 48 bits */
#ifdef JANET_64
if (s >> 48) {
if (s > 0xFFFFFFFFFFFFUl) {
janet_panic("interval too large");
}
#endif
janet_vm_gc_interval = s;
return janet_wrap_nil();
}
@@ -456,7 +435,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
static Janet janet_core_getline(int32_t argc, Janet *argv) {
FILE *in = janet_dynfile("in", stdin);
FILE *out = janet_dynfile("out", stdout);
janet_arity(argc, 0, 3);
janet_arity(argc, 0, 2);
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
if (argc >= 1) {
const char *prompt = (const char *) janet_getstring(argv, 0);
@@ -521,15 +500,10 @@ static Janet janet_core_signal(int32_t argc, Janet *argv) {
sig = JANET_SIGNAL_USER0 + s;
} else {
JanetKeyword kw = janet_getkeyword(argv, 0);
if (!janet_cstrcmp(kw, "yield")) {
sig = JANET_SIGNAL_YIELD;
} else if (!janet_cstrcmp(kw, "error")) {
sig = JANET_SIGNAL_ERROR;
} else if (!janet_cstrcmp(kw, "debug")) {
sig = JANET_SIGNAL_DEBUG;
} else {
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
}
if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD;
if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
}
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
janet_signalv(sig, payload);
@@ -548,35 +522,35 @@ static const JanetReg corelib_cfuns[] = {
{
"describe", janet_core_describe,
JDOC("(describe x)\n\n"
"Returns a string that is a human-readable description of a value x.")
"Returns a string that is a human readable description of a value x.")
},
{
"string", janet_core_string,
JDOC("(string & xs)\n\n"
"Creates a string by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
JDOC("(string & parts)\n\n"
"Creates a string by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. "
"Returns the new string.")
},
{
"symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n"
"Creates a symbol by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new symbol.")
"Creates a symbol by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new symbol.")
},
{
"keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n"
"Creates a keyword by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new keyword.")
"Creates a keyword by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new keyword.")
},
{
"buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n"
"Creates a buffer by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new buffer.")
"Creates a new buffer by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new buffer.")
},
{
"abstract?", janet_core_is_abstract,
@@ -645,35 +619,34 @@ static const JanetReg corelib_cfuns[] = {
{
"type", janet_core_type,
JDOC("(type x)\n\n"
"Returns the type of `x` as a keyword. `x` is one of:\n\n"
"* :nil\n\n"
"* :boolean\n\n"
"* :number\n\n"
"* :array\n\n"
"* :tuple\n\n"
"* :table\n\n"
"* :struct\n\n"
"* :string\n\n"
"* :buffer\n\n"
"* :symbol\n\n"
"* :keyword\n\n"
"* :function\n\n"
"* :cfunction\n\n"
"* :fiber\n\n"
"Returns the type of x as a keyword. x is one of\n"
"\t:nil\n"
"\t:boolean\n"
"\t:number\n"
"\t:array\n"
"\t:tuple\n"
"\t:table\n"
"\t:struct\n"
"\t:string\n"
"\t:buffer\n"
"\t:symbol\n"
"\t:keyword\n"
"\t:function\n"
"\t:cfunction\n\n"
"or another keyword for an abstract type.")
},
{
"hash", janet_core_hash,
JDOC("(hash value)\n\n"
"Gets a hash for any value. The hash is an integer can be used "
"as a cheap hash function for all values. If two values are strictly equal, "
"Gets a hash value for any janet value. The hash is an integer can be used "
"as a cheap hash function for all janet objects. If two values are strictly equal, "
"then they will have the same hash value.")
},
{
"getline", janet_core_getline,
JDOC("(getline &opt prompt buf env)\n\n"
"Reads a line of input into a buffer, including the newline character, using a prompt. "
"An optional environment table can be provided for auto-complete. "
"An optional environment table can be provided for autocomplete. "
"Returns the modified buffer. "
"Use this function to implement a simple interface for a terminal program.")
},
@@ -700,16 +673,16 @@ static const JanetReg corelib_cfuns[] = {
{
"module/expand-path", janet_core_expand_path,
JDOC("(module/expand-path path template)\n\n"
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"Expands a path template as found in module/paths for module/find. "
"This takes in a path (the argument to require) and a template string, template, "
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)")
"\t:all:\tthe value of path verbatim\n"
"\t:cur:\tthe current file, or (dyn :current-file)\n"
"\t:dir:\tthe directory containing the current file\n"
"\t:name:\tthe filename component of path, with extenion if given\n"
"\t:native:\tthe extension used to load natives, .so or .dll\n"
"\t:sys:\tthe system path, or (syn :syspath)")
},
{
"int?", janet_core_check_int,
@@ -724,7 +697,7 @@ static const JanetReg corelib_cfuns[] = {
{
"slice", janet_core_slice,
JDOC("(slice x &opt start end)\n\n"
"Extract a sub-range of an indexed data structure or byte sequence.")
"Extract a sub-range of an indexed data strutrue or byte sequence.")
},
{
"signal", janet_core_signal,
@@ -761,11 +734,10 @@ static void janet_quick_asm(
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, bytecode, bytecode_size);
janet_def_addflags(def);
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
}
/* Macros for easier inline assembly */
/* Macros for easier inline janet assembly */
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
@@ -947,10 +919,6 @@ static const uint32_t resume_asm[] = {
JOP_RESUME | (1 << 24),
JOP_RETURN
};
static const uint32_t cancel_asm[] = {
JOP_CANCEL | (1 << 24),
JOP_RETURN
};
static const uint32_t in_asm[] = {
JOP_IN | (1 << 24),
JOP_LOAD_NIL | (3 << 8),
@@ -995,10 +963,6 @@ static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
};
#endif /* ifdef JANET_BOOTSTRAP */
/*
@@ -1035,12 +999,6 @@ static void janet_load_libs(JanetTable *env) {
#ifdef JANET_THREADS
janet_lib_thread(env);
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#endif
#ifdef JANET_NET
janet_lib_net(env);
#endif
}
#ifdef JANET_BOOTSTRAP
@@ -1055,15 +1013,10 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through "
"Gets the next key in a datastructure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
@@ -1074,8 +1027,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Propagate a signal from a fiber to the current fiber. The resulting "
"stack trace from the current fiber will include frames from fiber. If "
"fiber is in a state that can be resumed, resuming the current fiber will "
"first resume fiber. This function can be used to re-raise an error without "
"losing the original stack trace."));
"first resume fiber."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
@@ -1091,11 +1043,6 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
@@ -1152,7 +1099,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
"values. Division by two integers uses truncating division."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
@@ -1206,8 +1153,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env),
JDOC("The root environment used to create environments with (make-env)."));
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
janet_load_libs(env);
janet_gcroot(janet_wrap_table(env));
@@ -1222,43 +1168,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
return janet_vm_core_env;
}
JanetTable *dict = janet_core_lookup_table(replacements);
/* Unmarshal bytecode */
Janet marsh_out = janet_unmarshal(
janet_core_image,
janet_core_image_size,
0,
dict,
NULL);
/* Memoize */
janet_gcroot(marsh_out);
JanetTable *env = janet_unwrap_table(marsh_out);
janet_vm_core_env = env;
/* Invert image dict manually here. We can't do this in boot.janet as it
* breaks deterministic builds */
Janet lidv, midv;
lidv = midv = janet_wrap_nil();
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
JanetTable *lid = janet_unwrap_table(lidv);
JanetTable *mid = janet_unwrap_table(midv);
for (int32_t i = 0; i < lid->capacity; i++) {
const JanetKV *kv = lid->data + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(mid, kv->value, kv->key);
}
}
return env;
}
#endif
JanetTable *janet_core_lookup_table(JanetTable *replacements) {
JanetTable *dict = janet_table(512);
/* Load core cfunctions (and some built in janet assembly functions) */
JanetTable *dict = janet_table(300);
janet_load_libs(dict);
/* Add replacements */
@@ -1274,5 +1185,20 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
}
}
return dict;
/* Unmarshal bytecode */
Janet marsh_out = janet_unmarshal(
janet_core_image,
janet_core_image_size,
0,
dict,
NULL);
/* Memoize */
janet_gcroot(marsh_out);
JanetTable *env = janet_unwrap_table(marsh_out);
janet_vm_core_env = env;
return env;
}
#endif

View File

@@ -102,9 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
int32_t fi;
const char *errstr = (const char *)janet_to_string(err);
JanetFiber **fibers = NULL;
/* Don't print error line if it is nil. */
int wrote_error = janet_checktype(err, JANET_NIL);
int wrote_error = 0;
int print_color = janet_truthy(janet_dyn("err-color"));
if (print_color) janet_eprintf("\x1b[31m");
@@ -301,10 +299,9 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
}
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
janet_stacktrace(fiber, x);
janet_stacktrace(fiber, argv[1]);
return argv[0];
}
@@ -328,12 +325,12 @@ static Janet cfun_debug_step(int32_t argc, Janet *argv) {
static const JanetReg debug_cfuns[] = {
{
"debug/break", cfun_debug_break,
JDOC("(debug/break source line col)\n\n"
"Sets a breakpoint in `source` at a given line and column. "
JDOC("(debug/break source byte-offset)\n\n"
"Sets a breakpoint with source a key at a given line and column. "
"Will throw an error if the breakpoint location "
"cannot be found. For example\n\n"
"\t(debug/break \"core.janet\" 10 4)\n\n"
"wil set a breakpoint at line 10, 4th column of the file core.janet.")
"\t(debug/break \"core.janet\" 1000)\n\n"
"wil set a breakpoint at the 1000th byte of the file core.janet.")
},
{
"debug/unbreak", cfun_debug_unbreak,
@@ -365,25 +362,25 @@ static const JanetReg debug_cfuns[] = {
"debug/stack", cfun_debug_stack,
JDOC("(debug/stack fib)\n\n"
"Gets information about the stack as an array of tables. Each table "
"in the array contains information about a stack frame. The top-most, current "
"stack frame is the first table in the array, and the bottom-most stack frame "
"in the array contains information about a stack frame. The top most, current "
"stack frame is the first table in the array, and the bottom most stack frame "
"is the last value. Each stack frame contains some of the following attributes:\n\n"
"* :c - true if the stack frame is a c function invocation\n\n"
"* :column - the current source column of the stack frame\n\n"
"* :function - the function that the stack frame represents\n\n"
"* :line - the current source line of the stack frame\n\n"
"* :name - the human-friendly name of the function\n\n"
"* :pc - integer indicating the location of the program counter\n\n"
"* :source - string with the file path or other identifier for the source code\n\n"
"* :slots - array of all values in each slot\n\n"
"* :tail - boolean indicating a tail call")
"\t:c - true if the stack frame is a c function invocation\n"
"\t:column - the current source column of the stack frame\n"
"\t:function - the function that the stack frame represents\n"
"\t:line - the current source line of the stack frame\n"
"\t:name - the human friendly name of the function\n"
"\t:pc - integer indicating the location of the program counter\n"
"\t:source - string with the file path or other identifier for the source code\n"
"\t:slots - array of all values in each slot\n"
"\t:tail - boolean indicating a tail call")
},
{
"debug/stacktrace", cfun_debug_stacktrace,
JDOC("(debug/stacktrace fiber &opt err)\n\n"
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, will skipp the error line. Returns the fiber.")
JDOC("(debug/stacktrace fiber err)\n\n"
"Prints a nice looking stacktrace for a fiber. The error message "
"err must be passed to the function as fiber's do not keep track of "
"the last error they have thrown. Returns the fiber.")
},
{
"debug/lineage", cfun_debug_lineage,

View File

@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
return reg;
}
/* Get a register less than 256 for temporary use. */
/* Get a register less than 256 */
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
return janetc_regalloc_temp(&c->scope->ra, tag);
}
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
}
/* Check if two slots are equal */
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
lhs.index == rhs.index &&
lhs.envindex == rhs.envindex) {
@@ -245,8 +245,8 @@ void janetc_copy(
janetc_moveback(c, dest, nearreg);
/* Cleanup */
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
}
}
/* Instruction templated emitters */
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {

View File

@@ -42,9 +42,6 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
/* Check if two slots are equivalent */
int janetc_sequal(JanetSlot x, JanetSlot y);
/* Move value from one slot to another. Cannot copy to constant slots. */
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);

File diff suppressed because it is too large Load Diff

View File

@@ -25,31 +25,13 @@
#ifndef JANET_FEATURES_H_defined
#define JANET_FEATURES_H_defined
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|| defined(__bsdi__) || defined(__DragonFly__)
/* Use BSD source on any BSD systems, include OSX */
# define _BSD_SOURCE
#else
/* Use POSIX feature flags */
# ifndef _POSIX_C_SOURCE
# define _POSIX_C_SOURCE 200809L
# endif
#endif
#if defined(WIN32) || defined(_WIN32)
#define WIN32_LEAN_AND_MEAN
#ifndef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 200112L
#endif
/* Needed for realpath on linux */
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
#if !defined(_XOPEN_SOURCE) && defined(__linux__)
#define _XOPEN_SOURCE 500
#endif
/* Needed for timegm and other extensions when building with -std=c99.
* It also defines realpath, etc, which would normally require
* _XOPEN_SOURCE >= 500. */
#if !defined(_NETBSD_SOURCE) && defined(__NetBSD__)
#define _NETBSD_SOURCE
#endif
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -37,12 +37,6 @@ static void fiber_reset(JanetFiber *fiber) {
fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->supervisor_channel = NULL;
#endif
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
}
@@ -83,10 +77,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
}
if (janet_fiber_funcframe(fiber, callee)) return NULL;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->supervisor_channel = NULL;
#endif
return fiber;
}
@@ -95,33 +85,14 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
}
#ifdef JANET_DEBUG
/* Test for memory issues by reallocating fiber every time we push a stack frame */
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
int32_t n = fiber->capacity;
if (n) {
Janet *newData = malloc(sizeof(Janet) * n);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
free(fiber->data);
fiber->data = newData;
}
}
#endif
/* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
int32_t old_size = fiber->capacity;
int32_t diff = n - old_size;
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
fiber->data = newData;
fiber->capacity = n;
janet_vm_next_collection += sizeof(Janet) * diff;
}
/* Grow fiber if needed */
@@ -202,10 +173,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Nil unset stack arguments (Needed for gc correctness) */
@@ -251,7 +218,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
static void janet_env_detach(JanetFuncEnv *env) {
/* Check for closure environment */
if (env) {
janet_env_valid(env);
int32_t len = env->length;
size_t s = sizeof(Janet) * (size_t) len;
Janet *vmem = malloc(s);
@@ -278,38 +244,10 @@ static void janet_env_detach(JanetFuncEnv *env) {
}
}
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
int janet_env_valid(JanetFuncEnv *env) {
if (env->offset < 0) {
int32_t real_offset = -(env->offset);
JanetFiber *fiber = env->as.fiber;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (real_offset == i &&
frame->env == env &&
frame->func &&
frame->func->def->slotcount == env->length) {
env->offset = real_offset;
return 1;
}
i = frame->prevframe;
}
/* Invalid, set to empty off-stack variant. */
env->offset = 0;
env->length = 0;
env->as.values = NULL;
return 0;
} else {
return 1;
}
}
/* Detach a fiber from the env if the target fiber has stopped mutating */
void janet_env_maybe_detach(JanetFuncEnv *env) {
/* Check for detachable closure envs */
janet_env_valid(env);
if (env->offset > 0) {
if (env->offset) {
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
@@ -338,10 +276,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
Janet *stack = fiber->data + fiber->frame;
@@ -404,10 +338,6 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Set the next frame */
@@ -423,7 +353,8 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
newframe->flags = 0;
}
/* Pop a stack frame from the fiber. */
/* Pop a stack frame from the fiber. Returns the new stack frame, or
* NULL if there are no more frames */
void janet_fiber_popframe(JanetFiber *fiber) {
JanetStackFrame *frame = janet_fiber_frame(fiber);
if (fiber->frame == 0) return;
@@ -445,10 +376,6 @@ JanetFiber *janet_current_fiber(void) {
return janet_vm_fiber;
}
JanetFiber *janet_root_fiber(void) {
return janet_vm_root_fiber;
}
/* CFuns */
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
@@ -489,7 +416,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
} else {
switch (view.bytes[i]) {
default:
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
break;
case 'a':
fiber->flags |=
@@ -552,12 +479,6 @@ static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
return janet_wrap_fiber(janet_vm_fiber);
}
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_fiber(janet_vm_root_fiber);
}
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
@@ -589,12 +510,6 @@ static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
return janet_wrap_boolean(!isFinished);
}
static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
return fiber->last_value;
}
static const JanetReg fiber_cfuns[] = {
{
"fiber/new", cfun_fiber_new,
@@ -602,43 +517,34 @@ static const JanetReg fiber_cfuns[] = {
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character "
"is used to indicate a signal to block. If the ev module is enabled, and "
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
"will result in messages being sent to the supervisor channel. "
"The default sigmask is :y. "
"For example,\n\n"
" (fiber/new myfun :e123)\n\n"
"is used to indicate a signal to block. The default sigmask is :y. "
"For example, \n\n"
"\t(fiber/new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are "
"as follows:\n\n"
"* :a - block all signals\n"
"* :d - block debug signals\n"
"* :e - block error signals\n"
"* :t - block termination signals: error + user[0-4]\n"
"* :u - block user signals\n"
"* :y - block yield signals\n"
"* :0-9 - block a specific user signal\n\n"
"as follows: \n\n"
"\ta - block all signals\n"
"\td - block debug signals\n"
"\te - block error signals\n"
"\tt - block termination signals: error + user[0-4]\n"
"\tu - block user signals\n"
"\ty - block yield signals\n"
"\t0-9 - block a specific user signal\n\n"
"The sigmask argument also can take environment flags. If any mutually "
"exclusive flags are present, the last flag takes precedence.\n\n"
"* :i - inherit the environment from the current fiber\n"
"* :p - the environment table's prototype is the current environment table")
"\ti - inherit the environment from the current fiber\n"
"\tp - the environment table's prototype is the current environment table")
},
{
"fiber/status", cfun_fiber_status,
JDOC("(fiber/status fib)\n\n"
"Get the status of a fiber. The status will be one of:\n\n"
"* :dead - the fiber has finished\n"
"* :error - the fiber has errored out\n"
"* :debug - the fiber is suspended in debug mode\n"
"* :pending - the fiber has been yielded\n"
"* :user(0-9) - the fiber is suspended by a user signal\n"
"* :alive - the fiber is currently running and cannot be resumed\n"
"* :new - the fiber has just been created and not yet run")
},
{
"fiber/root", cfun_fiber_root,
JDOC("(fiber/root)\n\n"
"Returns the current root fiber. The root fiber is the oldest ancestor "
"that does not have a parent.")
"\t:dead - the fiber has finished\n"
"\t:error - the fiber has errored out\n"
"\t:debug - the fiber is suspended in debug mode\n"
"\t:pending - the fiber has been yielded\n"
"\t:user(0-9) - the fiber is suspended by a user signal\n"
"\t:alive - the fiber is currently running and cannot be resumed\n"
"\t:new - the fiber has just been created and not yet run")
},
{
"fiber/current", cfun_fiber_current,
@@ -675,11 +581,6 @@ static const JanetReg fiber_cfuns[] = {
JDOC("(fiber/can-resume? fiber)\n\n"
"Check if a fiber is finished and cannot be resumed.")
},
{
"fiber/last-value", cfun_fiber_last_value,
JDOC("(fiber/last-value\n\n"
"Get the last value returned or signaled from the fiber.")
},
{NULL, NULL, NULL}
};

View File

@@ -46,9 +46,7 @@
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
#define JANET_FIBER_MASK_USER 0x3FF0
#define JANET_FIBER_STATUS_MASK 0x3F0000
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
#define JANET_FIBER_RESUME_SIGNAL 0x400000
#define JANET_FIBER_STATUS_MASK 0xFF0000
#define JANET_FIBER_STATUS_OFFSET 16
#define JANET_FIBER_BREAKPOINT 0x1000000
@@ -76,10 +74,5 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
void janet_fiber_popframe(JanetFiber *fiber);
void janet_env_maybe_detach(JanetFuncEnv *env);
int janet_env_valid(JanetFuncEnv *env);
#ifdef JANET_EV
void janet_fiber_did_resume(JanetFiber *fiber);
#endif
#endif

View File

@@ -28,7 +28,6 @@
#include "gc.h"
#include "util.h"
#include "fiber.h"
#include "vector.h"
#endif
struct JanetScratch {
@@ -40,7 +39,6 @@ struct JanetScratch {
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
JANET_THREAD_LOCAL size_t janet_vm_block_count;
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
/* Roots */
@@ -195,7 +193,7 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
* we don't need to keep around the whole dead fiber. */
janet_env_maybe_detach(env);
if (env->offset > 0) {
if (env->offset) {
/* On stack */
janet_mark_fiber(env->as.fiber);
} else {
@@ -226,14 +224,11 @@ static void janet_mark_function(JanetFunction *func) {
if (janet_gc_reachable(func))
return;
janet_gc_mark(func);
if (NULL != func->def) {
/* this should always be true, except if function is only partially constructed */
numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
janet_mark_funcenv(func->envs[i]);
}
janet_mark_funcdef(func->def);
numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
janet_mark_funcenv(func->envs[i]);
}
janet_mark_funcdef(func->def);
}
static void janet_mark_fiber(JanetFiber *fiber) {
@@ -244,8 +239,6 @@ recur:
return;
janet_gc_mark(fiber);
janet_mark(fiber->last_value);
/* Mark values on the argument stack */
janet_mark_many(fiber->data + fiber->stackstart,
fiber->stacktop - fiber->stackstart);
@@ -267,12 +260,6 @@ recur:
if (fiber->env)
janet_mark_table(fiber->env);
#ifdef JANET_EV
if (fiber->supervisor_channel) {
janet_mark_abstract(fiber->supervisor_channel);
}
#endif
/* Explicit tail recursion */
if (fiber->child) {
fiber = fiber->child;
@@ -340,7 +327,6 @@ void janet_sweep() {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
janet_vm_block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->next = next;
@@ -373,7 +359,6 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
janet_vm_next_collection += size;
mem->next = janet_vm_blocks;
janet_vm_blocks = mem;
janet_vm_block_count++;
return (void *)mem;
}
@@ -403,19 +388,7 @@ void janet_collect(void) {
uint32_t i;
if (janet_vm_gc_suspend) return;
depth = JANET_RECURSION_GUARD;
/* Try and prevent many major collections back to back.
* A full collection will take O(janet_vm_block_count) time.
* If we have a large heap, make sure our interval is not too
* small so we won't make many collections over it. This is just a
* heuristic for automatically changing the gc interval */
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
}
orig_rootcount = janet_vm_root_count;
#ifdef JANET_EV
janet_ev_mark();
#endif
janet_mark_fiber(janet_vm_root_fiber);
for (i = 0; i < orig_rootcount; i++)
janet_mark(janet_vm_roots[i]);
while (orig_rootcount < janet_vm_root_count) {
@@ -557,7 +530,7 @@ void *janet_srealloc(void *mem, size_t size) {
if (i == 0) break;
}
}
JANET_EXIT("invalid janet_srealloc");
janet_exit("invalid janet_srealloc");
}
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
@@ -578,5 +551,5 @@ void janet_sfree(void *mem) {
if (i == 0) break;
}
}
JANET_EXIT("invalid janet_sfree");
janet_exit("invalid janet_sfree");
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose & contributors
* Copyright (c) 2020 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -20,18 +20,18 @@
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
/* Conditional compilation */
#ifdef JANET_INT_TYPES
@@ -39,8 +39,6 @@
static int it_s64_get(void *p, Janet key, Janet *out);
static int it_u64_get(void *p, Janet key, Janet *out);
static Janet janet_int64_next(void *p, Janet key);
static Janet janet_uint64_next(void *p, Janet key);
static int32_t janet_int64_hash(void *p1, size_t size) {
(void) size;
@@ -94,8 +92,7 @@ const JanetAbstractType janet_s64_type = {
it_s64_tostring,
janet_int64_compare,
janet_int64_hash,
janet_int64_next,
JANET_ATEND_NEXT
JANET_ATEND_HASH
};
const JanetAbstractType janet_u64_type = {
@@ -109,8 +106,7 @@ const JanetAbstractType janet_u64_type = {
it_u64_tostring,
janet_uint64_compare,
janet_int64_hash,
janet_uint64_next,
JANET_ATEND_NEXT
JANET_ATEND_HASH
};
int64_t janet_unwrap_s64(Janet x) {
@@ -138,7 +134,7 @@ int64_t janet_unwrap_s64(Janet x) {
break;
}
}
janet_panicf("bad s64 initializer: %t", x);
janet_panic("bad s64 initializer");
return 0;
}
@@ -148,9 +144,7 @@ uint64_t janet_unwrap_u64(Janet x) {
break;
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
/* Allow negative values to be cast to "wrap around".
* This let's addition and subtraction work as expected. */
if (fabs(dbl) <= MAX_INT_IN_DBL)
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
return (uint64_t)dbl;
break;
}
@@ -169,7 +163,7 @@ uint64_t janet_unwrap_u64(Janet x) {
break;
}
}
janet_panicf("bad u64 initializer: %t", x);
janet_panic("bad u64 initializer");
return 0;
}
@@ -203,120 +197,6 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
/*
* Code to support polymorphic comparison.
* int/u64 and int/s64 support a "compare" method that allows
* comparison to each other, and to Janet numbers, using the
* "compare" "compare<" ... functions.
* In the following code explicit casts are sometimes used to help
* make it clear when int/float conversions are happening.
*/
static int compare_double_double(double x, double y) {
return (x < y) ? -1 : ((x > y) ? 1 : 0);
}
static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) {
return -1;
} else if (y < ((double) INT64_MIN)) {
return 1;
} else {
int64_t yi = (int64_t) y;
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
}
}
static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if (y < 0) {
return 1;
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) UINT64_MAX)) {
return -1;
} else {
uint64_t yi = (uint64_t) y;
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
}
}
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64)
janet_panic("compare method requires int/s64 as first argument");
int64_t x = janet_unwrap_s64(argv[0]);
switch (janet_type(argv[1])) {
default:
break;
case JANET_NUMBER : {
double y = janet_unwrap_number(argv[1]);
return janet_wrap_number(compare_int64_double(x, y));
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(argv[1]);
if (janet_abstract_type(abst) == &janet_s64_type) {
int64_t y = *(int64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_u64_type) {
// comparing signed to unsigned -- be careful!
uint64_t y = *(uint64_t *)abst;
if (x < 0) {
return janet_wrap_number(-1);
} else if (y > INT64_MAX) {
return janet_wrap_number(-1);
} else {
int64_t y2 = (int64_t) y;
return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
}
}
break;
}
}
return janet_wrap_nil();
}
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
janet_panic("compare method requires int/u64 as first argument");
uint64_t x = janet_unwrap_u64(argv[0]);
switch (janet_type(argv[1])) {
default:
break;
case JANET_NUMBER : {
double y = janet_unwrap_number(argv[1]);
return janet_wrap_number(compare_uint64_double(x, y));
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(argv[1]);
if (janet_abstract_type(abst) == &janet_u64_type) {
uint64_t y = *(uint64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_s64_type) {
// comparing unsigned to signed -- be careful!
int64_t y = *(int64_t *)abst;
if (y < 0) {
return janet_wrap_number(1);
} else if (x > INT64_MAX) {
return janet_wrap_number(1);
} else {
int64_t x2 = (int64_t) x;
return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
}
}
break;
}
}
return janet_wrap_nil();
}
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
@@ -386,15 +266,40 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
return janet_wrap_abstract(box); \
} \
#define COMPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T v1 = janet_unwrap_##type(argv[0]); \
T v2 = janet_unwrap_##type(argv[1]); \
return janet_wrap_boolean(v1 oper v2); \
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
*box = janet_unwrap_s64(argv[0]);
for (int32_t i = 1; i < argc; i++) {
int64_t value = janet_unwrap_s64(argv[i]);
if (value == 0) janet_panic("division by zero");
int64_t x = *box % value;
if (x < 0) {
x = (*box < 0) ? x - *box : x + *box;
}
*box = x;
}
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
if (x < 0) {
x = (op1 < 0) ? x - op1 : x + op1;
}
*box = x;
return janet_wrap_abstract(box);
}
@@ -405,11 +310,19 @@ OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>)
COMPMETHOD(int64_t, s64, lt, <)
COMPMETHOD(int64_t, s64, gt, >)
COMPMETHOD(int64_t, s64, le, <=)
COMPMETHOD(int64_t, s64, ge, >=)
COMPMETHOD(int64_t, s64, eq, ==)
COMPMETHOD(int64_t, s64, ne, !=)
OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, subi, -)
@@ -417,18 +330,24 @@ OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /)
DIVMETHODINVERT(uint64_t, u64, modi, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
OPMETHOD(uint64_t, u64, lshift, <<)
OPMETHOD(uint64_t, u64, rshift, >>)
COMPMETHOD(uint64_t, u64, lt, <)
COMPMETHOD(uint64_t, u64, gt, >)
COMPMETHOD(uint64_t, u64, le, <=)
COMPMETHOD(uint64_t, u64, ge, >=)
COMPMETHOD(uint64_t, u64, eq, ==)
COMPMETHOD(uint64_t, u64, ne, !=)
#undef OPMETHOD
#undef DIVMETHOD
#undef DIVMETHOD_SIGNED
#undef COMPMETHOD
static JanetMethod it_s64_methods[] = {
{"+", cfun_it_s64_add},
{"r+", cfun_it_s64_add},
@@ -439,9 +358,15 @@ static JanetMethod it_s64_methods[] = {
{"/", cfun_it_s64_div},
{"r/", cfun_it_s64_divi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
{"r%", cfun_it_s64_rem},
{"r%", cfun_it_s64_remi},
{"<", cfun_it_s64_lt},
{">", cfun_it_s64_gt},
{"<=", cfun_it_s64_le},
{">=", cfun_it_s64_ge},
{"=", cfun_it_s64_eq},
{"!=", cfun_it_s64_ne},
{"&", cfun_it_s64_and},
{"r&", cfun_it_s64_and},
{"|", cfun_it_s64_or},
@@ -450,7 +375,6 @@ static JanetMethod it_s64_methods[] = {
{"r^", cfun_it_s64_xor},
{"<<", cfun_it_s64_lshift},
{">>", cfun_it_s64_rshift},
{"compare", cfun_it_s64_compare},
{NULL, NULL}
};
@@ -465,9 +389,15 @@ static JanetMethod it_u64_methods[] = {
{"/", cfun_it_u64_div},
{"r/", cfun_it_u64_divi},
{"mod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_modi},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_mod},
{"r%", cfun_it_u64_modi},
{"<", cfun_it_u64_lt},
{">", cfun_it_u64_gt},
{"<=", cfun_it_u64_le},
{">=", cfun_it_u64_ge},
{"=", cfun_it_u64_eq},
{"!=", cfun_it_u64_ne},
{"&", cfun_it_u64_and},
{"r&", cfun_it_u64_and},
{"|", cfun_it_u64_or},
@@ -476,21 +406,10 @@ static JanetMethod it_u64_methods[] = {
{"r^", cfun_it_u64_xor},
{"<<", cfun_it_u64_lshift},
{">>", cfun_it_u64_rshift},
{"compare", cfun_it_u64_compare},
{NULL, NULL}
};
static Janet janet_int64_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(it_s64_methods, key);
}
static Janet janet_uint64_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(it_u64_methods, key);
}
static int it_s64_get(void *p, Janet key, Janet *out) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -30,39 +30,27 @@
#include <errno.h>
#ifndef JANET_WINDOWS
#include <fcntl.h>
#include <sys/wait.h>
#include <unistd.h>
#endif
static int cfun_io_gc(void *p, size_t len);
static int io_file_get(void *p, Janet key, Janet *out);
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
NULL,
io_file_get,
NULL,
io_file_marshal,
io_file_unmarshal,
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
io_file_next,
JANET_ATEND_NEXT
JANET_ATEND_GET
};
/* Check arguments to fopen */
static int32_t checkflags(const uint8_t *str) {
int32_t flags = 0;
static int checkflags(const uint8_t *str) {
int flags = 0;
int32_t i;
int32_t len = janet_string_length(str);
if (!len || len > 10)
janet_panic("file mode must have a length between 1 and 10");
if (!len || len > 3)
janet_panic("file mode must have a length between 1 and 3");
switch (*str) {
default:
janet_panicf("invalid flag %c, expected w, a, or r", *str);
@@ -80,7 +68,7 @@ static int32_t checkflags(const uint8_t *str) {
for (i = 1; i < len; i++) {
switch (str[i]) {
default:
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
janet_panicf("invalid flag %c, expected + or b", str[i]);
break;
case '+':
if (flags & JANET_FILE_UPDATE) return -1;
@@ -90,42 +78,39 @@ static int32_t checkflags(const uint8_t *str) {
if (flags & JANET_FILE_BINARY) return -1;
flags |= JANET_FILE_BINARY;
break;
case 'n':
if (flags & JANET_FILE_NONIL) return -1;
flags |= JANET_FILE_NONIL;
break;
}
}
return flags;
}
static void *makef(FILE *f, int32_t flags) {
static Janet makef(FILE *f, int flags) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
#ifndef JANET_WINDOWS
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
* not standard. */
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
#endif
return iof;
return janet_wrap_abstract(iof);
}
/* Open a process */
#ifndef JANET_NO_PROCESSES
#ifdef __EMSCRIPTEN__
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
(void) argc;
(void) argv;
janet_panic("not implemented on this platform");
return janet_wrap_nil();
}
#else
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode = NULL;
int32_t flags;
int flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = JANET_FILE_PIPED | checkflags(fmode);
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
if (janet_string_length(fmode) != 1 ||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
}
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
} else {
fmode = (const uint8_t *)"r";
flags = JANET_FILE_PIPED | JANET_FILE_READ;
@@ -135,18 +120,15 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
#endif
FILE *f = popen((const char *)fname, (const char *)fmode);
if (!f) {
if (flags & JANET_FILE_NONIL)
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
return janet_wrap_nil();
}
return janet_makefile(f, flags);
return makef(f, flags);
}
#endif
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
(void)argv;
janet_fixarity(argc, 0);
// XXX use mkostemp when we can to avoid CLOEXEC race.
FILE *tmp = tmpfile();
if (!tmp)
janet_panicf("unable to create temporary file - %s", strerror(errno));
@@ -157,7 +139,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
int32_t flags;
int flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = checkflags(fmode);
@@ -166,9 +148,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
return f ? makef(f, flags) : janet_wrap_nil();
}
/* Read up to n bytes into buffer. */
@@ -259,34 +239,13 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
return argv[0];
}
#ifdef JANET_WINDOWS
#define pclose _pclose
#define WEXITSTATUS(x) x
#endif
/* For closing files from C API */
int janet_file_close(JanetFile *file) {
int ret = 0;
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
#ifndef JANET_NO_PROCESSES
if (file->flags & JANET_FILE_PIPED) {
ret = pclose(file->file);
} else
#endif
{
ret = fclose(file->file);
}
file->flags |= JANET_FILE_CLOSED;
return ret;
}
return 0;
}
/* Cleanup a file */
static int cfun_io_gc(void *p, size_t len) {
(void) len;
JanetFile *iof = (JanetFile *)p;
janet_file_close(iof);
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
return fclose(iof->file);
}
return 0;
}
@@ -299,22 +258,19 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
janet_panic("file not closable");
if (iof->flags & JANET_FILE_PIPED) {
#ifndef JANET_NO_PROCESSES
#ifdef JANET_WINDOWS
#define pclose _pclose
#define WEXITSTATUS(x) x
#endif
int status = pclose(iof->file);
iof->flags |= JANET_FILE_CLOSED;
if (status == -1) janet_panic("could not close file");
return janet_wrap_integer(WEXITSTATUS(status));
#else
return janet_wrap_nil();
#endif
} else {
if (fclose(iof->file)) {
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
janet_panic("could not close file");
}
if (fclose(iof->file)) janet_panic("could not close file");
iof->flags |= JANET_FILE_CLOSED;
return janet_wrap_nil();
}
return janet_wrap_nil();
}
/* Seek a file */
@@ -360,55 +316,6 @@ static int io_file_get(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
}
static Janet io_file_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(io_file_methods, key);
}
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
JanetFile *iof = (JanetFile *)p;
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
janet_marshal_abstract(ctx, p);
#ifdef JANET_WINDOWS
janet_marshal_int(ctx, _fileno(iof->file));
#else
janet_marshal_int(ctx, fileno(iof->file));
#endif
janet_marshal_int(ctx, iof->flags);
} else {
janet_panic("cannot marshal file in safe mode");
}
}
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
int32_t fd = janet_unmarshal_int(ctx);
int32_t flags = janet_unmarshal_int(ctx);
char fmt[4] = {0};
int index = 0;
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
if (flags & JANET_FILE_APPEND) {
fmt[index++] = 'a';
} else if (flags & JANET_FILE_WRITE) {
fmt[index++] = 'w';
}
#ifdef JANET_WINDOWS
iof->file = _fdopen(fd, fmt);
#else
iof->file = fdopen(fd, fmt);
#endif
if (iof->file == NULL) {
iof->flags = JANET_FILE_CLOSED;
} else {
iof->flags = flags;
}
return iof;
} else {
janet_panic("cannot unmarshal file in safe mode");
}
}
FILE *janet_dynfile(const char *name, FILE *def) {
Janet x = janet_dyn(name);
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
@@ -418,16 +325,18 @@ FILE *janet_dynfile(const char *name, FILE *def) {
return iofile->file;
}
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
FILE *f;
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
janet_panicf("cannot print to %v", x);
/* Other values simply do nothing */
return janet_wrap_nil();
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
for (int32_t i = offset; i < argc; ++i) {
for (int32_t i = 0; i < argc; ++i) {
janet_to_string_b(buf, argv[i]);
}
if (newline)
@@ -436,7 +345,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -447,7 +355,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
break;
}
}
for (int32_t i = offset; i < argc; ++i) {
for (int32_t i = 0; i < argc; ++i) {
int32_t len;
const uint8_t *vstr;
if (janet_checktype(argv[i], JANET_BUFFER)) {
@@ -460,11 +368,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
}
if (len) {
if (1 != fwrite(vstr, len, 1, f)) {
if (f == dflt_file) {
janet_panicf("cannot print %d bytes", len);
} else {
janet_panicf("cannot print %d bytes to %v", len, x);
}
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
}
}
}
@@ -473,13 +377,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
return janet_wrap_nil();
}
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_print(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
}
@@ -496,33 +393,25 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
FILE *f;
const char *fmt = janet_getcstring(argv, offset);
janet_arity(argc, 1, -1);
const char *fmt = janet_getcstring(argv, 0);
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
janet_panicf("cannot print to %v", x);
/* Other values simply do nothing */
return janet_wrap_nil();
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
janet_buffer_format(buf, fmt, offset, argc, argv);
janet_buffer_format(buf, fmt, 0, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
return janet_wrap_nil();
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -534,11 +423,11 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
}
}
JanetBuffer *buf = janet_buffer(10);
janet_buffer_format(buf, fmt, offset, argc, argv);
janet_buffer_format(buf, fmt, 0, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
if (buf->count) {
if (1 != fwrite(buf->data, buf->count, 1, f)) {
janet_panicf("could not print %d bytes to file", buf->count);
janet_panicf("could not print %d bytes to file", buf->count, name);
}
}
/* Clear buffer to make things easier for GC */
@@ -549,14 +438,6 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
return janet_wrap_nil();
}
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
janet_arity(argc, 1, -1);
Janet x = janet_dyn(name);
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
}
@@ -573,16 +454,6 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
@@ -631,7 +502,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
int32_t len = 0;
while (format[len]) len++;
janet_buffer_init(&buffer, len);
janet_formatbv(&buffer, format, args);
janet_formatb(&buffer, format, args);
if (xtype == JANET_ABSTRACT) {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &janet_file_type)
@@ -644,7 +515,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
break;
}
case JANET_BUFFER:
janet_formatbv(janet_unwrap_buffer(x), format, args);
janet_formatb(janet_unwrap_buffer(x), format, args);
break;
}
va_end(args);
@@ -696,29 +567,6 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"xprint", cfun_io_xprint,
JDOC("(xprint to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
"newline character. The value to print "
"to is the first argument, and is otherwise the same as print. Returns nil.")
},
{
"xprin", cfun_io_xprin,
JDOC("(xprin to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
"to is the first argument, and is otherwise the same as prin. Returns nil.")
},
{
"xprintf", cfun_io_xprintf,
JDOC("(xprint to fmt & xs)\n\n"
"Like printf but prints to an explicit file or value to. Returns nil.")
},
{
"xprinf", cfun_io_xprinf,
JDOC("(xprin to fmt & xs)\n\n"
"Like prinf but prints to an explicit file or value to. Returns nil.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
@@ -732,24 +580,22 @@ static const JanetReg io_cfuns[] = {
{
"file/temp", cfun_io_temp,
JDOC("(file/temp)\n\n"
"Open an anonymous temporary file that is removed on close. "
"Open an anonymous temporary file that is removed on close."
"Raises an error on failure.")
},
{
"file/open", cfun_io_fopen,
JDOC("(file/open path &opt mode)\n\n"
"Open a file. `path` is an absolute or relative path, and "
"`mode` is a set of flags indicating the mode to open the file in. "
"`mode` is a keyword where each character represents a flag. If the file "
"Open a file. path is an absolute or relative path, and "
"mode is a set of flags indicating the mode to open the file in. "
"mode is a keyword where each character represents a flag. If the file "
"cannot be opened, returns nil, otherwise returns the new file handle. "
"Mode flags:\n\n"
"* r - allow reading from the file\n\n"
"* w - allow writing to the file\n\n"
"* a - append to the file\n\n"
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil")
"\tr - allow reading from the file\n"
"\tw - allow writing to the file\n"
"\ta - append to the file\n"
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
},
{
"file/close", cfun_io_fclose,
@@ -762,14 +608,14 @@ static const JanetReg io_cfuns[] = {
{
"file/read", cfun_io_fread,
JDOC("(file/read f what &opt buf)\n\n"
"Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
"be provided as an optional third argument, otherwise a new buffer "
"is created. `what` can either be an integer or a keyword. Returns the "
"Read a number of bytes from a file into a buffer. A buffer can "
"be provided as an optional fourth argument, otherwise a new buffer "
"is created. 'what' can either be an integer or a keyword. Returns the "
"buffer with file contents. "
"Values for `what`:\n\n"
"* :all - read the whole file\n\n"
"* :line - read up to and including the next newline character\n\n"
"* n (integer) - read up to n bytes from the file")
"Values for 'what':\n\n"
"\t:all - read the whole file\n"
"\t:line - read up to and including the next newline character\n"
"\tn (integer) - read up to n bytes from the file")
},
{
"file/write", cfun_io_fwrite,
@@ -786,45 +632,35 @@ static const JanetReg io_cfuns[] = {
{
"file/seek", cfun_io_fseek,
JDOC("(file/seek f &opt whence n)\n\n"
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
"* :cur - jump relative to the current file location\n\n"
"* :set - jump relative to the beginning of the file\n\n"
"* :end - jump relative to the end of the file\n\n"
"By default, `whence` is :cur. Optionally a value `n` may be passed "
"for the relative number of bytes to seek in the file. `n` may be a real "
"number to handle large files of more than 4GB. Returns the file handle.")
"Jump to a relative location in the file. 'whence' must be one of\n\n"
"\t:cur - jump relative to the current file location\n"
"\t:set - jump relative to the beginning of the file\n"
"\t:end - jump relative to the end of the file\n\n"
"By default, 'whence' is :cur. Optionally a value n may be passed "
"for the relative number of bytes to seek in the file. n may be a real "
"number to handle large files of more the 4GB. Returns the file handle.")
},
#ifndef JANET_NO_PROCESSES
{
"file/popen", cfun_io_popen,
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
JDOC("(file/popen path &opt mode)\n\n"
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "
"can be written to. Returns the new file.")
},
#endif
{NULL, NULL, NULL}
};
/* C API */
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &janet_file_type);
}
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
JanetFile *janet_makejfile(FILE *f, int flags) {
return makef(f, flags);
}
Janet janet_makefile(FILE *f, int flags) {
return janet_wrap_abstract(makef(f, flags));
return makef(f, flags);
}
JanetAbstract janet_checkfile(Janet j) {
@@ -840,19 +676,18 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
/* Module entry point */
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
janet_register_abstract_type(&janet_file_type);
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
/* stdout */
janet_core_def(env, "stdout",
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard output file."));
/* stderr */
janet_core_def(env, "stderr",
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard error file."));
/* stdin */
janet_core_def(env, "stdin",
janet_makefile(stdin, JANET_FILE_READ | default_flags),
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard input file."));
}

View File

@@ -42,28 +42,26 @@ typedef struct {
/* Lead bytes in marshaling protocol */
enum {
LB_REAL = 200,
LB_NIL, /* 201 */
LB_FALSE, /* 202 */
LB_TRUE, /* 203 */
LB_FIBER, /* 204 */
LB_INTEGER, /* 205 */
LB_STRING, /* 206 */
LB_SYMBOL, /* 207 */
LB_KEYWORD, /* 208 */
LB_ARRAY, /* 209 */
LB_TUPLE, /* 210 */
LB_TABLE, /* 211 */
LB_TABLE_PROTO, /* 212 */
LB_STRUCT, /* 213 */
LB_BUFFER, /* 214 */
LB_FUNCTION, /* 215 */
LB_REGISTRY, /* 216 */
LB_ABSTRACT, /* 217 */
LB_REFERENCE, /* 218 */
LB_FUNCENV_REF, /* 219 */
LB_FUNCDEF_REF, /* 220 */
LB_UNSAFE_CFUNCTION, /* 221 */
LB_UNSAFE_POINTER /* 222 */
LB_NIL,
LB_FALSE,
LB_TRUE,
LB_FIBER,
LB_INTEGER,
LB_STRING,
LB_SYMBOL,
LB_KEYWORD,
LB_ARRAY,
LB_TUPLE,
LB_TABLE,
LB_TABLE_PROTO,
LB_STRUCT,
LB_BUFFER,
LB_FUNCTION,
LB_REGISTRY,
LB_ABSTRACT,
LB_REFERENCE,
LB_FUNCENV_REF,
LB_FUNCDEF_REF
} LeadBytes;
/* Helper to look inside an entry in an environment */
@@ -185,9 +183,8 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
return;
}
}
janet_env_valid(env);
janet_v_push(st->seen_envs, env);
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
@@ -203,7 +200,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
janet_env_maybe_detach(env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset > 0) {
if (env->offset) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
} else {
@@ -214,6 +211,15 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
}
/* Add function flags to janet functions */
static void janet_func_addflags(JanetFuncDef *def) {
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a sequence of u32s */
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
for (int32_t i = 0; i < n; i++) {
@@ -234,6 +240,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
return;
}
}
janet_func_addflags(def);
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
@@ -285,8 +292,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 30)
#define JANET_STACKFRAME_HASENV (INT32_MIN)
#define JANET_FIBER_FLAG_HASENV (1 << 28)
#define JANET_STACKFRAME_HASENV (1 << 30)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
@@ -542,10 +549,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
/* Mark seen before reading def */
MARK_SEEN();
pushint(st, func->def->environments_length);
marshal_one_def(st, func->def, flags);
/* Mark seen after reading def, but before envs */
MARK_SEEN();
for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1);
return;
@@ -556,25 +562,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
return;
}
case JANET_CFUNCTION: {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_CFUNCTION);
JanetCFunction cfn = janet_unwrap_cfunction(x);
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
return;
}
case JANET_POINTER: {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_POINTER);
void *ptr = janet_unwrap_pointer(x);
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
return;
}
no_registry:
default: {
janet_panicf("no registry value and cannot marshal %p", x);
return;
}
}
#undef MARK_SEEN
@@ -644,15 +634,6 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
return ret;
}
/* Helper to read a natural number (int >= 0). */
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
int32_t ret = readint(st, atdata);
if (ret < 0) {
janet_panicf("expected integer >= 0, got %d", ret);
}
return ret;
}
/* Helper to read a size_t (up to 8 bytes unsigned). */
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
uint64_t ret;
@@ -721,31 +702,30 @@ static const uint8_t *unmarshal_one_env(
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
env->length = 0;
env->offset = 0;
env->as.values = NULL;
janet_v_push(st->lookup_envs, env);
int32_t offset = readnat(st, &data);
int32_t length = readnat(st, &data);
if (offset > 0) {
int32_t offset = readint(st, &data);
int32_t length = readint(st, &data);
if (offset) {
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Negative offset indicates untrusted input */
env->offset = -offset;
/* Unmarshalling fiber may set values */
if (env->offset != 0 && env->offset != offset)
janet_panic("invalid funcenv offset");
if (env->length != 0 && env->length != length)
janet_panic("invalid funcenv length");
} else {
/* Off stack variant */
if (length == 0) {
janet_panic("invalid funcenv length");
}
env->as.values = malloc(sizeof(Janet) * (size_t) length);
if (!env->as.values) {
JANET_OUT_OF_MEMORY;
}
env->offset = 0;
for (int32_t i = 0; i < length; i++)
data = unmarshal_one(st, data, env->as.values + i, flags);
}
env->offset = offset;
env->length = length;
*out = env;
}
@@ -790,11 +770,6 @@ static const uint8_t *unmarshal_one_def(
def->name = NULL;
def->source = NULL;
def->closure_bitset = NULL;
def->defs = NULL;
def->environments = NULL;
def->constants = NULL;
def->bytecode = NULL;
def->sourcemap = NULL;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -805,18 +780,18 @@ static const uint8_t *unmarshal_one_def(
/* Read flags and other fixed values */
def->flags = readint(st, &data);
def->slotcount = readnat(st, &data);
def->arity = readnat(st, &data);
def->min_arity = readnat(st, &data);
def->max_arity = readnat(st, &data);
def->slotcount = readint(st, &data);
def->arity = readint(st, &data);
def->min_arity = readint(st, &data);
def->max_arity = readint(st, &data);
/* Read some lengths */
constants_length = readnat(st, &data);
bytecode_length = readnat(st, &data);
constants_length = readint(st, &data);
bytecode_length = readint(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
environments_length = readnat(st, &data);
environments_length = readint(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
defs_length = readnat(st, &data);
defs_length = readint(st, &data);
/* Check name and source (optional) */
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
@@ -899,12 +874,11 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal closure bitset if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
int32_t n = (def->slotcount + 31) >> 5;
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
if (NULL == def->closure_bitset) {
JANET_OUT_OF_MEMORY;
}
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
}
/* Validate */
@@ -924,7 +898,7 @@ static const uint8_t *unmarshal_one_fiber(
JanetFiber **out,
int flags) {
/* Initialize a new fiber with gc friendly defaults */
/* Initialize a new fiber */
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
fiber->flags = 0;
fiber->frame = 0;
@@ -935,50 +909,46 @@ static const uint8_t *unmarshal_one_fiber(
fiber->data = NULL;
fiber->child = NULL;
fiber->env = NULL;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->supervisor_channel = NULL;
#endif
/* Push fiber to seen stack */
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
int32_t frame = 0;
int32_t stack = 0;
int32_t stacktop = 0;
/* Read ints */
int32_t fiber_flags = readint(st, &data);
int32_t frame = readnat(st, &data);
int32_t fiber_stackstart = readnat(st, &data);
int32_t fiber_stacktop = readnat(st, &data);
int32_t fiber_maxstack = readnat(st, &data);
JanetTable *fiber_env = NULL;
fiber->flags = readint(st, &data);
frame = readint(st, &data);
fiber->stackstart = readint(st, &data);
fiber->stacktop = readint(st, &data);
fiber->maxstack = readint(st, &data);
/* Check for bad flags and ints */
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
fiber_stackstart > fiber_stacktop ||
fiber_stacktop > fiber_maxstack) {
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
fiber->stackstart > fiber->stacktop ||
fiber->stacktop > fiber->maxstack) {
janet_panic("fiber has incorrect stack setup");
}
/* Allocate stack memory */
fiber->capacity = fiber_stacktop + 10;
fiber->capacity = fiber->stacktop + 10;
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
if (!fiber->data) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < fiber->capacity; i++) {
fiber->data[i] = janet_wrap_nil();
}
/* get frames */
int32_t stack = frame;
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
stack = frame;
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
while (stack > 0) {
JanetFunction *func = NULL;
JanetFuncDef *def = NULL;
JanetFuncEnv *env = NULL;
int32_t frameflags = readint(st, &data);
int32_t prevframe = readnat(st, &data);
int32_t pcdiff = readnat(st, &data);
int32_t prevframe = readint(st, &data);
int32_t pcdiff = readint(st, &data);
/* Get frame items */
Janet *framestack = fiber->data + stack;
@@ -994,7 +964,15 @@ static const uint8_t *unmarshal_one_fiber(
/* Check env */
if (frameflags & JANET_STACKFRAME_HASENV) {
frameflags &= ~JANET_STACKFRAME_HASENV;
int32_t offset = stack;
int32_t length = stacktop - stack;
data = unmarshal_one_env(st, data, &env, flags + 1);
if (env->offset != 0 && env->offset != offset)
janet_panic("funcenv offset does not match fiber frame");
if (env->length != 0 && env->length != length)
janet_panic("funcenv length does not match fiber frame");
env->offset = offset;
env->length = length;
}
/* Error checking */
@@ -1002,11 +980,11 @@ static const uint8_t *unmarshal_one_fiber(
if (expected_framesize != stacktop - stack) {
janet_panic("fiber stackframe size mismatch");
}
if (pcdiff >= def->bytecode_length) {
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
janet_panic("fiber stackframe has invalid pc");
}
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
janet_panic("fiber stackframe does not align with previous frame");
janet_panic("fibre stackframe does not align with previous frame");
}
/* Get stack items */
@@ -1029,37 +1007,25 @@ static const uint8_t *unmarshal_one_fiber(
}
/* Check for fiber env */
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
Janet envv;
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE);
fiber_env = janet_unwrap_table(envv);
fiber->env = janet_unwrap_table(envv);
}
/* Check for child fiber */
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
Janet fiberv;
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER);
fiber->child = janet_unwrap_fiber(fiberv);
}
/* We have valid fiber, finally construct remaining fields. */
fiber->frame = frame;
fiber->flags = fiber_flags;
fiber->stackstart = fiber_stackstart;
fiber->stacktop = fiber_stacktop;
fiber->maxstack = fiber_maxstack;
fiber->env = fiber_env;
int status = janet_fiber_status(fiber);
if (status < 0 || status > JANET_STATUS_ALIVE) {
janet_panic("invalid fiber status");
}
/* Return data */
fiber->frame = frame;
*out = fiber;
return data;
}
@@ -1118,7 +1084,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
const JanetAbstractType *at = janet_get_abstract_type(key);
if (at == NULL) goto oops;
if (at == NULL) return NULL;
if (at->unmarshal) {
JanetMarshalContext context = {NULL, st, flags, data, at};
*out = janet_wrap_abstract(at->unmarshal(&context));
@@ -1127,8 +1093,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
}
return context.data;
}
oops:
janet_panic("invalid abstract type");
return NULL;
}
static const uint8_t *unmarshal_one(
@@ -1140,7 +1105,7 @@ static const uint8_t *unmarshal_one(
MARSH_STACKCHECK;
MARSH_EOS(st, data);
lead = data[0];
if (lead < LB_REAL) {
if (lead < 200) {
*out = janet_wrap_integer(readint(st, &data));
return data;
}
@@ -1194,7 +1159,7 @@ static const uint8_t *unmarshal_one(
case LB_KEYWORD:
case LB_REGISTRY: {
data++;
int32_t len = readnat(st, &data);
int32_t len = readint(st, &data);
MARSH_EOS(st, data - 1 + len);
if (lead == LB_STRING) {
const uint8_t *str = janet_string(data, len);
@@ -1230,20 +1195,12 @@ static const uint8_t *unmarshal_one(
case LB_FUNCTION: {
JanetFunction *func;
JanetFuncDef *def;
data++;
int32_t len = readnat(st, &data);
if (len > 255) {
janet_panicf("invalid function");
}
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
len * sizeof(JanetFuncEnv));
def->environments_length * sizeof(JanetFuncEnv));
func->def = def;
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
if (def->environments_length != len) {
janet_panicf("invalid function");
}
func->def = def;
for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}
@@ -1262,11 +1219,7 @@ static const uint8_t *unmarshal_one(
/* Things that open with integers */
{
data++;
int32_t len = readnat(st, &data);
/* DOS check */
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
int32_t len = readint(st, &data);
if (lead == LB_ARRAY) {
/* Array */
JanetArray *array = janet_array(len);
@@ -1298,7 +1251,7 @@ static const uint8_t *unmarshal_one(
*out = janet_wrap_struct(janet_struct_end(struct_));
janet_v_push(st->lookup, *out);
} else if (lead == LB_REFERENCE) {
if (len >= janet_v_count(st->lookup))
if (len < 0 || len >= janet_v_count(st->lookup))
janet_panicf("invalid reference %d", len);
*out = st->lookup[len];
} else {
@@ -1321,42 +1274,6 @@ static const uint8_t *unmarshal_one(
}
return data;
}
case LB_UNSAFE_POINTER: {
MARSH_EOS(st, data + sizeof(void *));
data++;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal raw pointer at index %d",
(int)(data - st->start));
}
union {
void *ptr;
uint8_t bytes[sizeof(void *)];
} u;
memcpy(u.bytes, data, sizeof(void *));
data += sizeof(void *);
*out = janet_wrap_pointer(u.ptr);
janet_v_push(st->lookup, *out);
return data;
}
case LB_UNSAFE_CFUNCTION: {
MARSH_EOS(st, data + sizeof(JanetCFunction));
data++;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal function pointer at index %d",
(int)(data - st->start));
}
union {
JanetCFunction ptr;
uint8_t bytes[sizeof(JanetCFunction)];
} u;
memcpy(u.bytes, data, sizeof(JanetCFunction));
data += sizeof(JanetCFunction);
*out = janet_wrap_cfunction(u.ptr);
janet_v_push(st->lookup, *out);
return data;
}
default: {
janet_panicf("unknown byte %x at index %d",
*data,
@@ -1427,17 +1344,17 @@ static const JanetReg marsh_cfuns[] = {
{
"marshal", cfun_marshal,
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
"Marshal a value into a buffer and return the buffer. The buffer "
"can then later be unmarshalled to reconstruct the initial value. "
"Marshal a janet value into a buffer and return the buffer. The buffer "
"can the later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward "
"lookup table can be used to recover the original value when "
"aliased values that are found in the table. Then a forward"
"lookup table can be used to recover the original janet value when "
"unmarshalling.")
},
{
"unmarshal", cfun_unmarshal,
JDOC("(unmarshal buffer &opt lookup)\n\n"
"Unmarshal a value from a buffer. An optional lookup table "
"Unmarshal a janet value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.")
},

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -31,7 +31,6 @@
static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
static int janet_rng_get(void *p, Janet key, Janet *out);
static Janet janet_rng_next(void *p, Janet key);
static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) {
JanetRNG *rng = (JanetRNG *)p;
@@ -61,11 +60,7 @@ const JanetAbstractType janet_rng_type = {
NULL,
janet_rng_marshal,
janet_rng_unmarshal,
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
janet_rng_next,
JANET_ATEND_NEXT
JANET_ATEND_UNMARSHAL
};
JanetRNG *janet_default_rng(void) {
@@ -208,11 +203,6 @@ static int janet_rng_get(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), rng_methods, out);
}
static Janet janet_rng_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(rng_methods, key);
}
/* Get a random number */
static Janet janet_rand(int32_t argc, Janet *argv) {
(void) argv;
@@ -265,10 +255,6 @@ JANET_DEFINE_MATHOP(fabs, fabs)
JANET_DEFINE_MATHOP(floor, floor)
JANET_DEFINE_MATHOP(trunc, trunc)
JANET_DEFINE_MATHOP(round, round)
JANET_DEFINE_MATHOP(gamma, lgamma)
JANET_DEFINE_MATHOP(log1p, log1p)
JANET_DEFINE_MATHOP(erf, erf)
JANET_DEFINE_MATHOP(erfc, erfc)
#define JANET_DEFINE_MATH2OP(name, fop)\
static Janet janet_##name(int32_t argc, Janet *argv) {\
@@ -281,7 +267,6 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
JANET_DEFINE_MATH2OP(atan2, atan2)
JANET_DEFINE_MATH2OP(pow, pow)
JANET_DEFINE_MATH2OP(hypot, hypot)
JANET_DEFINE_MATH2OP(nextafter, nextafter)
static Janet janet_not(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
@@ -423,7 +408,7 @@ static const JanetReg math_cfuns[] = {
"math/rng", cfun_rng_make,
JDOC("(math/rng &opt seed)\n\n"
"Creates a Psuedo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. "
"The seed should be an unsigned 32 bit integer. "
"Do not use this for cryptography. Returns a core/rng abstract type.")
},
{
@@ -453,26 +438,6 @@ static const JanetReg math_cfuns[] = {
JDOC("(math/exp2 x)\n\n"
"Returns 2 to the power of x.")
},
{
"math/log1p", janet_log1p,
JDOC("(math/log1p x)\n\n"
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
},
{
"math/gamma", janet_gamma,
JDOC("(math/gamma x)\n\n"
"Returns gamma(x).")
},
{
"math/erfc", janet_erfc,
JDOC("(math/erfc x)\n\n"
"Returns the complementary error function of x.")
},
{
"math/erf", janet_erf,
JDOC("(math/erf x)\n\n"
"Returns the error function of x.")
},
{
"math/expm1", janet_expm1,
JDOC("(math/expm1 x)\n\n"
@@ -488,11 +453,6 @@ static const JanetReg math_cfuns[] = {
JDOC("(math/round x)\n\n"
"Returns the integer nearest to x.")
},
{
"math/next", janet_nextafter,
JDOC("(math/next x y)\n\n"
"Returns the next representable floating point value after x in the direction of y.")
},
{NULL, NULL, NULL}
};
@@ -509,19 +469,5 @@ void janet_lib_math(JanetTable *env) {
JDOC("The number representing positive infinity"));
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
JDOC("The number representing negative infinity"));
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
JDOC("The minimum contiguous integer representable by a 32 bit signed integer"));
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
JDOC("The maximum contiguous integer represtenable by a 32 bit signed integer"));
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
JDOC("The minimum contiguous integer representable by a double (2^53)"));
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
JDOC("The maximum contiguous integer represtenable by a double (-(2^53))"));
#ifdef NAN
janet_def(env, "math/nan", janet_wrap_number(NAN),
#else
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
#endif
JDOC("Not a number (IEEE-754 NaN)"));
#endif
}

View File

@@ -1,732 +0,0 @@
/*
* Copyright (c) 2021 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#ifdef JANET_NET
#include <math.h>
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <ws2tcpip.h>
#include <mswsock.h>
#pragma comment (lib, "Ws2_32.lib")
#pragma comment (lib, "Mswsock.lib")
#pragma comment (lib, "Advapi32.lib")
#else
#include <unistd.h>
#include <signal.h>
#include <sys/ioctl.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <netdb.h>
#include <fcntl.h>
#endif
const JanetAbstractType janet_address_type = {
"core/socket-address",
JANET_ATEND_NAME
};
#ifdef JANET_WINDOWS
#define JSOCKCLOSE(x) closesocket((SOCKET) x)
#define JSOCKDEFAULT INVALID_SOCKET
#define JSOCKVALID(x) ((x) != INVALID_SOCKET)
#define JSock SOCKET
#define JSOCKFLAGS 0
#else
#define JSOCKCLOSE(x) close(x)
#define JSOCKDEFAULT 0
#define JSOCKVALID(x) ((x) >= 0)
#define JSock int
#ifdef SOCK_CLOEXEC
#define JSOCKFLAGS SOCK_CLOEXEC
#else
#define JSOCKFLAGS 0
#endif
#endif
static JanetStream *make_stream(JSock handle, uint32_t flags);
/* We pass this flag to all send calls to prevent sigpipe */
#ifndef MSG_NOSIGNAL
#define MSG_NOSIGNAL 0
#endif
/* Make sure a socket doesn't block */
static void janet_net_socknoblock(JSock s) {
#ifdef JANET_WINDOWS
unsigned long arg = 1;
ioctlsocket(s, FIONBIO, &arg);
#else
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
int extra = O_CLOEXEC;
#else
int extra = 0;
#endif
fcntl(s, F_SETFL, fcntl(s, F_GETFL, 0) | O_NONBLOCK | extra);
#ifdef SO_NOSIGPIPE
int enable = 1;
setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int));
#endif
#endif
}
/* State machine for accepting connections. */
#ifdef JANET_WINDOWS
typedef struct {
JanetListenerState head;
WSAOVERLAPPED overlapped;
JanetFunction *function;
JanetStream *lstream;
JanetStream *astream;
char buf[1024];
} NetStateAccept;
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK: {
if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
if (state->function) janet_mark(janet_wrap_abstract(state->function));
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_COMPLETE: {
int seconds;
int bytes = sizeof(seconds);
if (NO_ERROR != getsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_CONNECT_TIME,
(char *)&seconds, &bytes)) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
(char *) & (state->lstream->handle), sizeof(SOCKET))) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
Janet streamv = janet_wrap_abstract(state->astream);
if (state->function) {
/* Schedule worker */
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
/* Now listen again for next connection */
Janet err;
if (net_sched_accept_impl(state, &err)) {
janet_cancel(s->fiber, err);
return JANET_ASYNC_STATUS_DONE;
}
} else {
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
}
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
SOCKET lsock = (SOCKET) stream->handle;
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
NetStateAccept *state = (NetStateAccept *)s;
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
memset(&state->buf, 0, 1024);
state->function = fun;
state->lstream = stream;
s->tag = &state->overlapped;
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
janet_await();
}
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
SOCKET lsock = (SOCKET) state->lstream->handle;
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
if (asock == INVALID_SOCKET) {
*err = janet_ev_lasterr();
return 1;
}
JanetStream *astream = make_stream(asock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
state->astream = astream;
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
int code = WSAGetLastError();
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
*err = janet_ev_lasterr();
return 1;
}
return 0;
}
#else
typedef struct {
JanetListenerState head;
JanetFunction *function;
} NetStateAccept;
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK: {
if (state->function) janet_mark(janet_wrap_function(state->function));
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_READ: {
JSock connfd = accept(s->stream->handle, NULL, NULL);
if (JSOCKVALID(connfd)) {
janet_net_socknoblock(connfd);
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
Janet streamv = janet_wrap_abstract(stream);
if (state->function) {
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
} else {
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
}
}
break;
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
state->function = fun;
janet_await();
}
#endif
/* Adress info */
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
int socktype = SOCK_DGRAM;
if ((NULL == stype) || !janet_cstrcmp(stype, "stream")) {
socktype = SOCK_STREAM;
} else if (janet_cstrcmp(stype, "datagram")) {
janet_panicf("expected socket type as :stream or :datagram, got %v", argv[n]);
}
return socktype;
}
/* Needs argc >= offset + 2 */
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
/* Unix socket support - not yet supported on windows. */
#ifndef JANET_WINDOWS
if (janet_keyeq(argv[offset], "unix")) {
const char *path = janet_getcstring(argv, offset + 1);
struct sockaddr_un *saddr = calloc(1, sizeof(struct sockaddr_un));
if (saddr == NULL) {
JANET_OUT_OF_MEMORY;
}
saddr->sun_family = AF_UNIX;
#ifdef JANET_LINUX
if (path[0] == '@') {
saddr->sun_path[0] = '\0';
snprintf(saddr->sun_path + 1, 107, "%s", path + 1);
} else
#endif
{
snprintf(saddr->sun_path, 108, "%s", path);
}
*is_unix = 1;
return (struct addrinfo *) saddr;
}
#endif
/* Get host and port */
const char *host = janet_getcstring(argv, offset);
const char *port;
if (janet_checkint(argv[offset + 1])) {
port = (const char *)janet_to_string(argv[offset + 1]);
} else {
port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
}
/* getaddrinfo */
struct addrinfo *ai = NULL;
struct addrinfo hints;
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
hints.ai_socktype = socktype;
hints.ai_flags = passive ? AI_PASSIVE : 0;
int status = getaddrinfo(host, port, &hints, &ai);
if (status) {
janet_panicf("could not get address info: %s", gai_strerror(status));
}
*is_unix = 0;
return ai;
}
/*
* C Funs
*/
static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
int make_arr = (argc >= 3 && janet_truthy(argv[3]));
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
#ifndef JANET_WINDOWS
/* no unix domain socket support on windows yet */
if (is_unix) {
void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un));
memcpy(abst, ai, sizeof(struct sockaddr_un));
Janet ret = janet_wrap_abstract(abst);
return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret;
}
#endif
if (make_arr) {
/* Select all */
JanetArray *arr = janet_array(10);
struct addrinfo *iter = ai;
while (NULL != iter) {
void *abst = janet_abstract(&janet_address_type, iter->ai_addrlen);
memcpy(abst, iter->ai_addr, iter->ai_addrlen);
janet_array_push(arr, janet_wrap_abstract(abst));
iter = iter->ai_next;
}
freeaddrinfo(ai);
return janet_wrap_array(arr);
} else {
/* Select first */
if (NULL == ai) {
janet_panic("no data for given address");
}
void *abst = janet_abstract(&janet_address_type, ai->ai_addrlen);
memcpy(abst, ai->ai_addr, ai->ai_addrlen);
freeaddrinfo(ai);
return janet_wrap_abstract(abst);
}
}
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
/* Create socket */
JSock sock = JSOCKDEFAULT;
void *addr = NULL;
socklen_t addrlen = 0;
#ifndef JANET_WINDOWS
if (is_unix) {
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
if (!JSOCKVALID(sock)) {
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
addr = (void *) ai;
addrlen = sizeof(struct sockaddr_un);
} else
#endif
{
struct addrinfo *rp = NULL;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
#ifdef JANET_WINDOWS
sock = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
#else
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (JSOCKVALID(sock)) {
addr = rp->ai_addr;
addrlen = (socklen_t) rp->ai_addrlen;
break;
}
}
if (NULL == addr) {
freeaddrinfo(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
}
/* Connect to socket */
#ifdef JANET_WINDOWS
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
freeaddrinfo(ai);
#else
int status = connect(sock, addr, addrlen);
if (is_unix) {
free(ai);
} else {
freeaddrinfo(ai);
}
#endif
if (status == -1) {
JSOCKCLOSE(sock);
janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
}
/* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
janet_net_socknoblock(sock);
/* Wrap socket in abstract type JanetStream */
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
return janet_wrap_abstract(stream);
}
static const char *serverify_socket(JSock sfd) {
/* Set various socket options */
int enable = 1;
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
}
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
#endif
janet_net_socknoblock(sfd);
return NULL;
}
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
/* Get host, port, and handler*/
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
JSock sfd = JSOCKDEFAULT;
#ifndef JANET_WINDOWS
if (is_unix) {
sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
if (!JSOCKVALID(sfd)) {
free(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
const char *err = serverify_socket(sfd);
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
JSOCKCLOSE(sfd);
free(ai);
if (err) {
janet_panic(err);
} else {
janet_panicf("could not bind socket: %V", janet_ev_lasterr());
}
}
free(ai);
} else
#endif
{
/* Check all addrinfos in a loop for the first that we can bind to. */
struct addrinfo *rp = NULL;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
#ifdef JANET_WINDOWS
sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
#else
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (!JSOCKVALID(sfd)) continue;
const char *err = serverify_socket(sfd);
if (NULL != err) {
JSOCKCLOSE(sfd);
continue;
}
/* Bind */
if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break;
JSOCKCLOSE(sfd);
}
freeaddrinfo(ai);
if (NULL == rp) {
janet_panic("could not bind to any sockets");
}
}
if (socktype == SOCK_DGRAM) {
/* Datagram server (UDP) */
JanetStream *stream = make_stream(sfd, JANET_STREAM_UDPSERVER | JANET_STREAM_READABLE);
return janet_wrap_abstract(stream);
} else {
/* Stream server (TCP) */
/* listen */
int status = listen(sfd, 1024);
if (status) {
JSOCKCLOSE(sfd);
janet_panicf("could not listen on file descriptor: %V", janet_ev_lasterr());
}
/* Put sfd on our loop */
JanetStream *stream = make_stream(sfd, JANET_STREAM_ACCEPTABLE);
return janet_wrap_abstract(stream);
}
}
static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
JanetFunction *fun = janet_getfunction(argv, 1);
janet_sched_accept(stream, fun);
}
static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
double to = janet_optnumber(argv, argc, 1, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_sched_accept(stream, NULL);
}
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (janet_keyeq(argv[1], "all")) {
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvchunk(stream, buffer, INT32_MAX, MSG_NOSIGNAL);
} else {
int32_t n = janet_getnat(argv, 1);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
}
janet_await();
}
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 2);
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
double to = janet_optnumber(argv, argc, 2, INFINITY);
if (janet_checktype(argv[1], JANET_BUFFER)) {
if (to != INFINITY) janet_addtimeout(to);
janet_ev_send_buffer(stream, janet_getbuffer(argv, 1), MSG_NOSIGNAL);
} else {
JanetByteView bytes = janet_getbytes(argv, 1);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
}
janet_await();
}
static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
void *dest = janet_getabstract(argv, 1, &janet_address_type);
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (janet_checktype(argv[2], JANET_BUFFER)) {
if (to != INFINITY) janet_addtimeout(to);
janet_ev_sendto_buffer(stream, janet_getbuffer(argv, 2), dest, MSG_NOSIGNAL);
} else {
JanetByteView bytes = janet_getbytes(argv, 2);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
}
janet_await();
}
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
/* Toggle no delay flag */
int flag = 1;
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
flag = 0;
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
return argv[0];
}
static const JanetMethod net_stream_methods[] = {
{"chunk", cfun_stream_chunk},
{"close", janet_cfun_stream_close},
{"read", cfun_stream_read},
{"write", cfun_stream_write},
{"flush", cfun_stream_flush},
{"accept", cfun_stream_accept},
{"accept-loop", cfun_stream_accept_loop},
{"send-to", cfun_stream_send_to},
{"recv-from", cfun_stream_recv_from},
{"recv-from", cfun_stream_recv_from},
{"evread", janet_cfun_stream_read},
{"evchunk", janet_cfun_stream_chunk},
{"evwrite", janet_cfun_stream_write},
{NULL, NULL}
};
static JanetStream *make_stream(JSock handle, uint32_t flags) {
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
}
static const JanetReg net_cfuns[] = {
{
"net/address", cfun_net_sockaddr,
JDOC("(net/address host port &opt type)\n\n"
"Look up the connection information for a given hostname, port, and connection type. Returns "
"a handle that can be used to send datagrams over network without establishing a connection. "
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
"given in the port argument. On Linux, abstract "
"unix domain sockets are specified with a leading '@' character in port.")
},
{
"net/listen", cfun_net_listen,
JDOC("(net/listen host port &opt type)\n\n"
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.")
},
{
"net/accept", cfun_stream_accept,
JDOC("(net/accept stream &opt timeout)\n\n"
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a new duplex stream which represents a connection to the client.")
},
{
"net/accept-loop", cfun_stream_accept_loop,
JDOC("(net/accept-loop stream handler)\n\n"
"Shorthand for running a server stream that will continuously accept new connections. "
"Blocks the current fiber until the stream is closed, and will return the stream.")
},
{
"net/read", cfun_stream_read,
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
},
{
"net/chunk", cfun_stream_chunk,
JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n"
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
"Takes an optional timeout in seconds, after which will return nil.")
},
{
"net/write", cfun_stream_write,
JDOC("(net/write stream data &opt timeout)\n\n"
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.")
},
{
"net/send-to", cfun_stream_send_to,
JDOC("(net/send-to stream dest data &opt timeout)\n\n"
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
"Takes an optional timeout in seconds, after which will return nil. "
"Returns stream.")
},
{
"net/recv-from", cfun_stream_recv_from,
JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n"
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.")
},
{
"net/flush", cfun_stream_flush,
JDOC("(net/flush stream)\n\n"
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
"Use this to make sure data is sent without delay. Returns stream.")
},
{
"net/connect", cfun_net_connect,
JDOC("(net/connect host port &opt type)\n\n"
"Open a connection to communicate with a server. Returns a duplex stream "
"that can be used to communicate with the server. Type is an optional keyword "
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
},
{NULL, NULL, NULL}
};
void janet_lib_net(JanetTable *env) {
janet_core_cfuns(env, NULL, net_cfuns);
}
void janet_net_init(void) {
#ifdef JANET_WINDOWS
WSADATA wsaData;
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
#endif
}
void janet_net_deinit(void) {
#ifdef JANET_WINDOWS
WSACleanup();
#endif
}
#endif

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -26,9 +26,6 @@
#include "util.h"
#endif
#define JANET_PARSER_DEAD 0x1
#define JANET_PARSER_GENERATED_ERROR 0x2
/* Check if a character is whitespace */
static int is_whitespace(uint8_t c) {
return c == ' '
@@ -115,6 +112,8 @@ struct JanetParseState {
Consumer consumer;
};
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
/* Define a stack on the main parser struct */
#define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
static void NAME(JanetParser *p, T x) { \
@@ -167,22 +166,15 @@ static void popstate(JanetParser *p, Janet val) {
for (;;) {
JanetParseState top = p->states[--p->statecount];
JanetParseState *newtop = p->states + p->statecount - 1;
/* Source mapping info */
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
}
if (newtop->flags & PFLAG_CONTAINER) {
/* Source mapping info */
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
}
newtop->argn++;
/* Keep track of number of values in the root state */
if (p->statecount == 1) {
p->pending++;
/* Root items are always wrapped in a tuple for source map info. */
const Janet *tup = janet_tuple_n(&val, 1);
janet_tuple_sm_line(tup) = (int32_t) top.line;
janet_tuple_sm_column(tup) = (int32_t) top.column;
val = janet_wrap_tuple(tup);
}
if (p->statecount == 1) p->pending++;
push_arg(p, val);
return;
} else if (newtop->flags & PFLAG_READERMAC) {
@@ -193,8 +185,12 @@ static void popstate(JanetParser *p, Janet val) {
(c == ',') ? "unquote" :
(c == ';') ? "splice" :
(c == '|') ? "short-fn" :
(c == '~') ? "quasiquote" : "<unknown>";
t[0] = janet_csymbolv(which);
(c == '~') ? "quasiquote" : NULL;
if (!which) {
t[0] = p->args[--p->argcount];
} else {
t[0] = janet_csymbolv(which);
}
t[1] = val;
/* Quote source mapping info */
janet_tuple_sm_line(t) = (int32_t) newtop->line;
@@ -211,8 +207,6 @@ static int checkescape(uint8_t c) {
default:
return -1;
case 'x':
case 'u':
case 'U':
return 1;
case 'n':
return '\n';
@@ -240,24 +234,6 @@ static int checkescape(uint8_t c) {
/* Forward declare */
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
static void write_codepoint(JanetParser *p, int32_t codepoint) {
if (codepoint <= 0x7F) {
push_buf(p, (uint8_t) codepoint);
} else if (codepoint <= 0x7FF) {
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
} else if (codepoint <= 0xFFFF) {
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
} else {
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
}
}
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
int digit = to_hex(c);
if (digit < 0) {
@@ -267,27 +243,7 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
state->argn = (state->argn << 4) + digit;
state->counter--;
if (!state->counter) {
push_buf(p, (uint8_t)(state->argn & 0xFF));
state->argn = 0;
state->consumer = stringchar;
}
return 1;
}
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
int digit = to_hex(c);
if (digit < 0) {
p->error = "invalid hex digit in unicode escape";
return 1;
}
state->argn = (state->argn << 4) + digit;
state->counter--;
if (!state->counter) {
if (state->argn > 0x10FFFF) {
p->error = "invalid unicode codepoint";
return 1;
}
write_codepoint(p, state->argn);
push_buf(p, (state->argn & 0xFF));
state->argn = 0;
state->consumer = stringchar;
}
@@ -304,10 +260,6 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
state->counter = 2;
state->argn = 0;
state->consumer = escapeh;
} else if (c == 'u' || c == 'U') {
state->counter = c == 'u' ? 4 : 6;
state->argn = 0;
state->consumer = escapeu;
} else {
push_buf(p, (uint8_t) e);
state->consumer = stringchar;
@@ -320,48 +272,11 @@ static int stringend(JanetParser *p, JanetParseState *state) {
uint8_t *bufstart = p->buf;
int32_t buflen = (int32_t) p->bufcount;
if (state->flags & PFLAG_LONGSTRING) {
/* Post process to remove leading whitespace */
JanetParseState top = p->states[p->statecount - 1];
int32_t indent_col = (int32_t) top.column - 1;
uint8_t *r = bufstart, *end = r + buflen;
/* Check if there are any characters before the start column -
* if so, do not reindent. */
int reindent = 1;
while (reindent && (r < end)) {
if (*r++ == '\n') {
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++) {
if (*r != ' ') {
reindent = 0;
break;
}
}
}
/* Check for leading newline character so we can remove it */
if (bufstart[0] == '\n') {
bufstart++;
buflen--;
}
/* Now reindent if able to, otherwise just drop leading newline. */
if (!reindent) {
if (buflen > 0 && bufstart[0] == '\n') {
buflen--;
bufstart++;
}
} else {
uint8_t *w = bufstart;
r = bufstart;
while (r < end) {
if (*r == '\n') {
if (r == bufstart) {
/* Skip leading newline */
r++;
} else {
*w++ = *r++;
}
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
} else {
*w++ = *r++;
}
}
buflen = (int32_t)(w - bufstart);
}
/* Check for trailing newline character so we can remove it */
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
buflen--;
}
@@ -411,6 +326,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
Janet ret;
double numval;
int32_t blen;
int prefix_symbol = 0;
if (is_symbol_char(c)) {
push_buf(p, (uint8_t) c);
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
@@ -448,10 +364,20 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
}
ret = janet_symbolv(p->buf, blen);
prefix_symbol = c == '"' || c == '`' || c == '[' || c == '(' || c == '{';
}
}
p->bufcount = 0;
popstate(p, ret);
if (prefix_symbol) {
push_arg(p, ret);
/* Set current state to a different state */
JanetParseState newState = {0};
newState.flags = PFLAG_READERMAC;
newState.consumer = root;
*state = newState;
} else {
popstate(p, ret);
}
return 0;
}
@@ -484,23 +410,21 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
static Janet close_struct(JanetParser *p, JanetParseState *state) {
JanetKV *st = janet_struct_begin(state->argn >> 1);
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
Janet key = p->args[i];
Janet value = p->args[i + 1];
for (int32_t i = state->argn; i > 0; i -= 2) {
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
janet_struct_put(st, key, value);
}
p->argcount -= state->argn;
return janet_wrap_struct(janet_struct_end(st));
}
static Janet close_table(JanetParser *p, JanetParseState *state) {
JanetTable *table = janet_table(state->argn >> 1);
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
Janet key = p->args[i];
Janet value = p->args[i + 1];
for (int32_t i = state->argn; i > 0; i -= 2) {
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
janet_table_put(table, key, value);
}
p->argcount -= state->argn;
return janet_wrap_table(table);
}
@@ -548,8 +472,6 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
}
}
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
p->statecount--;
@@ -684,30 +606,11 @@ void janet_parser_eof(JanetParser *parser) {
size_t oldline = parser->line;
janet_parser_consume(parser, '\n');
if (parser->statecount > 1) {
JanetParseState *s = parser->states + (parser->statecount - 1);
JanetBuffer *buffer = janet_buffer(40);
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
if (s->flags & PFLAG_PARENS) {
janet_buffer_push_u8(buffer, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
janet_buffer_push_u8(buffer, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
janet_buffer_push_u8(buffer, '{');
} else if (s->flags & PFLAG_STRING) {
janet_buffer_push_u8(buffer, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
janet_buffer_push_u8(buffer, '`');
}
}
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR;
parser->error = "unexpected end of source";
}
parser->line = oldline;
parser->column = oldcolumn;
parser->flag |= JANET_PARSER_DEAD;
parser->flag = 1;
}
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
@@ -729,7 +632,6 @@ const char *janet_parser_error(JanetParser *parser) {
if (status == JANET_PARSE_ERROR) {
const char *e = parser->error;
parser->error = NULL;
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
janet_parser_flush(parser);
return e;
}
@@ -737,19 +639,6 @@ const char *janet_parser_error(JanetParser *parser) {
}
Janet janet_parser_produce(JanetParser *parser) {
Janet ret;
size_t i;
if (parser->pending == 0) return janet_wrap_nil();
ret = janet_unwrap_tuple(parser->args[0])[0];
for (i = 1; i < parser->argcount; i++) {
parser->args[i - 1] = parser->args[i];
}
parser->pending--;
parser->argcount--;
return ret;
}
Janet janet_parser_produce_wrapped(JanetParser *parser) {
Janet ret;
size_t i;
if (parser->pending == 0) return janet_wrap_nil();
@@ -846,9 +735,6 @@ static int parsermark(void *p, size_t size) {
for (i = 0; i < parser->argcount; i++) {
janet_mark(parser->args[i]);
}
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
janet_mark(janet_wrap_string((const uint8_t *) parser->error));
}
return 0;
}
@@ -860,21 +746,13 @@ static int parsergc(void *p, size_t size) {
}
static int parserget(void *p, Janet key, Janet *out);
static Janet parsernext(void *p, Janet key);
const JanetAbstractType janet_parser_type = {
"core/parser",
parsergc,
parsermark,
parserget,
NULL, /* put */
NULL, /* marshal */
NULL, /* unmarshal */
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
parsernext,
JANET_ATEND_NEXT
JANET_ATEND_GET
};
/* C Function parser */
@@ -930,13 +808,8 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
if (s->flags & PFLAG_COMMENT) s--;
if (s->flags & PFLAG_CONTAINER) {
s->argn++;
if (p->statecount == 1) {
p->pending++;
Janet tup = janet_wrap_tuple(janet_tuple_n(argv + 1, 1));
push_arg(p, tup);
} else {
push_arg(p, argv[1]);
}
if (p->statecount == 1) p->pending++;
push_arg(p, argv[1]);
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
const uint8_t *str = janet_to_string(argv[1]);
int32_t slen = janet_string_length(str);
@@ -996,22 +869,14 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *err = janet_parser_error(p);
if (err) {
return (p->flag & JANET_PARSER_GENERATED_ERROR)
? janet_wrap_string((const uint8_t *) err)
: janet_cstringv(err);
}
if (err) return janet_cstringv(err);
return janet_wrap_nil();
}
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc == 2 && janet_truthy(argv[1])) {
return janet_parser_produce_wrapped(p);
} else {
return janet_parser_produce(p);
}
return janet_parser_produce(p);
}
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
@@ -1022,20 +887,8 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc > 1) {
int32_t line = janet_getinteger(argv, 1);
if (line < 1)
janet_panicf("invalid line number %d", line);
p->line = (size_t) line;
}
if (argc > 2) {
int32_t column = janet_getinteger(argv, 2);
if (column < 0)
janet_panicf("invalid column number %d", column);
p->column = (size_t) column;
}
Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer(p->line);
tup[1] = janet_wrap_integer(p->column);
@@ -1089,6 +942,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
type = (c == '\'') ? "quote" :
(c == ',') ? "unquote" :
(c == ';') ? "splice" :
(c == '|') ? "short-fn" :
(c == '~') ? "quasiquote" : "<reader>";
} else {
type = "root";
@@ -1115,30 +969,31 @@ struct ParserStateGetter {
};
static Janet parser_state_delimiters(const JanetParser *_p) {
JanetParser *p = (JanetParser *)_p;
JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_clone(_p, clone);
size_t i;
const uint8_t *str;
size_t oldcount;
oldcount = p->bufcount;
for (i = 0; i < p->statecount; i++) {
JanetParseState *s = p->states + i;
oldcount = clone->bufcount;
for (i = 0; i < clone->statecount; i++) {
JanetParseState *s = clone->states + i;
if (s->flags & PFLAG_PARENS) {
push_buf(p, '(');
push_buf(clone, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
push_buf(p, '[');
push_buf(clone, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
push_buf(p, '{');
push_buf(clone, '{');
} else if (s->flags & PFLAG_STRING) {
push_buf(p, '"');
push_buf(clone, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
push_buf(p, '`');
push_buf(clone, '`');
}
}
}
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
clone->bufcount = oldcount;
return janet_wrap_string(str);
}
@@ -1220,17 +1075,12 @@ static int parserget(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), parser_methods, out);
}
static Janet parsernext(void *p, Janet key) {
(void) p;
return janet_nextmethod(parser_methods, key);
}
static const JanetReg parse_cfuns[] = {
{
"parser/new", cfun_parse_parser,
JDOC("(parser/new)\n\n"
"Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of values.")
"that can receive bytes, and generate a stream of janet values.")
},
{
"parser/clone", cfun_parse_clone,
@@ -1246,12 +1096,10 @@ static const JanetReg parse_cfuns[] = {
},
{
"parser/produce", cfun_parse_produce,
JDOC("(parser/produce parser &opt wrap)\n\n"
JDOC("(parser/produce parser)\n\n"
"Dequeue the next value in the parse queue. Will return nil if "
"no parsed values are in the queue, otherwise will dequeue the "
"next value. If `wrap` is truthy, will return a 1-element tuple that "
"wraps the result. This tuple can be used for source-mapping "
"purposes.")
"next value.")
},
{
"parser/consume", cfun_parse_consume,
@@ -1278,9 +1126,9 @@ static const JanetReg parse_cfuns[] = {
JDOC("(parser/status parser)\n\n"
"Gets the current status of the parser state machine. The status will "
"be one of:\n\n"
"* :pending - a value is being parsed.\n\n"
"* :error - a parsing error was encountered.\n\n"
"* :root - the parser can either read more values or safely terminate.")
"\t:pending - a value is being parsed.\n"
"\t:error - a parsing error was encountered.\n"
"\t:root - the parser can either read more values or safely terminate.")
},
{
"parser/flush", cfun_parse_flush,
@@ -1294,19 +1142,17 @@ static const JanetReg parse_cfuns[] = {
JDOC("(parser/state parser &opt key)\n\n"
"Returns a representation of the internal state of the parser. If a key is passed, "
"only that information about the state is returned. Allowed keys are:\n\n"
"* :delimiters - Each byte in the string represents a nested data structure. For example, "
"\t:delimiters - Each byte in the string represents a nested data structure. For example, "
"if the parser state is '([\"', then the parser is in the middle of parsing a "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
"* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt."
"\t:frames - Each table in the array represents a 'frame' in the parser state. Frames "
"contain information about the start of the expression being parsed as well as the "
"type of that expression and some type-specific information.")
},
{
"parser/where", cfun_parse_where,
JDOC("(parser/where parser &opt line col)\n\n"
"Returns the current line number and column of the parser's internal state. If line is "
"provided, the current line number of the parser is first set to that value. If column is "
"also provided, the current column number of the parser is also first set to that value.")
JDOC("(parser/where parser)\n\n"
"Returns the current line number and column of the parser's internal state.")
},
{
"parser/eof", cfun_parse_eof,

View File

@@ -44,13 +44,9 @@ typedef struct {
JanetArray *captures;
JanetBuffer *scratch;
JanetBuffer *tags;
JanetArray *tagged_captures;
const Janet *extrav;
int32_t *linemap;
int32_t extrac;
int32_t depth;
int32_t linemaplen;
int32_t has_backref;
enum {
PEG_MODE_NORMAL,
PEG_MODE_ACCUMULATE
@@ -62,7 +58,6 @@ typedef struct {
* if one branch fails and try a new branch. */
typedef struct {
int32_t cap;
int32_t tcap;
int32_t scratch;
} CapState;
@@ -71,7 +66,6 @@ static CapState cap_save(PegState *s) {
CapState cs;
cs.scratch = s->scratch->count;
cs.cap = s->captures->count;
cs.tcap = s->tagged_captures->count;
return cs;
}
@@ -79,15 +73,7 @@ static CapState cap_save(PegState *s) {
static void cap_load(PegState *s, CapState cs) {
s->scratch->count = cs.scratch;
s->captures->count = cs.cap;
s->tags->count = cs.tcap;
s->tagged_captures->count = cs.tcap;
}
/* Load a saved capture state in the case of success. Keeps
* tagged captures around for backref. */
static void cap_load_keept(PegState *s, CapState cs) {
s->scratch->count = cs.scratch;
s->captures->count = cs.cap;
s->tags->count = cs.cap;
}
/* Add a capture */
@@ -95,72 +81,12 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
if (s->mode == PEG_MODE_ACCUMULATE) {
janet_to_string_b(s->scratch, capture);
}
if (s->mode == PEG_MODE_NORMAL) {
if (tag || s->mode == PEG_MODE_NORMAL) {
janet_array_push(s->captures, capture);
}
if (s->has_backref) {
janet_array_push(s->tagged_captures, capture);
janet_buffer_push_u8(s->tags, tag);
}
}
/* Lazily generate line map to get line and column information for PegState.
* line and column are 1-indexed. */
typedef struct {
int32_t line;
int32_t col;
} LineCol;
static LineCol get_linecol_from_position(PegState *s, int32_t position) {
/* Generate if not made yet */
if (s->linemaplen < 0) {
int32_t newline_count = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
if (*c == '\n') newline_count++;
}
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
size_t index = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
}
s->linemaplen = newline_count;
s->linemap = mem;
}
/* Do binary search for line. Slightly modified from classic binary search:
* - if we find that our current character is a line break, just return immediately.
* a newline character is consider to be on the same line as the character before
* (\n is line terminator, not line separator).
* - in the not-found case, we still want to find the greatest-indexed newline that
* is before position. we use that to calcuate the line and column.
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
* are on the first line and our column is position + 1. */
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
int32_t lo = 0; /* lo is less than or equal to the actual line */
LineCol ret;
while (lo + 1 < hi) {
int32_t mid = lo + (hi - lo) / 2;
if (s->linemap[mid] >= position) {
hi = mid;
} else {
lo = mid;
}
}
/* first line case */
if (s->linemaplen == 0 || (lo == 0 && s->linemap[0] >= position)) {
ret.line = 1;
ret.col = position + 1;
} else {
ret.line = lo + 2;
ret.col = position - s->linemap[lo];
}
return ret;
}
/* Convert a uint64_t to a int64_t by wrapping to a maximum number of bytes */
static int64_t peg_convert_u64_s64(uint64_t from, int width) {
int shift = 8 * (8 - width);
return ((int64_t)(from << shift)) >> shift;
}
/* Prevent stack overflow */
#define down1(s) do { \
if (0 == --((s)->depth)) janet_panic("peg/match recursed too deeply"); \
@@ -224,7 +150,6 @@ tail:
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
up1(s);
text -= ((int32_t *)rule)[1];
return result ? text : NULL;
}
@@ -280,29 +205,6 @@ tail:
return (result) ? NULL : text;
}
case RULE_THRU:
case RULE_TO: {
const uint32_t *rule_a = s->bytecode + rule[1];
const uint8_t *next_text;
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
CapState cs2 = cap_save(s);
next_text = peg_rule(s, rule_a, text);
if (next_text) {
if (rule[0] == RULE_TO) cap_load(s, cs2);
break;
}
text++;
}
up1(s);
if (text > s->text_end) {
cap_load(s, cs);
return NULL;
}
return rule[0] == RULE_TO ? text : next_text;
}
case RULE_BETWEEN: {
uint32_t lo = rule[1];
uint32_t hi = rule[2];
@@ -336,7 +238,7 @@ tail:
uint32_t tag = rule[2];
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
if (s->tags->data[i] == search) {
pushcap(s, s->tagged_captures->data[i], tag);
pushcap(s, s->captures->data[i], tag);
return text;
}
}
@@ -348,18 +250,6 @@ tail:
return text;
}
case RULE_LINE: {
LineCol lc = get_linecol_from_position(s, (int32_t)(text - s->text_start));
pushcap(s, janet_wrap_number((double)(lc.line)), rule[1]);
return text;
}
case RULE_COLUMN: {
LineCol lc = get_linecol_from_position(s, (int32_t)(text - s->text_start));
pushcap(s, janet_wrap_number((double)(lc.col)), rule[1]);
return text;
}
case RULE_ARGUMENT: {
int32_t index = ((int32_t *)rule)[1];
Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index];
@@ -373,15 +263,15 @@ tail:
}
case RULE_CAPTURE: {
uint32_t tag = rule[2];
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
/* Specialized pushcap - avoid intermediate string creation */
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
if (!tag && s->mode == PEG_MODE_ACCUMULATE) {
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
} else {
uint32_t tag = rule[2];
pushcap(s, janet_stringv(text, (int32_t)(result - text)), tag);
}
return result;
@@ -403,7 +293,7 @@ tail:
if (!result) return NULL;
Janet cap = janet_stringv(s->scratch->data + cs.scratch,
s->scratch->count - cs.scratch);
cap_load_keept(s, cs);
cap_load(s, cs);
pushcap(s, cap, tag);
return result;
}
@@ -434,7 +324,7 @@ tail:
s->captures->data + cs.cap,
sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
cap_load_keept(s, cs);
cap_load(s, cs);
pushcap(s, janet_wrap_array(sub_captures), tag);
return result;
}
@@ -479,7 +369,7 @@ tail:
s->captures->data + cs.cap);
break;
}
cap_load_keept(s, cs);
cap_load(s, cs);
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
pushcap(s, cap, tag);
return result;
@@ -500,8 +390,8 @@ tail:
} else {
/* Throw generic error */
int32_t start = (int32_t)(text - s->text_start);
LineCol lc = get_linecol_from_position(s, start);
janet_panicf("match error at line %d, column %d", lc.line, lc.col);
int32_t end = (int32_t)(result - s->text_start);
janet_panicf("match error in range (%d:%d)", start, end);
}
return NULL;
}
@@ -510,7 +400,7 @@ tail:
uint32_t search = rule[1];
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
if (s->tags->data[i] == search) {
Janet capture = s->tagged_captures->data[i];
Janet capture = s->captures->data[i];
if (!janet_checktype(capture, JANET_STRING))
return NULL;
const uint8_t *bytes = janet_unwrap_string(capture);
@@ -523,103 +413,6 @@ tail:
return NULL;
}
case RULE_LENPREFIX: {
int oldmode = s->mode;
s->mode = PEG_MODE_NORMAL;
const uint8_t *next_text;
CapState cs = cap_save(s);
down1(s);
next_text = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (NULL == next_text) return NULL;
s->mode = oldmode;
int32_t num_sub_captures = s->captures->count - cs.cap;
Janet lencap;
if (num_sub_captures <= 0 ||
(lencap = s->captures->data[cs.cap], !janet_checkint(lencap))) {
cap_load(s, cs);
return NULL;
}
int32_t nrep = janet_unwrap_integer(lencap);
/* drop captures from len pattern */
cap_load(s, cs);
for (int32_t i = 0; i < nrep; i++) {
down1(s);
next_text = peg_rule(s, s->bytecode + rule[2], next_text);
up1(s);
if (NULL == next_text) {
cap_load(s, cs);
return NULL;
}
}
return next_text;
}
case RULE_READINT: {
uint32_t tag = rule[2];
uint32_t signedness = rule[1] & 0x10;
uint32_t endianess = rule[1] & 0x20;
int width = (int)(rule[1] & 0xF);
if (text + width > s->text_end) return NULL;
uint64_t accum = 0;
if (endianess) {
/* BE */
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
} else {
/* LE */
for (int i = width - 1; i >= 0; i--) accum = (accum << 8) | text[i];
}
Janet capture_value;
/* We can only parse integeres of greater than 6 bytes reliable if int-types are enabled.
* Otherwise, we may lose precision, so 6 is the maximum size when int-types are disabled. */
#ifdef JANET_INT_TYPES
if (width > 6) {
if (signedness) {
capture_value = janet_wrap_s64(peg_convert_u64_s64(accum, width));
} else {
capture_value = janet_wrap_u64(accum);
}
} else
#endif
{
double double_value;
if (signedness) {
double_value = (double)(peg_convert_u64_s64(accum, width));
} else {
double_value = (double)accum;
}
capture_value = janet_wrap_number(double_value);
}
pushcap(s, capture_value, tag);
return text + width;
}
case RULE_UNREF: {
int32_t tcap = s->tags->count;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
int32_t final_tcap = s->tags->count;
/* Truncate tagged captures to not include items of the given tag */
int32_t w = tcap;
/* If no tag is given, drop ALL tagged captures */
if (rule[2]) {
for (int32_t i = tcap; i < final_tcap; i++) {
if (s->tags->data[i] != (0xFF & rule[2])) {
s->tags->data[w] = s->tags->data[i];
s->tagged_captures->data[w] = s->tagged_captures->data[i];
w++;
}
}
}
s->tags->count = w;
s->tagged_captures->count = w;
return result;
}
}
}
@@ -636,7 +429,6 @@ typedef struct {
Janet form;
int depth;
uint32_t nexttag;
int has_backref;
} Builder;
/* Forward declaration to allow recursion */
@@ -865,9 +657,6 @@ static void spec_if(Builder *b, int32_t argc, const Janet *argv) {
static void spec_ifnot(Builder *b, int32_t argc, const Janet *argv) {
spec_branch(b, argc, argv, RULE_IFNOT);
}
static void spec_lenprefix(Builder *b, int32_t argc, const Janet *argv) {
spec_branch(b, argc, argv, RULE_LENPREFIX);
}
static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 3);
@@ -935,19 +724,7 @@ static void spec_not(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_NOT);
}
static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
if (argc == 0) {
Reserve r = reserve(b, 2);
uint32_t rule = peg_compile1(b, janet_wrap_number(0));
emit_1(r, RULE_ERROR, rule);
} else {
spec_onerule(b, argc, argv, RULE_ERROR);
}
}
static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_TO);
}
static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_THRU);
spec_onerule(b, argc, argv, RULE_ERROR);
}
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_DROP);
@@ -971,16 +748,12 @@ static void spec_accumulate(Builder *b, int32_t argc, const Janet *argv) {
static void spec_group(Builder *b, int32_t argc, const Janet *argv) {
spec_cap1(b, argc, argv, RULE_GROUP);
}
static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
spec_cap1(b, argc, argv, RULE_UNREF);
}
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 1, 2);
Reserve r = reserve(b, 3);
uint32_t search = emit_tag(b, argv[0]);
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
b->has_backref = 1;
emit_2(r, RULE_GETTAG, search, tag);
}
@@ -995,15 +768,8 @@ static void spec_tag1(Builder *b, int32_t argc, const Janet *argv, uint32_t op)
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
spec_tag1(b, argc, argv, RULE_POSITION);
}
static void spec_line(Builder *b, int32_t argc, const Janet *argv) {
spec_tag1(b, argc, argv, RULE_LINE);
}
static void spec_column(Builder *b, int32_t argc, const Janet *argv) {
spec_tag1(b, argc, argv, RULE_COLUMN);
}
static void spec_backmatch(Builder *b, int32_t argc, const Janet *argv) {
b->has_backref = 1;
spec_tag1(b, argc, argv, RULE_BACKMATCH);
}
@@ -1045,36 +811,6 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
#ifdef JANET_INT_TYPES
#define JANET_MAX_READINT_WIDTH 8
#else
#define JANET_MAX_READINT_WIDTH 6
#endif
static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
peg_arity(b, argc, 1, 2);
Reserve r = reserve(b, 3);
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
int32_t width = peg_getnat(b, argv[0]);
if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
}
emit_2(r, RULE_READINT, mask | ((uint32_t) width), tag);
}
static void spec_uint_le(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x0u);
}
static void spec_int_le(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x10u);
}
static void spec_uint_be(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x20u);
}
static void spec_int_be(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x30u);
}
/* Special compiler form */
typedef void (*Special)(Builder *b, int32_t argc, const Janet *argv);
typedef struct {
@@ -1105,17 +841,12 @@ static const SpecialPair peg_specials[] = {
{"capture", spec_capture},
{"choice", spec_choice},
{"cmt", spec_matchtime},
{"column", spec_column},
{"constant", spec_constant},
{"drop", spec_drop},
{"error", spec_error},
{"group", spec_group},
{"if", spec_if},
{"if-not", spec_ifnot},
{"int", spec_int_le},
{"int-be", spec_int_be},
{"lenprefix", spec_lenprefix},
{"line", spec_line},
{"look", spec_look},
{"not", spec_not},
{"opt", spec_opt},
@@ -1127,11 +858,6 @@ static const SpecialPair peg_specials[] = {
{"sequence", spec_sequence},
{"set", spec_set},
{"some", spec_some},
{"thru", spec_thru},
{"to", spec_to},
{"uint", spec_uint_le},
{"uint-be", spec_uint_be},
{"unref", spec_unref},
};
/* Compile a janet value into a rule and return the rule index. */
@@ -1234,14 +960,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
const Janet *tup = janet_unwrap_tuple(peg);
int32_t len = janet_tuple_length(tup);
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
if (janet_checkint(tup[0])) {
int32_t n = janet_unwrap_integer(tup[0]);
if (n < 0) {
peg_panicf(b, "expected non-negative integer, got %d", n);
}
spec_repeat(b, len, tup);
break;
}
if (!janet_checktype(tup[0], JANET_SYMBOL))
peg_panicf(b, "expected grammar command, found %v", tup[0]);
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
@@ -1341,7 +1059,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
}
/* verify peg bytecode */
int32_t has_backref = 0;
uint32_t i = 0;
while (i < blen) {
uint32_t instr = bytecode[i];
@@ -1355,15 +1072,9 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_NOTNCHAR:
case RULE_RANGE:
case RULE_POSITION:
case RULE_LINE:
case RULE_COLUMN:
/* [1 word] */
i += 2;
break;
case RULE_BACKMATCH:
/* [1 word] */
i += 2;
has_backref = 1;
break;
case RULE_SET:
/* [8 words] */
@@ -1389,7 +1100,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_IF:
case RULE_IFNOT:
case RULE_LENPREFIX:
/* [rule_a, rule_b (b if not a)] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
@@ -1404,13 +1114,9 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 4;
break;
case RULE_ARGUMENT:
/* [searchtag, tag] */
i += 3;
break;
case RULE_GETTAG:
/* [searchtag, tag] */
i += 3;
has_backref = 1;
break;
case RULE_CONSTANT:
/* [constant, tag] */
@@ -1420,7 +1126,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_ACCUMULATE:
case RULE_GROUP:
case RULE_CAPTURE:
case RULE_UNREF:
/* [rule, tag] */
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
@@ -1437,18 +1142,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_ERROR:
case RULE_DROP:
case RULE_NOT:
case RULE_TO:
case RULE_THRU:
/* [rule] */
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 2;
break;
case RULE_READINT:
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
default:
goto bad;
}
@@ -1465,7 +1163,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
/* Good return */
peg->bytecode = bytecode;
peg->constants = constants;
peg->has_backref = has_backref;
free(op_flags);
return peg;
@@ -1475,21 +1172,16 @@ bad:
}
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
static Janet peg_next(void *p, Janet key);
const JanetAbstractType janet_peg_type = {
"core/peg",
NULL,
peg_mark,
cfun_peg_getter,
NULL, /* put */
NULL,
peg_marshal,
peg_unmarshal,
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
peg_next,
JANET_ATEND_NEXT
JANET_ATEND_UNMARSHAL
};
/* Convert Builder to JanetPeg (Janet Abstract Value) */
@@ -1507,7 +1199,6 @@ static JanetPeg *make_peg(Builder *b) {
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
safe_memcpy(peg->constants, b->constants, constants_size);
peg->bytecode_len = janet_v_count(b->bytecode);
peg->has_backref = b->has_backref;
return peg;
}
@@ -1515,20 +1206,13 @@ static JanetPeg *make_peg(Builder *b) {
static JanetPeg *compile_peg(Janet x) {
Builder builder;
builder.grammar = janet_table(0);
builder.default_grammar = NULL;
{
Janet default_grammarv = janet_dyn("peg-grammar");
if (janet_checktype(default_grammarv, JANET_TABLE)) {
builder.default_grammar = janet_unwrap_table(default_grammarv);
}
}
builder.default_grammar = janet_get_core_table("default-peg-grammar");
builder.tags = janet_table(0);
builder.constants = NULL;
builder.bytecode = NULL;
builder.nexttag = 1;
builder.form = x;
builder.depth = JANET_RECURSION_GUARD;
builder.has_backref = 0;
peg_compile1(&builder, x);
JanetPeg *peg = make_peg(&builder);
builder_cleanup(&builder);
@@ -1545,145 +1229,47 @@ static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
return janet_wrap_abstract(peg);
}
/* Common data for peg cfunctions */
typedef struct {
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
JanetPeg *peg;
PegState s;
JanetByteView bytes;
JanetByteView repl;
int32_t start;
} PegCall;
/* Initialize state for peg cfunctions */
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, get_replace, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
ret.peg = janet_unwrap_abstract(argv[0]);
peg = janet_unwrap_abstract(argv[0]);
} else {
ret.peg = compile_peg(argv[0]);
peg = compile_peg(argv[0]);
}
if (get_replace) {
ret.repl = janet_getbytes(argv, 1);
ret.bytes = janet_getbytes(argv, 2);
JanetByteView bytes = janet_getbytes(argv, 1);
int32_t start;
PegState s;
if (argc > 2) {
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
s.extrac = argc - 3;
s.extrav = janet_tuple_n(argv + 3, argc - 3);
} else {
ret.bytes = janet_getbytes(argv, 1);
start = 0;
s.extrac = 0;
s.extrav = NULL;
}
if (argc > min) {
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
ret.s.extrac = argc - min - 1;
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
} else {
ret.start = 0;
ret.s.extrac = 0;
ret.s.extrav = NULL;
}
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.tagged_captures = janet_array(0);
ret.s.scratch = janet_buffer(10);
ret.s.tags = janet_buffer(10);
ret.s.constants = ret.peg->constants;
ret.s.bytecode = ret.peg->bytecode;
ret.s.linemap = NULL;
ret.s.linemaplen = -1;
ret.s.has_backref = ret.peg->has_backref;
return ret;
s.mode = PEG_MODE_NORMAL;
s.text_start = bytes.bytes;
s.text_end = bytes.bytes + bytes.len;
s.depth = JANET_RECURSION_GUARD;
s.captures = janet_array(0);
s.scratch = janet_buffer(10);
s.tags = janet_buffer(10);
s.constants = peg->constants;
s.bytecode = peg->bytecode;
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
}
static void peg_call_reset(PegCall *c) {
c->s.captures->count = 0;
c->s.scratch->count = 0;
c->s.tags->count = 0;
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
}
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
return janet_wrap_integer(i);
}
return janet_wrap_nil();
}
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
JanetArray *ret = janet_array(0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
janet_array_push(ret, janet_wrap_integer(i));
}
return janet_wrap_array(ret);
}
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
PegCall c = peg_cfun_init(argc, argv, 1);
JanetBuffer *ret = janet_buffer(0);
int32_t trail = 0;
for (int32_t i = c.start; i < c.bytes.len;) {
peg_call_reset(&c);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
if (NULL != result) {
if (trail < i) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
trail = i;
}
int32_t nexti = (int32_t)(result - c.bytes.bytes);
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
trail = nexti;
if (nexti == i) nexti++;
i = nexti;
if (only_one) break;
} else {
i++;
}
}
if (trail < c.bytes.len) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
}
return janet_wrap_buffer(ret);
}
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 0);
}
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 1);
}
static JanetMethod peg_methods[] = {
{"match", cfun_peg_match},
{"find", cfun_peg_find},
{"find-all", cfun_peg_find_all},
{"replace", cfun_peg_replace},
{"replace-all", cfun_peg_replace_all},
{NULL, NULL}
};
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
(void) a;
if (!janet_checktype(key, JANET_KEYWORD))
return 0;
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
}
static Janet peg_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(peg_methods, key);
if (janet_keyeq(key, "match")) {
*out = janet_wrap_cfunction(cfun_peg_match);
return 1;
}
return 0;
}
static const JanetReg peg_cfuns[] = {
@@ -1691,35 +1277,14 @@ static const JanetReg peg_cfuns[] = {
"peg/compile", cfun_peg_compile,
JDOC("(peg/compile peg)\n\n"
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
"the grammar of the peg for otherwise undefined peg keywords.")
"if the same peg will be used multiple times.")
},
{
"peg/match", cfun_peg_match,
JDOC("(peg/match peg text &opt start & args)\n\n"
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
},
{
"peg/find", cfun_peg_find,
JDOC("(peg/find peg text &opt start & args)\n\n"
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
},
{
"peg/find-all", cfun_peg_find_all,
JDOC("(peg/find-all peg text &opt start & args)\n\n"
"Find all indexes where the peg matches in text. Returns an array of integers.")
},
{
"peg/replace", cfun_peg_replace,
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
"If no matches are found, returns the input string in a new buffer.")
},
{
"peg/replace-all", cfun_peg_replace_all,
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
"similar to those defined by LPeg, and have similar capabilities.")
},
{NULL, NULL, NULL}
};

View File

@@ -39,17 +39,12 @@
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
/* Use int32_t range for valid integers because that is the
* range most integer-expecting functions in the C api use. */
const char *fmt = (x == floor(x) &&
x <= JANET_INTMAX_DOUBLE &&
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
int count;
if (x == 0.0) {
/* Prevent printing of '-0' */
count = 1;
buffer->data[buffer->count] = '0';
} else {
count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
}
x <= ((double) INT32_MAX) &&
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
buffer->count += count;
}
@@ -128,6 +123,9 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
#undef HEX
#undef BUFSIZE
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
for (int32_t i = 0; i < len; ++i) {
@@ -157,11 +155,8 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
case '\\':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
break;
case '\t':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
break;
default:
if (c < 32 || c > 126) {
if (c < 32 || c > 127) {
uint8_t buf[4];
buf[0] = '\\';
buf[1] = 'x';
@@ -193,7 +188,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
case JANET_NIL:
janet_buffer_push_cstring(buffer, "");
janet_buffer_push_cstring(buffer, "nil");
break;
case JANET_BOOLEAN:
janet_buffer_push_cstring(buffer,
@@ -282,9 +277,6 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
return;
case JANET_KEYWORD:
janet_buffer_push_u8(buffer, ':');
break;
@@ -351,9 +343,6 @@ struct pretty {
int indent;
int flags;
int32_t bufstartlen;
int32_t *keysort_buffer;
int32_t keysort_capacity;
int32_t keysort_start;
JanetTable seen;
};
@@ -362,16 +351,12 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
if (depth == 0) return 1;
switch (janet_type(x)) {
case JANET_NIL:
case JANET_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@@ -464,7 +449,7 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m",
"\x1B[36m",
"\x1B[36m",
"\x1B[36m",
"\x1B[36m"
"\x1B[35m",
"\x1B[36m",
"\x1B[36m",
@@ -474,8 +459,8 @@ static const char *janet_pretty_colors[] = {
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_ARRAY_LIMIT 160
#define JANET_PRETTY_DICT_LIMIT 16
#define JANET_PRETTY_ARRAY_LIMIT 16
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
@@ -542,7 +527,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
if (len > JANET_PRETTY_ARRAY_LIMIT) {
for (i = 0; i < 3; i++) {
if (i) print_newline(S, 0);
janet_pretty_one(S, arr[i], 0);
@@ -575,7 +560,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
Janet name = janet_table_get(proto, janet_ckeywordv("name"));
const uint8_t *n;
int32_t len;
if (janet_bytes_view(name, &n, &len)) {
@@ -597,55 +582,31 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, "...");
} else {
int32_t i = 0, len = 0, cap = 0;
int first_kv_pair = 1;
const JanetKV *kvs = NULL;
int counter = 0;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
int32_t ks_start = S->keysort_start;
/* Ensure buffer is large enough to sort keys. */
int truncated = 0;
int64_t mincap = (int64_t) len + (int64_t) ks_start;
if (mincap > INT32_MAX) {
truncated = 1;
len = 0;
mincap = ks_start;
}
if (S->keysort_capacity < mincap) {
if (mincap >= INT32_MAX / 2) {
S->keysort_capacity = INT32_MAX;
} else {
S->keysort_capacity = mincap * 2;
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
for (i = 0; i < cap; i++) {
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
if (first_kv_pair) {
first_kv_pair = 0;
} else {
print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
}
janet_pretty_one(S, kvs[i].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[i].value, 1);
counter++;
if (counter == 10) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
break;
}
}
}
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
S->keysort_start += len;
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
truncated = 1;
}
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
}
if (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
S->keysort_start = ks_start;
}
S->indent -= 2;
S->depth++;
@@ -668,9 +629,6 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
S.indent = 0;
S.flags = flags;
S.bufstartlen = startlen;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
janet_table_init(&S.seen, 10);
janet_pretty_one(&S, x, 0);
janet_table_deinit(&S.seen);
@@ -693,9 +651,6 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
S.indent = 0;
S.flags = 0;
S.bufstartlen = startlen;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
janet_table_init(&S.seen, 10);
int res = print_jdn_one(&S, x, depth);
janet_table_deinit(&S.seen);
@@ -773,7 +728,7 @@ static const char *scanformat(
return p;
}
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
const char *format_end = format + strlen(format);
const char *c = format;
int32_t startlen = b->count;
@@ -796,6 +751,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
case 'd':
case 'i':
case 'o':
case 'u':
case 'x':
case 'X': {
int32_t n = va_arg(args, long);
@@ -846,24 +802,18 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
pushtypes(b, types);
break;
}
case 'M':
case 'm':
case 'N':
case 'n':
case 'Q':
case 'q':
case 'P':
case 'p': { /* janet pretty , precision = depth */
int depth = atoi(precision);
if (depth < 1) depth = JANET_RECURSION_GUARD;
if (depth < 1) depth = 4;
char d = c[-1];
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
int has_color = (d == 'P') || (d == 'Q');
int has_oneline = (d == 'Q') || (d == 'q');
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
break;
}
@@ -903,7 +853,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
va_start(args, format);
/* Run format */
janet_formatbv(&buffer, format, args);
janet_formatb(&buffer, format, args);
/* Iterate length */
va_end(args);
@@ -913,14 +863,6 @@ const uint8_t *janet_formatc(const char *format, ...) {
return ret;
}
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
va_list args;
va_start(args, format);
janet_formatbv(buffer, format, args);
va_end(args);
return buffer;
}
/* Shared implementation between string/format and
* buffer/format */
void janet_buffer_format(
@@ -954,6 +896,7 @@ void janet_buffer_format(
case 'd':
case 'i':
case 'o':
case 'u':
case 'x':
case 'X': {
int32_t n = janet_getinteger(argv, arg);
@@ -995,27 +938,19 @@ void janet_buffer_format(
janet_description_b(b, argv[arg]);
break;
}
case 't':
janet_buffer_push_cstring(b, typestr(argv[arg]));
break;
case 'M':
case 'm':
case 'N':
case 'n':
case 'Q':
case 'q':
case 'P':
case 'p': { /* janet pretty , precision = depth */
int depth = atoi(precision);
if (depth < 1) depth = JANET_RECURSION_GUARD;
char d = strfrmt[-1];
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
if (depth < 1)
depth = 4;
char c = strfrmt[-1];
int has_color = (c == 'P') || (c == 'Q');
int has_oneline = (c == 'Q') || (c == 'q');
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, argv[arg], startlen);
break;
}
@@ -1039,6 +974,3 @@ void janet_buffer_format(
}
}
}
#undef HEX
#undef BUFSIZE

View File

@@ -145,7 +145,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
int32_t oldmax = ra->max;
if (ra->regtemps & (1 << nth)) {
JANET_EXIT("regtemp already allocated");
janet_exit("regtemp already allocated");
}
ra->regtemps |= 1 << nth;
int32_t reg = janetc_regalloc_1(ra);

View File

@@ -23,6 +23,7 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@@ -49,16 +50,15 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
fiber->env = env;
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, ret);
errflags |= 0x01;
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, ret);
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@@ -68,23 +68,25 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
}
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
case JANET_PARSE_ERROR:
errflags |= 0x04;
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
janet_eprintf("parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
done = 1;
break;
}
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index == len) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
}
break;
case JANET_PARSE_ROOT:
if (index >= len) {
janet_parser_eof(&parser);
} else {

View File

@@ -336,8 +336,10 @@ static int defleaf(
/* Put value in table when evaulated */
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
return 1;
} else {
return namelocal(c, sym, 0, s);
}
return namelocal(c, sym, 0, s);
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -468,28 +470,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Compile an upscope form. Upscope forms execute their body sequentially and
* evaluate to the last expression in the body, but without lexical scope. */
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
int32_t i;
JanetSlot ret = janetc_cslot(janet_wrap_nil());
JanetCompiler *c = opts.compiler;
JanetFopts subopts = janetc_fopts_default(c);
for (i = 0; i < argn; i++) {
if (i != argn - 1) {
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
}
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
janetc_freeslot(c, ret);
}
}
return ret;
}
/* Add a funcdef to the top most function scope */
static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
JanetScope *scope = c->scope;
@@ -642,11 +622,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Check if closure created in while scope. If so,
* recompile in a function scope. */
if (tempscope.flags & JANET_SCOPE_CLOSURE) {
subopts = janetc_fopts_default(c);
tempscope.flags |= JANET_SCOPE_UNUSED;
janetc_popscope(c);
if (c->buffer) janet_v__cnt(c->buffer) = labelwt;
if (c->mapbuffer) janet_v__cnt(c->mapbuffer) = labelwt;
janet_v__cnt(c->buffer) = labelwt;
janet_v__cnt(c->mapbuffer) = labelwt;
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
@@ -669,7 +648,6 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Compile function */
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
janet_def_addflags(def);
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
@@ -844,7 +822,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (selfref) def->name = janet_unwrap_symbol(head);
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);
/* Ensure enough slots for vararg function. */
@@ -874,7 +851,6 @@ static const JanetSpecial janetc_specials[] = {
{"set", janetc_varset},
{"splice", janetc_splice},
{"unquote", janetc_unquote},
{"upscope", janetc_upscope},
{"var", janetc_var},
{"while", janetc_while}
};

View File

@@ -34,9 +34,6 @@
typedef struct JanetScratch JanetScratch;
/* Top level dynamic bindings */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
@@ -46,7 +43,6 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
/* The current running fiber on the current thread.
* Set and unset by janet_run. */
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber;
/* The current pointer to the inner most jmp_buf. The current
* return point for panics. */
@@ -71,7 +67,6 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
/* GC roots */
@@ -84,31 +79,10 @@ extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
/* Recursionless traversal of data structures */
typedef struct {
JanetGCObject *self;
JanetGCObject *other;
int32_t index;
int32_t index2;
} JanetTraversalNode;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
/* Setup / teardown */
#ifdef JANET_THREADS
void janet_threads_init(void);
void janet_threads_deinit(void);
#endif
#ifdef JANET_NET
void janet_net_init(void);
void janet_net_deinit(void);
#endif
#ifdef JANET_EV
void janet_ev_init(void);
void janet_ev_deinit(void);
#endif
#endif /* JANET_STATE_H_defined */

View File

@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
int32_t ylen = janet_string_length(rhs);
int32_t len = xlen > ylen ? ylen : xlen;
int res = memcmp(lhs, rhs, len);
if (res) return res > 0 ? 1 : -1;
if (res) return res;
if (xlen == ylen) return 0;
return xlen < ylen ? -1 : 1;
}
@@ -176,18 +176,6 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
return janet_stringv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_symbolv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_keywordv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetByteView view = janet_getbytes(argv, 0);
@@ -398,7 +386,6 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex);
janet_array_push(array, janet_wrap_string(slice));
lastindex = result + state.patlen;
kmp_seti(&state, lastindex);
}
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
janet_array_push(array, janet_wrap_string(slice));
@@ -542,16 +529,6 @@ static const JanetReg string_cfuns[] = {
"from the end of the string. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ")
},
{
"keyword/slice", cfun_keyword_slice,
JDOC("(keyword/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a keyword.")
},
{
"symbol/slice", cfun_symbol_slice,
JDOC("(symbol/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a symbol.")
},
{
"string/repeat", cfun_string_repeat,
JDOC("(string/repeat bytes n)\n\n"
@@ -565,7 +542,7 @@ static const JanetReg string_cfuns[] = {
{
"string/from-bytes", cfun_string_frombytes,
JDOC("(string/from-bytes & byte-vals)\n\n"
"Creates a string from integer parameters with byte values. All integers "
"Creates a string from integer params with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.")
},
{
@@ -596,11 +573,12 @@ static const JanetReg string_cfuns[] = {
},
{
"string/find-all", cfun_string_findall,
JDOC("(string/find-all patt str)\n\n"
JDOC("(string/find patt str)\n\n"
"Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in str "
"may contribute to multiple found patterns.")
"instances of the pattern are not counted, meaning a byte in string "
"will only contribute to finding at most on occurrence of pattern. If no "
"occurrences are found, will return an empty array.")
},
{
"string/has-prefix?", cfun_string_hasprefix,
@@ -621,8 +599,7 @@ static const JanetReg string_cfuns[] = {
{
"string/replace-all", cfun_string_replaceall,
JDOC("(string/replace-all patt subst str)\n\n"
"Replace all instances of patt with subst in the string str. Overlapping "
"matches will not be counted, only the first match in such a span will be replaced. "
"Replace all instances of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.")
},
{
@@ -650,7 +627,7 @@ static const JanetReg string_cfuns[] = {
{
"string/format", cfun_string_format,
JDOC("(string/format format & values)\n\n"
"Similar to snprintf, but specialized for operating with Janet values. Returns "
"Similar to snprintf, but specialized for operating with janet. Returns "
"a new string.")
},
{

View File

@@ -208,9 +208,9 @@ static double convert(
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
* number, within * 2^32 or so. */
int64_t mant_exp2_approx = mant->n * 32 + 16;
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
int32_t mant_exp2_approx = mant->n * 32 + 16;
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
@@ -447,7 +447,7 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
int neg;
uint64_t bi;
if (scan_uint64(str, len, &bi, &neg)) {
if (neg && bi <= ((UINT64_MAX / 2) + 1)) {
if (neg && bi <= (UINT64_MAX / 2)) {
if (bi > INT64_MAX) {
*out = INT64_MIN;
} else {

View File

@@ -123,8 +123,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
dist = otherdist;
hash = otherhash;
} else if (status == 0) {
/* A key was added to the struct more than once - replace old value */
kv->value = value;
/* A key was added to the struct more than once */
return;
}
}
@@ -167,3 +166,51 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
}
return table;
}
/* Check if two structs are equal */
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
int32_t index;
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
if (llen != rlen)
return 0;
if (lhash != rhash)
return 0;
for (index = 0; index < llen; index++) {
const JanetKV *l = lhs + index;
const JanetKV *r = rhs + index;
if (!janet_equals(l->key, r->key))
return 0;
if (!janet_equals(l->value, r->value))
return 0;
}
return 1;
}
/* Compare structs */
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
int32_t i;
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
if (llen < rlen)
return -1;
if (llen > rlen)
return 1;
if (lhash < rhash)
return -1;
if (lhash > rhash)
return 1;
for (i = 0; i < llen; ++i) {
const JanetKV *l = lhs + i;
const JanetKV *r = rhs + i;
int comp = janet_compare(l->key, r->key);
if (comp != 0) return comp;
comp = janet_compare(l->value, r->value);
if (comp != 0) return comp;
}
return 0;
}

View File

@@ -173,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
Janet janet_table_remove(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
Janet ret = bucket->value;
Janet ret = bucket->key;
t->count--;
t->deleted++;
bucket->key = janet_wrap_nil();
@@ -256,7 +256,7 @@ static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t c
}
}
/* Merge a table into another table */
/* Merge a table other into another table */
void janet_table_merge_table(JanetTable *table, JanetTable *other) {
janet_table_mergekv(table, other->data, other->capacity);
}

View File

@@ -66,15 +66,9 @@ struct JanetMailbox {
JanetBuffer messages[];
};
#define JANET_THREAD_HEAVYWEIGHT 0x1
#define JANET_THREAD_ABSTRACTS 0x2
#define JANET_THREAD_CFUNCTIONS 0x4
static const char janet_thread_flags[] = "hac";
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
uint64_t flags;
} JanetMailboxPair;
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
@@ -84,9 +78,6 @@ static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
static JanetTable *janet_thread_get_decode(void) {
if (janet_vm_thread_decode == NULL) {
janet_vm_thread_decode = janet_get_core_table("load-image-dict");
if (NULL == janet_vm_thread_decode) {
janet_vm_thread_decode = janet_table(0);
}
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
}
return janet_vm_thread_decode;
@@ -184,7 +175,7 @@ static int thread_mark(void *p, size_t size) {
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
@@ -192,7 +183,6 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flag
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
pair->flags = flags;
return pair;
}
@@ -237,7 +227,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
if (waiter->timedwait) {
/* N seconds -> timespec of (now + sec) */
struct timespec now;
janet_gettime(&now);
clock_gettime(CLOCK_REALTIME, &now);
time_t tvsec = (time_t) floor(sec);
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
tvsec += now.tv_sec;
@@ -339,7 +329,7 @@ int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
msgbuf->count = 0;
/* Start panic zone */
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
janet_marshal(msgbuf, msg, thread->encode, 0);
/* End panic zone */
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
@@ -378,12 +368,8 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
/* Handle errors */
if (setjmp(buf)) {
/* Cleanup jmp_buf, return error.
* Do not ignore bad messages as before. */
/* Cleanup jmp_buf, keep lock */
janet_vm_jmp_buf = old_buf;
*msg_out = *janet_vm_return_reg;
janet_mailbox_unlock(mailbox);
return 2;
} else {
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
mailbox->messageCount--;
@@ -393,7 +379,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
const uint8_t *nextItem = NULL;
Janet item = janet_unmarshal(
msgbuf->data, msgbuf->count,
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
0, janet_thread_get_decode(), &nextItem);
*msg_out = item;
/* Cleanup */
@@ -418,24 +404,17 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
return 1;
}
}
}
static int janet_thread_getter(void *p, Janet key, Janet *out);
static Janet janet_thread_next(void *p, Janet key);
const JanetAbstractType janet_thread_type = {
"core/thread",
thread_gc,
thread_mark,
janet_thread_getter,
NULL, /* put */
NULL, /* marshal */
NULL, /* unmarshal */
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
janet_thread_next,
JANET_ATEND_NEXT
JANET_ATEND_GET
};
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
@@ -463,44 +442,16 @@ static int thread_worker(JanetMailboxPair *pair) {
janet_init();
/* Get dictionaries for default encode/decode */
JanetTable *encode;
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
janet_vm_thread_decode = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
}
JanetTable *encode = janet_get_core_table("make-image-dict");
/* Create parent thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the abstract registry */
if (pair->flags & JANET_THREAD_ABSTRACTS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
janet_vm_abstract_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
}
/* Unmarshal the normal registry */
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_registry));
janet_vm_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_registry));
}
/* Unmarshal the function */
Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY);
if (status) goto error;
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
JanetFunction *func = janet_unwrap_function(funcv);
@@ -513,20 +464,12 @@ static int thread_worker(JanetMailboxPair *pair) {
/* Call function */
Janet argv[1] = { parentv };
fiber = janet_fiber(func, 64, 1, argv);
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
fiber->env = janet_table(0);
fiber->env->proto = janet_core_env(NULL);
}
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
if (sig != JANET_SIGNAL_OK) {
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
janet_stacktrace(fiber, out);
}
#ifdef JANET_EV
janet_loop();
#endif
/* Normal exit */
destroy_mailbox_pair(pair);
janet_deinit();
@@ -596,14 +539,6 @@ void janet_threads_deinit(void) {
janet_vm_thread_decode = NULL;
}
JanetThread *janet_thread_current(void) {
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_vm_thread_current;
}
/*
* Cfuns
*/
@@ -611,44 +546,30 @@ JanetThread *janet_thread_current(void) {
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_abstract(janet_thread_current());
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_wrap_abstract(janet_vm_thread_current);
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
janet_arity(argc, 1, 2);
/* Just type checking */
janet_getfunction(argv, 0);
int32_t cap = janet_optinteger(argv, argc, 1, 10);
if (cap < 1 || cap > UINT16_MAX) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
JanetTable *encode;
if (flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
}
JanetTable *encode = janet_get_core_table("make-image-dict");
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
if (flags & JANET_THREAD_ABSTRACTS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
janet_panic("could not send abstract registry to thread");
}
}
if (flags & JANET_THREAD_CFUNCTIONS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
janet_panic("could not send registry to thread");
}
}
/* If thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]);
@@ -682,8 +603,6 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
break;
case 1:
janet_panicf("timeout after %f seconds", wait);
case 2:
janet_panicf("failed to receive message: %v", out);
}
return out;
}
@@ -695,18 +614,6 @@ static Janet cfun_thread_close(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
(void) argv;
janet_arity(argc, 0, 1);
#if defined(JANET_WINDOWS)
int32_t flag = janet_optinteger(argv, argc, 0, 0);
ExitThread(flag);
#else
pthread_exit(NULL);
#endif
return janet_wrap_nil();
}
static const JanetMethod janet_thread_methods[] = {
{"send", cfun_thread_send},
{"close", cfun_thread_close},
@@ -719,11 +626,6 @@ static int janet_thread_getter(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
}
static Janet janet_thread_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(janet_thread_methods, key);
}
static const JanetReg threadlib_cfuns[] = {
{
"thread/current", cfun_thread_current,
@@ -732,30 +634,23 @@ static const JanetReg threadlib_cfuns[] = {
},
{
"thread/new", cfun_thread_new,
JDOC("(thread/new func &opt capacity flags)\n\n"
JDOC("(thread/new func &opt capacity)\n\n"
"Start a new thread that will start immediately. "
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
"Can optionally provide flags to the new thread - supported flags are:\n\n"
"* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
"* :a - Allow sending over registered abstract types to the new thread\n\n"
"* :c - Send over cfunction information to the new thread.\n\n"
"Returns a handle to the new thread.")
},
{
"thread/send", cfun_thread_send,
JDOC("(thread/send thread msgi &opt timeout)\n\n"
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
"in seconds can be provided. Use math/inf for no timeout. "
JDOC("(thread/send thread msg)\n\n"
"Send a message to the thread. This will never block and returns thread immediately. "
"Will throw an error if there is a problem sending the message.")
},
{
"thread/receive", cfun_thread_receive,
JDOC("(thread/receive &opt timeout)\n\n"
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
"will be thrown after the timeout has elapsed but "
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
"turn off the timeout.")
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
"no messages are received.")
},
{
"thread/close", cfun_thread_close,
@@ -763,12 +658,6 @@ static const JanetReg threadlib_cfuns[] = {
"Close a thread, unblocking it and ending communication with it. Note that closing "
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
},
{
"thread/exit", cfun_thread_exit,
JDOC("(thread/exit &opt code)\n\n"
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.")
},
{NULL, NULL, NULL}
};

View File

@@ -53,6 +53,45 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
return janet_tuple_end(t);
}
/* Check if two tuples are equal */
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
int32_t index;
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t lhash = janet_tuple_hash(lhs);
int32_t rhash = janet_tuple_hash(rhs);
if (lhash == 0)
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
if (rhash == 0)
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
if (lhash != rhash)
return 0;
if (llen != rlen)
return 0;
for (index = 0; index < llen; index++) {
if (!janet_equals(lhs[index], rhs[index]))
return 0;
}
return 1;
}
/* Compare tuples */
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
int32_t i;
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t count = llen < rlen ? llen : rlen;
for (i = 0; i < count; ++i) {
int comp = janet_compare(lhs[i], rhs[i]);
if (comp != 0) return comp;
}
if (llen < rlen)
return -1;
else if (llen > rlen)
return 1;
return 0;
}
/* C Functions */
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {

View File

@@ -275,24 +275,6 @@ static void ta_setter(void *p, Janet key, Janet value) {
}
}
static Janet ta_view_next(void *p, Janet key) {
JanetTArrayView *view = p;
if (janet_checktype(key, JANET_NIL)) {
if (view->size > 0) {
return janet_wrap_number(0);
} else {
return janet_wrap_nil();
}
}
if (!janet_checksize(key)) janet_panic("expected size as key");
size_t index = (size_t) janet_unwrap_number(key);
index++;
if (index < view->size) {
return janet_wrap_number((double) index);
}
return janet_wrap_nil();
}
const JanetAbstractType janet_ta_view_type = {
"ta/view",
NULL,
@@ -301,11 +283,7 @@ const JanetAbstractType janet_ta_view_type = {
ta_setter,
ta_view_marshal,
ta_view_unmarshal,
NULL,
NULL,
NULL,
ta_view_next,
JANET_ATEND_NEXT
JANET_ATEND_UNMARSHAL
};
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
@@ -376,29 +354,18 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
if (argc > 3)
offset = janet_getsize(argv, 3);
if (argc > 4) {
int32_t blen;
const uint8_t *bytes;
if (janet_bytes_view(argv[4], &bytes, &blen)) {
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buffer, (size_t) blen);
memcpy(buffer->data, bytes, blen);
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else {
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
buffer = p;
} else {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
buffer = p;
}
}
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);

View File

@@ -26,14 +26,6 @@
#include "util.h"
#include "state.h"
#include "gc.h"
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#endif
#endif
#include <inttypes.h>
@@ -102,7 +94,7 @@ const char *const janet_status_names[16] = {
"alive"
};
#ifndef JANET_PRF
#ifdef JANET_NO_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
const uint8_t *end = str + len;
@@ -227,21 +219,19 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
/* Computes hash of an array of values */
int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len;
uint32_t hash = 0;
while (array < end) {
uint32_t elem = janet_hash(*array++);
hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
}
uint32_t hash = 5381;
while (array < end)
hash = (hash << 5) + hash + janet_hash(*array++);
return (int32_t) hash;
}
/* Computes hash of an array of values */
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
const JanetKV *end = kvs + len;
uint32_t hash = 0;
uint32_t hash = 5381;
while (kvs < end) {
hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash = (hash << 5) + hash + janet_hash(kvs->key);
hash = (hash << 5) + hash + janet_hash(kvs->value);
kvs++;
}
return (int32_t) hash;
@@ -390,7 +380,7 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
}
/* Load many cfunctions at once */
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
uint8_t *longname_buffer = NULL;
size_t prefixlen = 0;
size_t bufsize = 0;
@@ -424,35 +414,18 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
name = janet_csymbolv(cfuns->name);
}
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (defprefix) {
JanetTable *subt = janet_table(2);
janet_table_put(subt, janet_ckeywordv("value"), fun);
if (cfuns->documentation)
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
janet_table_put(env, name, janet_wrap_table(subt));
} else {
janet_def(env, cfuns->name, fun, cfuns->documentation);
}
janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(janet_vm_registry, fun, name);
cfuns++;
}
free(longname_buffer);
}
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
}
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
}
/* Abstract type introspection */
void janet_register_abstract_type(const JanetAbstractType *at) {
Janet sym = janet_csymbolv(at->name);
Janet check = janet_table_get(janet_vm_abstract_registry, sym);
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
janet_panicf("cannot register abstract type %s, "
"a type with the same name exists", at->name);
}
@@ -585,12 +558,8 @@ int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
if (dval != (double)((size_t) dval)) return 0;
if (SIZE_MAX > JANET_INTMAX_INT64) {
return dval <= JANET_INTMAX_INT64;
} else {
return dval <= SIZE_MAX;
}
return dval == (double)((size_t) dval) &&
dval <= SIZE_MAX;
}
JanetTable *janet_get_core_table(const char *name) {
@@ -601,122 +570,3 @@ JanetTable *janet_get_core_table(const char *name) {
if (!janet_checktype(out, JANET_TABLE)) return NULL;
return janet_unwrap_table(out);
}
/* Sort keys of a dictionary type */
int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer) {
/* First, put populated indices into index_buffer */
int32_t next_index = 0;
for (int32_t i = 0; i < cap; i++) {
if (!janet_checktype(dict[i].key, JANET_NIL)) {
index_buffer[next_index++] = i;
}
}
/* Next, sort those (simple insertion sort here for now) */
for (int32_t i = 1; i < next_index; i++) {
int32_t index_to_insert = index_buffer[i];
Janet lhs = dict[index_to_insert].key;
for (int32_t j = i - 1; j >= 0; j--) {
index_buffer[j + 1] = index_buffer[j];
Janet rhs = dict[index_buffer[j]].key;
if (janet_compare(lhs, rhs) >= 0) {
index_buffer[j + 1] = index_to_insert;
break;
} else if (j == 0) {
index_buffer[0] = index_to_insert;
}
}
}
/* Return number of indices found */
return next_index;
}
/* Clock shims for various platforms */
#ifdef JANET_GETTIME
/* For macos */
#ifdef __MACH__
#include <mach/clock.h>
#include <mach/mach.h>
#endif
#ifdef JANET_WINDOWS
int janet_gettime(struct timespec *spec) {
FILETIME ftime;
GetSystemTimeAsFileTime(&ftime);
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
/* Windows epoch is January 1, 1601 apparently */
wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL;
/* Resolution is 100 nanoseconds. */
spec->tv_nsec = wintime % 10000000LL * 100;
return 0;
}
#elif defined(__MACH__)
int janet_gettime(struct timespec *spec) {
clock_serv_t cclock;
mach_timespec_t mts;
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec;
return 0;
}
#else
int janet_gettime(struct timespec *spec) {
return clock_gettime(CLOCK_REALTIME, spec);
}
#endif
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
void arc4random_buf(void *buf, size_t nbytes);
#endif
int janet_cryptorand(uint8_t *out, size_t n) {
#ifdef JANET_WINDOWS
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
return -1;
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
out[i + j] = v & 0xff;
v = v >> 8;
}
}
return 0;
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
In these cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
if (randfd < 0)
return -1;
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, out, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
return -1;
}
out += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
return 0;
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
(void) n;
(void) out;
return -1;
#endif
}

View File

@@ -31,16 +31,11 @@
#include <stdio.h>
#include <errno.h>
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
#include <time.h>
#define JANET_GETTIME
#endif
/* Handle runtime errors */
#ifndef JANET_EXIT
#ifndef janet_exit
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
#define janet_exit(m) do { \
printf("C runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
@@ -49,13 +44,13 @@
#endif
#define janet_assert(c, m) do { \
if (!(c)) JANET_EXIT((m)); \
if (!(c)) janet_exit((m)); \
} while (0)
/* What to do when out of memory */
#ifndef JANET_OUT_OF_MEMORY
#include <stdio.h>
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
#endif
/* Omit docstrings in some builds */
@@ -76,10 +71,10 @@ int32_t janet_tablen(int32_t n);
void safe_memcpy(void *dest, const void *src, size_t len);
void janet_buffer_push_types(JanetBuffer *buffer, int types);
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
@@ -91,7 +86,6 @@ void janet_buffer_format(
int32_t argstart,
int32_t argc,
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
/* Inside the janet core, defining globals is different
* at bootstrap time and normal runtime */
@@ -103,18 +97,6 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
#endif
/* Clock gettime */
#ifdef JANET_GETTIME
int janet_gettime(struct timespec *spec);
#endif
/* strdup */
#ifdef JANET_WINDOWS
#define strdup(x) _strdup(x)
#endif
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
void janet_lib_math(JanetTable *env);
@@ -144,14 +126,5 @@ void janet_lib_inttypes(JanetTable *env);
#ifdef JANET_THREADS
void janet_lib_thread(JanetTable *env);
#endif
#ifdef JANET_NET
void janet_lib_net(JanetTable *env);
extern const JanetAbstractType janet_address_type;
#endif
#ifdef JANET_EV
void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
int janet_make_pipe(JanetHandle handles[2], int mode);
#endif
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -23,103 +23,14 @@
#ifndef JANET_AMALG
#include "features.h"
#include "util.h"
#include "state.h"
#include "gc.h"
#include "fiber.h"
#include <janet.h>
#endif
#include <math.h>
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
JanetTraversalNode node;
node.self = (JanetGCObject *) lhs;
node.other = (JanetGCObject *) rhs;
node.index = 0;
node.index2 = index2;
if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
size_t newsize = 2 * oldsize + 1;
if (newsize < 128) {
newsize = 128;
}
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
if (tn == NULL) {
JANET_OUT_OF_MEMORY;
}
janet_vm_traversal_base = tn;
janet_vm_traversal_top = janet_vm_traversal_base + newsize;
janet_vm_traversal = janet_vm_traversal_base + oldsize;
}
*(++janet_vm_traversal) = node;
}
/*
* Used for travsersing structs and tuples without recursion
* Returns:
* 0 - next node found
* 1 - early stop - lhs < rhs
* 2 - no next node found
* 3 - early stop - lhs > rhs
*/
static int traversal_next(Janet *x, Janet *y) {
JanetTraversalNode *t = janet_vm_traversal;
while (t && t > janet_vm_traversal_base) {
JanetGCObject *self = t->self;
JanetTupleHead *tself = (JanetTupleHead *)self;
JanetStructHead *sself = (JanetStructHead *)self;
JanetGCObject *other = t->other;
JanetTupleHead *tother = (JanetTupleHead *)other;
JanetStructHead *sother = (JanetStructHead *)other;
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
/* Node is a tuple at index t->index */
if (t->index < tself->length && t->index < tother->length) {
int32_t index = t->index++;
*x = tself->data[index];
*y = tother->data[index];
janet_vm_traversal = t;
return 0;
}
if (t->index2 && tself->length != tother->length) {
return tself->length > tother->length ? 3 : 1;
}
} else {
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
if (t->index2) {
t->index2 = 0;
int32_t index = t->index++;
*x = sself->data[index].value;
*y = sother->data[index].value;
janet_vm_traversal = t;
return 0;
}
for (int32_t i = t->index; i < sself->capacity; i++) {
t->index2 = 1;
*x = sself->data[t->index].key;
*y = sother->data[t->index].key;
janet_vm_traversal = t;
return 0;
}
}
t--;
}
janet_vm_traversal = t;
return 2;
}
/*
* Define a number of functions that can be used internally on ANY Janet.
*/
Janet janet_next(Janet ds, Janet key) {
return janet_next_impl(ds, key, 0);
}
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
JanetType t = janet_type(ds);
switch (t) {
default:
@@ -182,44 +93,6 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
if (NULL == at->next) break;
return at->next(abst, key);
}
case JANET_FIBER: {
JanetFiber *child = janet_unwrap_fiber(ds);
Janet retreg;
JanetFiberStatus status = janet_fiber_status(child);
if (status == JANET_STATUS_ALIVE ||
status == JANET_STATUS_DEAD ||
status == JANET_STATUS_ERROR ||
status == JANET_STATUS_USER0 ||
status == JANET_STATUS_USER1 ||
status == JANET_STATUS_USER2 ||
status == JANET_STATUS_USER3 ||
status == JANET_STATUS_USER4) {
return janet_wrap_nil();
}
janet_vm_fiber->child = child;
JanetSignal sig = janet_continue(child, janet_wrap_nil(), &retreg);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
if (is_interpreter) {
janet_signalv(sig, retreg);
} else {
janet_vm_fiber->child = NULL;
janet_panicv(retreg);
}
}
janet_vm_fiber->child = NULL;
if (sig == JANET_SIGNAL_OK ||
sig == JANET_SIGNAL_ERROR ||
sig == JANET_SIGNAL_USER0 ||
sig == JANET_SIGNAL_USER1 ||
sig == JANET_SIGNAL_USER2 ||
sig == JANET_SIGNAL_USER3 ||
sig == JANET_SIGNAL_USER4) {
/* Fiber cannot be resumed, so discard last value. */
return janet_wrap_nil();
} else {
return janet_wrap_integer(0);
}
}
}
return janet_wrap_nil();
}
@@ -238,51 +111,41 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
return xt->compare(xx, yy);
}
/* Check if two values are equal. This is strict equality with no conversion. */
int janet_equals(Janet x, Janet y) {
janet_vm_traversal = janet_vm_traversal_base;
do {
if (janet_type(x) != janet_type(y)) return 0;
int result = 0;
if (janet_type(x) != janet_type(y)) {
result = 0;
} else {
switch (janet_type(x)) {
case JANET_NIL:
result = 1;
break;
case JANET_BOOLEAN:
if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0;
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
break;
case JANET_NUMBER:
if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0;
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
break;
case JANET_STRING:
if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0;
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
break;
case JANET_TUPLE:
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
break;
case JANET_STRUCT:
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
break;
case JANET_ABSTRACT:
if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0;
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
break;
default:
if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0;
/* compare pointers */
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
break;
case JANET_TUPLE: {
const Janet *t1 = janet_unwrap_tuple(x);
const Janet *t2 = janet_unwrap_tuple(y);
if (t1 == t2) break;
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
break;
}
break;
case JANET_STRUCT: {
const JanetKV *s1 = janet_unwrap_struct(x);
const JanetKV *s2 = janet_unwrap_struct(y);
if (s1 == s2) break;
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
break;
}
break;
}
} while (!traversal_next(&x, &y));
return 1;
}
return result;
}
/* Computes a hash value for a function */
@@ -306,17 +169,6 @@ int32_t janet_hash(Janet x) {
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
break;
case JANET_NUMBER: {
union {
double d;
uint64_t u;
} as;
as.d = janet_unwrap_number(x);
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(as.u >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
break;
}
case JANET_ABSTRACT: {
JanetAbstract xx = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(xx);
@@ -327,12 +179,14 @@ int32_t janet_hash(Janet x) {
}
/* fallthrough */
default:
/* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */
uint64_t i = janet_u64(x);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
hash = (int32_t)(i & 0xFFFFFFFF);
/* Get a bit more entropy by shifting the low bits out */
hash >>= 3;
hash ^= (int32_t)(i >> 32);
} else {
/* Assuming 4 byte pointer (or smaller) */
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
@@ -347,71 +201,38 @@ int32_t janet_hash(Janet x) {
* If y is less, returns 1. All types are comparable
* and should have strict ordering, excepts NaNs. */
int janet_compare(Janet x, Janet y) {
janet_vm_traversal = janet_vm_traversal_base;
int status;
do {
JanetType tx = janet_type(x);
JanetType ty = janet_type(y);
if (tx != ty) return tx < ty ? -1 : 1;
switch (tx) {
if (janet_type(x) == janet_type(y)) {
switch (janet_type(x)) {
case JANET_NIL:
break;
case JANET_BOOLEAN: {
int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
if (diff) return diff;
break;
}
return 0;
case JANET_BOOLEAN:
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
case JANET_NUMBER: {
double xx = janet_unwrap_number(x);
double yy = janet_unwrap_number(y);
if (xx == yy) {
break;
} else {
return (xx < yy) ? -1 : 1;
}
return xx == yy
? 0
: (xx < yy) ? -1 : 1;
}
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD: {
int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
if (diff) return diff;
break;
}
case JANET_ABSTRACT: {
int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
if (diff) return diff;
break;
}
default: {
if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) {
break;
case JANET_KEYWORD:
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
case JANET_TUPLE:
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
case JANET_STRUCT:
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
case JANET_ABSTRACT:
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
default:
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
return 0;
} else {
return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1;
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
}
}
case JANET_TUPLE: {
const Janet *lhs = janet_unwrap_tuple(x);
const Janet *rhs = janet_unwrap_tuple(y);
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
break;
}
case JANET_STRUCT: {
const JanetKV *lhs = janet_unwrap_struct(x);
const JanetKV *rhs = janet_unwrap_struct(y);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
if (llen < rlen) return -1;
if (llen > rlen) return 1;
if (lhash < rhash) return -1;
if (lhash > rhash) return 1;
push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0);
break;
}
}
} while (!(status = traversal_next(&x, &y)));
return status - 2;
}
return (janet_type(x) < janet_type(y)) ? -1 : 1;
}
static int32_t getter_checkint(Janet key, int32_t max) {
@@ -473,14 +294,6 @@ Janet janet_in(Janet ds, Janet key) {
}
break;
}
case JANET_FIBER: {
/* Bit of a hack to allow iterating over fibers. */
if (janet_equals(key, janet_wrap_integer(0))) {
return janet_unwrap_fiber(ds)->last_value;
} else {
janet_panicf("expected key 0, got %v", key);
}
}
}
return value;
}
@@ -536,14 +349,6 @@ Janet janet_get(Janet ds, Janet key) {
const JanetKV *st = janet_unwrap_struct(ds);
return janet_struct_get(st, key);
}
case JANET_FIBER: {
/* Bit of a hack to allow iterating over fibers. */
if (janet_equals(key, janet_wrap_integer(0))) {
return janet_unwrap_fiber(ds)->last_value;
} else {
return janet_wrap_nil();
}
}
}
}
@@ -600,14 +405,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
}
break;
}
case JANET_FIBER: {
if (index == 0) {
value = janet_unwrap_fiber(ds)->last_value;
} else {
value = janet_wrap_nil();
}
break;
}
}
return value;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2020 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -33,13 +33,11 @@
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber = NULL;
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
@@ -91,11 +89,7 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
func = janet_stack_frame(stack)->func; \
} while (0)
#define vm_return(sig, val) do { \
janet_vm_return_reg[0] = (val); \
vm_commit(); \
return (sig); \
} while (0)
#define vm_return_no_restore(sig, val) do { \
janet_vm_return_reg[0] = (val); \
return (sig); \
} while (0)
@@ -113,13 +107,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
#define vm_assert_type(X, T) do { \
if (!(janet_checktype((X), (T)))) { \
vm_commit(); \
janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
janet_panicf("expected %T, got %t", (1 << (T)), (X)); \
} \
} while (0)
#define vm_assert_types(X, TS) do { \
if (!(janet_checktypes((X), (TS)))) { \
vm_commit(); \
janet_panicf("expected %T, got %v", (TS), (X)); \
janet_panicf("expected %T, got %t", (TS), (X)); \
} \
} while (0)
@@ -202,20 +196,6 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
vm_checkgc_pcnext();\
}\
}
#define vm_compop_imm(op) \
{\
Janet op1 = stack[B];\
if (janet_checktype(op1, JANET_NUMBER)) {\
double x1 = janet_unwrap_number(op1);\
double x2 = (double) CS; \
stack[A] = janet_wrap_boolean(x1 op x2);\
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
vm_checkgc_pcnext();\
}\
}
/* Trace a function call */
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
@@ -310,10 +290,6 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
}
}
/* Forward declaration */
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
/* Interpreter main loop */
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
@@ -392,9 +368,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_GREATER_THAN_EQUAL,
&&label_JOP_LESS_THAN_EQUAL,
&&label_JOP_NEXT,
&&label_JOP_NOT_EQUALS,
&&label_JOP_NOT_EQUALS_IMMEDIATE,
&&label_JOP_CANCEL,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -582,15 +558,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
register Janet *stack;
register uint32_t *pc;
register JanetFunction *func;
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
janet_vm_return_reg[0] = in;
return sig;
}
vm_restore();
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
@@ -641,7 +608,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = stack[D];
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -651,7 +618,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = janet_wrap_nil();
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -794,7 +761,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_compop( <=);
VM_OP(JOP_LESS_THAN_IMMEDIATE)
vm_compop_imm( <);
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
vm_pcnext();
VM_OP(JOP_GREATER_THAN)
vm_compop( >);
@@ -803,22 +771,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_compop( >=);
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
vm_compop_imm( >);
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
vm_pcnext();
VM_OP(JOP_EQUALS)
stack[A] = janet_wrap_boolean(janet_equals(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
vm_pcnext();
VM_OP(JOP_NOT_EQUALS)
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
vm_pcnext();
VM_OP(JOP_COMPARE)
@@ -826,12 +787,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_NEXT)
vm_commit();
{
Janet temp = janet_next_impl(stack[B], stack[C], 1);
vm_restore();
stack[A] = temp;
}
stack[A] = janet_next(stack[B], stack[C]);
vm_pcnext();
VM_OP(JOP_LOAD_NIL)
@@ -868,8 +824,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
env = func->envs[eindex];
vm_assert(env->length > vindex, "invalid upvalue index");
vm_assert(janet_env_valid(env), "invalid upvalue environment");
if (env->offset > 0) {
if (env->offset) {
/* On stack */
stack[A] = env->as.fiber->data[env->offset + vindex];
} else {
@@ -886,8 +841,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
env = func->envs[eindex];
vm_assert(env->length > vindex, "invalid upvalue index");
vm_assert(janet_env_valid(env), "invalid upvalue environment");
if (env->offset > 0) {
if (env->offset) {
env->as.fiber->data[env->offset + vindex] = stack[A];
} else {
env->as.values[vindex] = stack[A];
@@ -950,7 +904,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_indexed_view(stack[D], &vals, &len)) {
janet_fiber_pushn(fiber, vals, len);
} else {
janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]);
}
}
stack = fiber->data + fiber->frame;
@@ -968,7 +922,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
}
janet_stack_frame(stack)->pc = pc;
if (janet_fiber_funcframe(fiber, func)) {
@@ -1007,7 +961,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
}
if (janet_fiber_funcframe_tail(fiber, func)) {
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
@@ -1031,9 +985,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
retreg = call_nonfn(fiber, callee);
}
janet_fiber_popframe(fiber);
if (entrance_frame) {
vm_return_no_restore(JANET_SIGNAL_OK, retreg);
}
if (entrance_frame)
vm_return(JANET_SIGNAL_OK, retreg);
vm_restore();
stack[A] = retreg;
vm_checkgc_pcnext();
@@ -1044,12 +997,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
vm_commit();
janet_panicv(retreg);
}
fiber->child = child;
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
JanetSignal sig = janet_continue(child, stack[C], &retreg);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
@@ -1080,25 +1029,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_return((int) sub_status, stack[B]);
}
VM_OP(JOP_CANCEL) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
vm_commit();
janet_panicv(retreg);
}
fiber->child = child;
JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
vm_checkgc_pcnext();
}
VM_OP(JOP_PUT)
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
@@ -1288,14 +1218,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Push frame */
janet_fiber_pushn(janet_vm_fiber, argv, argc);
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
int32_t min = fun->def->min_arity;
int32_t max = fun->def->max_arity;
Janet funv = janet_wrap_function(fun);
if (min == max && min != argc)
janet_panicf("arity mismatch in %v, expected %d, got %d", funv, min, argc);
if (min >= 0 && argc < min)
janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
}
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
@@ -1311,14 +1234,15 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
janet_vm_stackn = oldn;
janet_gcunlock(handle);
if (signal != JANET_SIGNAL_OK) {
janet_panicv(*janet_vm_return_reg);
}
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
return *janet_vm_return_reg;
}
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
jmp_buf buf;
/* Check conditions */
JanetFiberStatus old_status = janet_fiber_status(fiber);
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
@@ -1335,71 +1259,17 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
*out = janet_wrap_string(str);
return JANET_SIGNAL_ERROR;
}
return JANET_SIGNAL_OK;
}
void janet_try_init(JanetTryState *state) {
state->stackn = janet_vm_stackn++;
state->gc_handle = janet_vm_gc_suspend;
state->vm_fiber = janet_vm_fiber;
state->vm_jmp_buf = janet_vm_jmp_buf;
state->vm_return_reg = janet_vm_return_reg;
janet_vm_return_reg = &(state->payload);
janet_vm_jmp_buf = &(state->buf);
}
void janet_restore(JanetTryState *state) {
janet_vm_stackn = state->stackn;
janet_vm_gc_suspend = state->gc_handle;
janet_vm_fiber = state->vm_fiber;
janet_vm_jmp_buf = state->vm_jmp_buf;
janet_vm_return_reg = state->vm_return_reg;
}
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
JanetFiberStatus old_status = janet_fiber_status(fiber);
#ifdef JANET_EV
janet_fiber_did_resume(fiber);
#endif
/* Clear last value */
fiber->last_value = janet_wrap_nil();
/* Continue child fiber if it exists */
if (fiber->child) {
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
JanetFiber *child = fiber->child;
uint32_t instr = (janet_stack_frame(fiber->data + fiber->frame)->pc)[0];
janet_vm_stackn++;
JanetSignal sig = janet_continue(child, in, &in);
janet_vm_stackn--;
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
*out = in;
janet_fiber_set_status(fiber, sig);
return sig;
}
/* Check if we need any special handling for certain opcodes */
switch (instr & 0x7F) {
default:
break;
case JOP_NEXT: {
if (sig == JANET_SIGNAL_OK ||
sig == JANET_SIGNAL_ERROR ||
sig == JANET_SIGNAL_USER0 ||
sig == JANET_SIGNAL_USER1 ||
sig == JANET_SIGNAL_USER2 ||
sig == JANET_SIGNAL_USER3 ||
sig == JANET_SIGNAL_USER4) {
in = janet_wrap_nil();
} else {
in = janet_wrap_integer(0);
}
break;
}
}
fiber->child = NULL;
}
@@ -1417,46 +1287,45 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
}
/* Save global state */
JanetTryState tstate;
JanetSignal sig = janet_try(&tstate);
if (!sig) {
/* Normal setup */
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
janet_vm_fiber = fiber;
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
sig = run_vm(fiber, in);
int32_t oldn = janet_vm_stackn++;
int handle = janet_vm_gc_suspend;
JanetFiber *old_vm_fiber = janet_vm_fiber;
jmp_buf *old_vm_jmp_buf = janet_vm_jmp_buf;
Janet *old_vm_return_reg = janet_vm_return_reg;
/* Setup fiber */
janet_vm_fiber = fiber;
janet_gcroot(janet_wrap_fiber(fiber));
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
janet_vm_return_reg = out;
janet_vm_jmp_buf = &buf;
/* Run loop */
JanetSignal signal;
int jmpsig;
#if defined(JANET_BSD) || defined(JANET_APPLE)
jmpsig = _setjmp(buf);
#else
jmpsig = setjmp(buf);
#endif
if (jmpsig) {
signal = (JanetSignal) jmpsig;
} else {
signal = run_vm(fiber, in);
}
/* Restore */
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
janet_fiber_set_status(fiber, sig);
janet_restore(&tstate);
fiber->last_value = tstate.payload;
*out = tstate.payload;
/* Tear down fiber */
janet_fiber_set_status(fiber, signal);
janet_gcunroot(janet_wrap_fiber(fiber));
return sig;
}
/* Restore global state */
janet_vm_gc_suspend = handle;
janet_vm_fiber = old_vm_fiber;
janet_vm_stackn = oldn;
janet_vm_return_reg = old_vm_return_reg;
janet_vm_jmp_buf = old_vm_jmp_buf;
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Check conditions */
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
if (tmp_signal) return tmp_signal;
return janet_continue_no_check(fiber, in, out);
}
/* Enter the main vm loop but immediately raise a signal */
JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
if (tmp_signal) return tmp_signal;
if (sig != JANET_SIGNAL_OK) {
JanetFiber *child = fiber;
while (child->child) child = child->child;
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
child->flags |= JANET_FIBER_RESUME_SIGNAL;
}
return janet_continue_no_check(fiber, in, out);
return signal;
}
JanetSignal janet_pcall(
@@ -1496,8 +1365,11 @@ int janet_init(void) {
/* Garbage collection */
janet_vm_blocks = NULL;
janet_vm_next_collection = 0;
janet_vm_gc_interval = 0x400000;
janet_vm_block_count = 0;
/* Setting memoryInterval to zero forces
* a collection pretty much every cycle, which is
* incredibly horrible for performance, but can help ensure
* there are no memory bugs during development */
janet_vm_gc_interval = 0x10000;
janet_symcache_init();
/* Initialize gc roots */
janet_vm_roots = NULL;
@@ -1512,28 +1384,13 @@ int janet_init(void) {
janet_vm_abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_registry));
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
/* Traversal */
janet_vm_traversal = NULL;
janet_vm_traversal_base = NULL;
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Dynamic bindings */
janet_vm_top_dyns = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);
/* Fibers */
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;
janet_vm_stackn = 0;
/* Threads */
#ifdef JANET_THREADS
janet_threads_init();
#endif
#ifdef JANET_EV
janet_ev_init();
#endif
#ifdef JANET_NET
janet_net_init();
#endif
return 0;
}
@@ -1549,17 +1406,7 @@ void janet_deinit(void) {
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
janet_vm_top_dyns = NULL;
free(janet_vm_traversal_base);
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;
#ifdef JANET_THREADS
janet_threads_deinit();
#endif
#ifdef JANET_EV
janet_ev_deinit();
#endif
#ifdef JANET_NET
janet_net_deinit();
#endif
}

View File

@@ -20,8 +20,6 @@
* IN THE SOFTWARE.
*/
#include "janetconf.h"
#ifndef JANET_H_defined
#define JANET_H_defined
@@ -29,14 +27,10 @@
extern "C" {
#endif
/* Variable length arrays are ok */
#ifdef _MSC_VER
#pragma warning( push )
#pragma warning( disable : 4200 )
#endif
/***** START SECTION CONFIG *****/
#include "janetconf.h"
#ifndef JANET_VERSION
#define JANET_VERSION "latest"
#endif
@@ -127,21 +121,9 @@ extern "C" {
#define JANET_LITTLE_ENDIAN 1
#endif
/* Limits for converting doubles to 64 bit integers */
#define JANET_INTMAX_DOUBLE 9007199254740992.0
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
#define JANET_INTMAX_INT64 9007199254740992
#define JANET_INTMIN_INT64 (-9007199254740992)
/* Check emscripten */
#ifdef __EMSCRIPTEN__
#define JANET_NO_DYNAMIC_MODULES
#define JANET_NO_PROCESSES
#endif
/* Check sun */
#ifdef __sun
#define JANET_NO_UTC_MKTIME
#endif
/* Define how global janet state is declared */
@@ -177,16 +159,6 @@ extern "C" {
#define JANET_TYPED_ARRAY
#endif
/* Enable or disable event loop */
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
#define JANET_EV
#endif
/* Enable or disable networking */
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#define JANET_NET
#endif
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
#ifndef JANET_NO_INT_TYPES
#define JANET_INT_TYPES
@@ -206,7 +178,7 @@ extern "C" {
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
#else
#define JANET_NO_RETURN __attribute__((noreturn))
#define JANET_NO_RETURN __attribute__ ((noreturn))
#endif
#endif
@@ -230,11 +202,6 @@ extern "C" {
* To turn of nanboxing, for debugging purposes or for certain
* architectures (Nanboxing only tested on x86 and x64), comment out
* the JANET_NANBOX define.*/
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
#define JANET_NO_NANBOX
#endif
#ifndef JANET_NO_NANBOX
#ifdef JANET_32
#define JANET_NANBOX_32
@@ -272,22 +239,11 @@ typedef struct {
} JanetBuildConfig;
/* Get config of current compilation unit. */
#ifdef __cplusplus
/* C++11 syntax */
#define janet_config_current() (JanetBuildConfig { \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#else
/* C99 syntax */
#define janet_config_current() ((JanetBuildConfig){ \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#endif
/***** END SECTION CONFIG *****/
@@ -315,15 +271,6 @@ JANET_API extern const char *const janet_type_names[16];
JANET_API extern const char *const janet_signal_names[14];
JANET_API extern const char *const janet_status_names[16];
/* For various IO routines, we want to use an int on posix and HANDLE on windows */
#ifdef JANET_WINDOWS
typedef void *JanetHandle;
#define JANET_HANDLE_NONE NULL
#else
typedef int JanetHandle;
#define JANET_HANDLE_NONE (-1)
#endif
/* Fiber signals */
typedef enum {
JANET_SIGNAL_OK,
@@ -342,8 +289,6 @@ typedef enum {
JANET_SIGNAL_USER9
} JanetSignal;
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
/* Fiber statuses - mostly corresponds to signals. */
typedef enum {
JANET_STATUS_DEAD,
@@ -364,6 +309,14 @@ typedef enum {
JANET_STATUS_ALIVE
} JanetFiberStatus;
#ifdef JANET_NANBOX_64
typedef union Janet Janet;
#elif defined(JANET_NANBOX_32)
typedef union Janet Janet;
#else
typedef struct Janet Janet;
#endif
/* Use type punning for GC objects */
typedef struct JanetGCObject JanetGCObject;
@@ -394,6 +347,15 @@ typedef struct JanetByteView JanetByteView;
typedef struct JanetDictView JanetDictView;
typedef struct JanetRange JanetRange;
typedef struct JanetRNG JanetRNG;
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
/* String and other aliased pointer types */
typedef const uint8_t *JanetString;
typedef const uint8_t *JanetSymbol;
typedef const uint8_t *JanetKeyword;
typedef const Janet *JanetTuple;
typedef const JanetKV *JanetStruct;
typedef void *JanetAbstract;
/* Basic types for all Janet Values */
typedef enum JanetType {
@@ -415,61 +377,6 @@ typedef enum JanetType {
JANET_POINTER
} JanetType;
/* Recursive type (Janet) */
#ifdef JANET_NANBOX_64
typedef union Janet Janet;
union Janet {
uint64_t u64;
int64_t i64;
double number;
void *pointer;
};
#elif defined(JANET_NANBOX_32)
typedef union Janet Janet;
union Janet {
struct {
#ifdef JANET_BIG_ENDIAN
uint32_t type;
union {
int32_t integer;
void *pointer;
} payload;
#else
union {
int32_t integer;
void *pointer;
} payload;
uint32_t type;
#endif
} tagged;
double number;
uint64_t u64;
};
#else
typedef struct Janet Janet;
struct Janet {
union {
uint64_t u64;
double number;
int32_t integer;
void *pointer;
const void *cpointer;
} as;
JanetType type;
};
#endif
/* C functions */
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
/* String and other aliased pointer types */
typedef const uint8_t *JanetString;
typedef const uint8_t *JanetSymbol;
typedef const uint8_t *JanetKeyword;
typedef const Janet *JanetTuple;
typedef const JanetKV *JanetStruct;
typedef void *JanetAbstract;
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
/* Type flags */
@@ -497,75 +404,6 @@ typedef void *JanetAbstract;
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
/* Event Loop Types */
#ifdef JANET_EV
#define JANET_STREAM_CLOSED 0x1
#define JANET_STREAM_SOCKET 0x2
#define JANET_STREAM_IOCP 0x4
#define JANET_STREAM_READABLE 0x200
#define JANET_STREAM_WRITABLE 0x400
#define JANET_STREAM_ACCEPTABLE 0x800
#define JANET_STREAM_UDPSERVER 0x1000
typedef enum {
JANET_ASYNC_EVENT_INIT,
JANET_ASYNC_EVENT_MARK,
JANET_ASYNC_EVENT_DEINIT,
JANET_ASYNC_EVENT_CLOSE,
JANET_ASYNC_EVENT_ERR,
JANET_ASYNC_EVENT_HUP,
JANET_ASYNC_EVENT_READ,
JANET_ASYNC_EVENT_WRITE,
JANET_ASYNC_EVENT_CANCEL,
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_USER
} JanetAsyncEvent;
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
typedef enum {
JANET_ASYNC_STATUS_NOT_DONE,
JANET_ASYNC_STATUS_DONE
} JanetAsyncStatus;
/* Typedefs */
typedef struct JanetListenerState JanetListenerState;
typedef struct JanetStream JanetStream;
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
/* Wrapper around file descriptors and HANDLEs that can be polled. */
struct JanetStream {
JanetHandle handle;
uint32_t flags;
/* Linked list of all in-flight IO routines for this stream */
JanetListenerState *state;
const void *methods; /* Methods for this stream */
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
* this constraint may be lifted later but allowing such would require more internal book keeping
* for some implementations. You can read and write at the same time on the same stream, though. */
int _mask;
};
/* Interface for state machine based event loop */
struct JanetListenerState {
JanetListener machine;
JanetFiber *fiber;
JanetStream *stream;
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
implementation of the event loop and the particular event. */
#ifdef JANET_WINDOWS
void *tag; /* Used to associate listeners with an overlapped structure */
int bytes; /* Used to track how many bytes were transfered. */
#endif
/* internal */
size_t _index;
int _mask;
JanetListenerState *_next;
};
#endif
/* We provide three possible implementations of Janets. The preferred
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
* application must interact through exposed interface. */
@@ -647,6 +485,13 @@ JANET_API Janet janet_wrap_integer(int32_t x);
#include <math.h>
/* 64 Nanboxed Janet value */
union Janet {
uint64_t u64;
int64_t i64;
double number;
void *pointer;
};
#define janet_u64(x) ((x).u64)
#define JANET_NANBOX_TAGBITS 0xFFFF800000000000llu
@@ -655,14 +500,14 @@ JANET_API Janet janet_wrap_integer(int32_t x);
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
#define janet_type(x) \
(isnan((x).number) \
? (JanetType) (((x).u64 >> 47) & 0xF) \
? (((x).u64 >> 47) & 0xF) \
: JANET_NUMBER)
#define janet_nanbox_checkauxtype(x, type) \
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
#define janet_nanbox_isnumber(x) \
(!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
#define janet_checktype(x, t) \
(((t) == JANET_NUMBER) \
@@ -731,10 +576,31 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#elif defined(JANET_NANBOX_32)
/* 32 bit nanboxed janet */
union Janet {
struct {
#ifdef JANET_BIG_ENDIAN
uint32_t type;
union {
int32_t integer;
void *pointer;
} payload;
#else
union {
int32_t integer;
void *pointer;
} payload;
uint32_t type;
#endif
} tagged;
double number;
uint64_t u64;
};
#define JANET_DOUBLE_OFFSET 0xFFFF
#define janet_u64(x) ((x).u64)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
: (x).tagged.type == (t))
@@ -781,6 +647,18 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#else
/* A general janet value type for more standard C */
struct Janet {
union {
uint64_t u64;
double number;
int32_t integer;
void *pointer;
const void *cpointer;
} as;
JanetType type;
};
#define janet_u64(x) ((x).as.u64)
#define janet_type(x) ((x).type)
#define janet_checktype(x, t) ((x).type == (t))
@@ -811,7 +689,7 @@ JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -833,21 +711,11 @@ struct JanetFiber {
int32_t frame; /* Index of the stack frame */
int32_t stackstart; /* Beginning of next args */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity; /* How big is the stack memory */
int32_t capacity;
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
JanetTable *env; /* Dynamic bindings table (usually current environment). */
Janet *data; /* Dynamically resized stack memory */
Janet *data;
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
Janet last_value; /* Last returned value from a fiber */
#ifdef JANET_EV
/* These fields are only relevant for fibers that are used as "root fibers" -
* that is, fibers that are scheduled on the event loop and behave much like threads
* in a multi-tasking system. It would be possible to move these fields to a new
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
JanetListenerState *waiting;
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
void *supervisor_channel; /* Channel to push self to when complete */
#endif
};
/* Mark if a stack frame is a tail call for debugging */
@@ -865,9 +733,8 @@ struct JanetStackFrame {
int32_t flags;
};
/* Number of Janets a frame takes up in the stack
* Should be constant across architectures */
#define JANET_FRAME_SIZE 4
/* Number of Janets a frame takes up in the stack */
#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet))
/* A dynamic array type. */
struct JanetArray {
@@ -1111,22 +978,9 @@ struct JanetRNG {
typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int32_t flags;
int flags;
};
/* For janet_try and janet_restore */
typedef struct {
/* old state */
int32_t stackn;
int gc_handle;
JanetFiber *vm_fiber;
jmp_buf *vm_jmp_buf;
Janet *vm_return_reg;
/* new state */
jmp_buf buf;
Janet payload;
} JanetTryState;
/* Thread types */
#ifdef JANET_THREADS
typedef struct JanetThread JanetThread;
@@ -1246,9 +1100,6 @@ enum JanetOpCode {
JOP_GREATER_THAN_EQUAL,
JOP_LESS_THAN_EQUAL,
JOP_NEXT,
JOP_NOT_EQUALS,
JOP_NOT_EQUALS_IMMEDIATE,
JOP_CANCEL,
JOP_INSTRUCTION_COUNT
};
@@ -1259,107 +1110,6 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** START SECTION MAIN *****/
#ifdef JANET_EV
extern JANET_API const JanetAbstractType janet_stream_type;
/* Run the event loop */
JANET_API void janet_loop(void);
/* Wrapper around streams */
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
JANET_API void janet_stream_close(JanetStream *stream);
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_chunk(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_write(int32_t argc, Janet *argv);
JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
/* Queue a fiber to run on the event loop */
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Start a state machine listening for events from a stream */
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
/* Shorthand for yielding to event loop in C */
JANET_NO_RETURN JANET_API void janet_await(void);
JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
/* For use inside listeners - adds a timeout to the current fiber, such that
* it will be resumed after sec seconds if no other event schedules the current fiber. */
JANET_API void janet_addtimeout(double sec);
JANET_API void janet_ev_inc_refcount(void);
JANET_API void janet_ev_dec_refcount(void);
/* Get last error from a an IO operation */
JANET_API Janet janet_ev_lasterr(void);
/* Async service for calling a function or syscall in a background thread. This is not
* as efficient in the slightest as using Streams but can be used for arbitrary blocking
* functions and syscalls. */
/* Used to pass data between the main thread and worker threads for simple tasks.
* We could just use a pointer but this prevents malloc/free in the common case
* of only a handful of arguments. */
typedef struct {
int tag;
int argi;
void *argp;
JanetFiber *fiber;
} JanetEVGenericMessage;
/* How to resume or cancel after a threaded call. Not exhaustive of the possible
* ways one might want to resume after returning from a threaded call, but should
* cover most of the common cases. For something more complicated, such as resuming
* with an abstract type or a struct, one should use janet_ev_threaded_call instead
* of janet_ev_threaded_await with a custom callback. */
#define JANET_EV_TCTAG_NIL 0 /* resume with nil */
#define JANET_EV_TCTAG_INTEGER 1 /* resume with janet_wrap_integer(argi) */
#define JANET_EV_TCTAG_STRING 2 /* resume with janet_cstringv((const char *) argp) */
#define JANET_EV_TCTAG_STRINGF 3 /* resume with janet_cstringv((const char *) argp), then call free on argp. */
#define JANET_EV_TCTAG_KEYWORD 4 /* resume with janet_ckeywordv((const char *) argp) */
#define JANET_EV_TCTAG_ERR_STRING 5 /* cancel with janet_cstringv((const char *) argp) */
#define JANET_EV_TCTAG_ERR_STRINGF 6 /* cancel with janet_cstringv((const char *) argp), then call free on argp. */
#define JANET_EV_TCTAG_ERR_KEYWORD 7 /* cancel with janet_ckeywordv((const char *) argp) */
#define JANET_EV_TCTAG_BOOLEAN 8 /* resume with janet_wrap_boolean(argi) */
/* Function pointer that is run in the thread pool */
typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments);
/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine */
typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value);
/* API calls for quickly offloading some work in C to a new thread or thread pool. */
JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb);
JANET_NO_RETURN JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
/* Callback used by janet_ev_threaded_await */
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
/* Read async from a stream */
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
#ifdef JANET_NET
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
#endif
/* Write async to a stream */
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
#ifdef JANET_NET
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
#endif
#endif
/* Parsing */
extern JANET_API const JanetAbstractType janet_parser_type;
JANET_API void janet_parser_init(JanetParser *parser);
@@ -1367,7 +1117,6 @@ JANET_API void janet_parser_deinit(JanetParser *parser);
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
JANET_API Janet janet_parser_produce(JanetParser *parser);
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
JANET_API const char *janet_parser_error(JanetParser *parser);
JANET_API void janet_parser_flush(JanetParser *parser);
JANET_API void janet_parser_eof(JanetParser *parser);
@@ -1407,7 +1156,6 @@ JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetS
/* Get the default environment for janet */
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
@@ -1460,7 +1208,6 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@@ -1469,6 +1216,8 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
JANET_API Janet *janet_tuple_begin(int32_t length);
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
/* String/Symbol functions */
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
@@ -1488,8 +1237,7 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
JANET_API JanetString janet_formatc(const char *format, ...);
JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...);
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
/* Symbol functions */
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
@@ -1506,7 +1254,6 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@@ -1515,6 +1262,8 @@ JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
JANET_API JanetStruct janet_struct_end(JanetKV *st);
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
/* Table functions */
@@ -1531,14 +1280,12 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
JANET_API JanetFiber *janet_current_fiber(void);
JANET_API JanetFiber *janet_root_fiber(void);
/* Treat similar types through uniform interfaces for iteration */
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
@@ -1549,7 +1296,6 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
/* Abstract */
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
#define janet_abstract_from_head(gcobject) ((JanetAbstract)((char *)gcobject + offsetof(JanetAbstractHead, data)))
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
@@ -1562,8 +1308,6 @@ typedef JanetBuildConfig(*JanetModconf)(void);
JANET_API JanetModule janet_native(const char *name, JanetString *error);
/* Marshaling */
#define JANET_MARSHAL_UNSAFE 0x20000
JANET_API void janet_marshal(
JanetBuffer *buf,
Janet x,
@@ -1598,21 +1342,13 @@ JANET_API int janet_verify(JanetFuncDef *def);
/* Pretty printing */
#define JANET_PRETTY_COLOR 1
#define JANET_PRETTY_ONELINE 2
#define JANET_PRETTY_NOTRUNC 4
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
/* Misc */
#ifdef JANET_PRF
#ifndef JANET_NO_PRF
#define JANET_HASH_KEY_SIZE 16
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
#endif
JANET_API void janet_try_init(JanetTryState *state);
#if defined(JANET_BSD) || defined(JANET_APPLE)
#define janet_try(state) (janet_try_init(state), (JanetSignal) _setjmp((state)->buf))
#else
#define janet_try(state) (janet_try_init(state), (JanetSignal) setjmp((state)->buf))
#endif
JANET_API void janet_restore(JanetTryState *state);
JANET_API int janet_equals(Janet x, Janet y);
JANET_API int32_t janet_hash(Janet x);
JANET_API int janet_compare(Janet x, Janet y);
@@ -1630,13 +1366,11 @@ JANET_API Janet janet_wrap_number_safe(double x);
JANET_API int janet_keyeq(Janet x, const char *cstring);
JANET_API int janet_streq(Janet x, const char *cstring);
JANET_API int janet_symeq(Janet x, const char *cstring);
JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
/* VM functions */
JANET_API int janet_init(void);
JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
@@ -1662,7 +1396,6 @@ typedef enum {
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
JANET_API void janet_register(const char *name, JanetCFunction cfun);
@@ -1671,23 +1404,15 @@ JANET_API Janet janet_resolve_core(const char *name);
/* New C API */
/* Shorthand for janet C function declarations */
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
/* Allow setting entry name for static libraries */
#ifdef __cplusplus
#define JANET_MODULE_PREFIX extern "C"
#else
#define JANET_MODULE_PREFIX
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_MODULE_PREFIX JANET_API void _janet_init
JANET_API void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
#endif
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
@@ -1704,7 +1429,6 @@ JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
JANET_API int janet_getmethod(JanetKeyword method, const JanetMethod *methods, Janet *out);
JANET_API Janet janet_nextmethod(const JanetMethod *methods, Janet key);
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
@@ -1773,18 +1497,12 @@ extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_BINARY 64
#define JANET_FILE_SERIALIZABLE 128
#define JANET_FILE_PIPED 256
#define JANET_FILE_NONIL 512
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
JANET_API JanetFile *janet_makejfile(FILE *f, int32_t flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
JANET_API Janet janet_makefile(FILE *f, int flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
JANET_API JanetAbstract janet_checkfile(Janet j);
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
JANET_API int janet_file_close(JanetFile *file);
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
/* Marshal API */
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
@@ -1837,21 +1555,13 @@ typedef enum {
RULE_ERROR, /* [rule] */
RULE_DROP, /* [rule] */
RULE_BACKMATCH, /* [tag] */
RULE_TO, /* [rule] */
RULE_THRU, /* [rule] */
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF /* [rule, tag] */
} JanetPegOpcod;
} JanetPegOpcode;
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
int has_backref;
} JanetPeg;
#endif
@@ -1936,17 +1646,11 @@ extern JANET_API const JanetAbstractType janet_thread_type;
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
JANET_API JanetThread *janet_thread_current(void);
#endif
/***** END SECTION MAIN *****/
/* Re-enable popped variable length array warnings */
#ifdef _MSC_VER
#pragma warning( pop )
#endif
#ifdef __cplusplus
}
#endif

View File

@@ -40,8 +40,6 @@ void janet_line_deinit();
void janet_line_get(const char *p, JanetBuffer *buffer);
Janet janet_line_getter(int32_t argc, Janet *argv);
static JANET_THREAD_LOCAL int gbl_cancel_current_repl_form = 0;
/*
* Line Editing
*/
@@ -56,17 +54,7 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
janet_line_get(str, buf);
gbl_complete_env = NULL;
Janet result;
if (gbl_cancel_current_repl_form) {
gbl_cancel_current_repl_form = 0;
/* Signal that the user bailed out of the current form */
result = janet_ckeywordv("cancel");
} else {
result = janet_wrap_buffer(buf);
}
return result;
return janet_wrap_buffer(buf);
}
static void simpleline(JanetBuffer *buffer) {
@@ -84,7 +72,7 @@ static void simpleline(JanetBuffer *buffer) {
}
/* Windows */
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
#ifdef JANET_WINDOWS
void janet_line_init() {
;
@@ -170,7 +158,7 @@ static int rawmode(void) {
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
t.c_cc[VMIN] = 1;
t.c_cc[VTIME] = 0;
if (tcsetattr(STDIN_FILENO, TCSADRAIN, &t) < 0) goto fatal;
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
gbl_israwmode = 1;
return 0;
fatal:
@@ -180,7 +168,7 @@ fatal:
/* Disable raw mode */
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
gbl_israwmode = 0;
}
@@ -527,147 +515,6 @@ static void check_specials(JanetByteView src) {
check_cmatch(src, "while");
}
static void resolve_format(JanetTable *entry) {
int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro")));
Janet refv = janet_table_get(entry, janet_ckeywordv("ref"));
int is_ref = janet_checktype(refv, JANET_ARRAY);
Janet value = janet_wrap_nil();
if (is_ref) {
JanetArray *a = janet_unwrap_array(refv);
if (a->count) value = a->data[0];
} else {
value = janet_table_get(entry, janet_ckeywordv("value"));
}
if (is_macro) {
fprintf(stderr, " macro\n");
gbl_lines_below++;
} else if (is_ref) {
janet_eprintf(" var (%t)\n", value);
gbl_lines_below++;
} else {
janet_eprintf(" %t\n", value);
gbl_lines_below++;
}
Janet sm = janet_table_get(entry, janet_ckeywordv("source-map"));
Janet path = janet_get(sm, janet_wrap_integer(0));
Janet line = janet_get(sm, janet_wrap_integer(1));
Janet col = janet_get(sm, janet_wrap_integer(2));
if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) {
janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col);
gbl_lines_below++;
}
}
static void doc_format(JanetString doc, int32_t width) {
int32_t maxcol = width - 8;
uint8_t wordbuf[256] = {0};
int32_t wordp = 0;
int32_t current = 0;
if (maxcol > 200) maxcol = 200;
fprintf(stderr, " ");
for (int32_t i = 0; i < janet_string_length(doc); i++) {
uint8_t b = doc[i];
switch (b) {
default: {
if (maxcol <= current + wordp + 1) {
if (!current) {
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
wordbuf[wordp++] = b;
break;
}
case '\t': {
if (maxcol <= current + wordp + 2) {
if (!current) {
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
wordbuf[wordp++] = ' ';
wordbuf[wordp++] = ' ';
break;
}
case '\n':
case ' ': {
if (wordp) {
int32_t oldcur = current;
int spacer = maxcol > current + wordp + 1;
if (spacer) current++;
else current = 0;
current += wordp;
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
if (oldcur && !spacer) gbl_lines_below++;
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
if (b == '\n') {
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
}
}
}
if (wordp) {
int32_t oldcur = current;
int spacer = maxcol > current + wordp + 1;
if (spacer) current++;
else current = 0;
current += wordp + 1;
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
if (oldcur && !spacer) gbl_lines_below++;
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
}
static void find_matches(JanetByteView prefix) {
JanetTable *env = gbl_complete_env;
gbl_match_count = 0;
while (NULL != env) {
JanetKV *kvend = env->data + env->capacity;
for (JanetKV *kv = env->data; kv < kvend; kv++) {
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
const uint8_t *sym = janet_unwrap_symbol(kv->key);
check_match(prefix, sym, janet_string_length(sym));
}
env = env->proto;
}
}
static void kshowdoc(void) {
if (!gbl_complete_env) return;
while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++;
JanetByteView prefix = get_symprefix();
Janet symbol = janet_symbolv(prefix.bytes, prefix.len);
Janet entry = janet_table_get(gbl_complete_env, symbol);
if (!janet_checktype(entry, JANET_TABLE)) return;
Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc"));
if (!janet_checktype(doc, JANET_STRING)) return;
JanetString docs = janet_unwrap_string(doc);
int num_cols = getcols();
clearlines();
fprintf(stderr, "\n\n\n");
gbl_lines_below += 3;
resolve_format(janet_unwrap_table(entry));
fprintf(stderr, "\n");
gbl_lines_below += 1;
doc_format(docs, num_cols);
fprintf(stderr, "\n\n");
gbl_lines_below += 2;
/* Go up to original line (zsh-like autocompletion) */
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
fflush(stderr);
}
static void kshowcomp(void) {
JanetTable *env = gbl_complete_env;
if (env == NULL) {
@@ -681,9 +528,19 @@ static void kshowcomp(void) {
gbl_pos++;
JanetByteView prefix = get_symprefix();
if (prefix.len == 0) return;
if (prefix.len == 0) return;
find_matches(prefix);
/* Find all matches */
gbl_match_count = 0;
while (NULL != env) {
JanetKV *kvend = env->data + env->capacity;
for (JanetKV *kv = env->data; kv < kvend; kv++) {
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
const uint8_t *sym = janet_unwrap_symbol(kv->key);
check_match(prefix, sym, janet_string_length(sym));
}
env = env->proto;
}
check_specials(prefix);
@@ -747,7 +604,7 @@ static int line() {
switch (c) {
default:
if ((unsigned char) c < 0x20) break;
if (c < 0x20) break;
if (insert(c, 1)) return -1;
break;
case 1: /* ctrl-a */
@@ -758,11 +615,8 @@ static int line() {
kleft();
break;
case 3: /* ctrl-c */
clearlines();
errno = EAGAIN;
gbl_sigint_flag = 1;
return -1;
case 17: /* ctrl-q */
gbl_cancel_current_repl_form = 1;
clearlines();
return -1;
case 4: /* ctrl-d, eof */
@@ -779,10 +633,6 @@ static int line() {
case 6: /* ctrl-f */
kright();
break;
case 7: /* ctrl-g */
kshowdoc();
refresh();
break;
case 127: /* backspace */
case 8: /* ctrl-h */
kbackspace(1);
@@ -1000,28 +850,6 @@ int main(int argc, char **argv) {
SetConsoleOutputCP(65001);
#endif
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
/* Try and not leave the terminal in a bad state */
atexit(norawmode);
#endif
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
char *envvar = getenv("JANET_HASHSEED");
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
}
janet_init_hash_key(hash_key);
#endif
/* Set up VM */
janet_init();
@@ -1042,24 +870,15 @@ int main(int argc, char **argv) {
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
/* Run startup script */
Janet mainfun;
Janet mainfun, out;
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
fiber->env = env;
#ifdef JANET_EV
janet_gcroot(janet_wrap_fiber(fiber));
janet_schedule(fiber, janet_wrap_nil());
janet_loop();
status = janet_fiber_status(fiber);
#else
Janet out;
status = janet_continue(fiber, janet_wrap_nil(), &out);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, out);
}
#endif
/* Deinitialize vm */
janet_deinit();

View File

@@ -1,45 +0,0 @@
#include <stdint.h>
#include <string.h>
#include <janet.h>
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
/* init Janet */
janet_init();
/* fuzz the parser */
JanetParser parser;
janet_parser_init(&parser);
for (int i = 0, done = 0; i < size; i++) {
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
case JANET_PARSE_ERROR:
done = 1;
break;
case JANET_PARSE_PENDING:
if (i == size) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, data[i]);
}
break;
case JANET_PARSE_ROOT:
if (i >= size) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, data[i]);
}
break;
}
if (done == 1)
break;
}
janet_parser_deinit(&parser);
/* cleanup Janet */
janet_deinit();
return 0;
}

View File

@@ -3,20 +3,25 @@
(var num-tests-passed 0)
(var num-tests-run 0)
(var suite-num 0)
(var numchecks 0)
(var start-time 0)
(defn assert
"Override's the default assert with some nice error handling."
[x &opt e]
(default e "assert error")
[x e]
(++ num-tests-run)
(when x (++ num-tests-passed))
(def str (string e))
(def truncated
(if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
(if x
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
(do
(when (= numchecks 25)
(set numchecks 0)
(print))
(++ numchecks)
(file/write stdout "\e[32m✔\e[0m"))
(do
(file/write stdout "\n\e[31m✘\e[0m ")
(set numchecks 0)
(print e)))
x)
(defmacro assert-error
@@ -32,10 +37,10 @@
(defn start-suite [x]
(set suite-num x)
(set start-time (os/clock))
(eprint "\nRunning test suite " x " tests...\n "))
(print "\nRunning test suite " x " tests...\n "))
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprintf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.\n")
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(print num-tests-passed " of " num-tests-run " tests passed.\n")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@@ -1,5 +1,4 @@
/build
/modpath
.cache
.manifests
json.*

View File

@@ -9,14 +9,6 @@
:name "testmod2"
:source @["testmod2.c"])
(declare-native
:name "testmod3"
:source @["testmod3.cpp"])
(declare-native
:name "test-mod-4"
:source @["testmod4.c"])
(declare-executable
:name "testexec"
:entry "testexec.janet")

View File

@@ -1,3 +1,3 @@
(import /build/testmod :as testmod)
(import build/testmod :as testmod)
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))

View File

@@ -1,8 +1,6 @@
(use /build/testmod)
(use /build/testmod2)
(use /build/testmod3)
(use /build/test-mod-4)
(use build/testmod)
(use build/testmod2)
(defn main [&]
(print "Hello from executable!")
(print (+ (get5) (get6) (get7) (get8))))
(print (+ (get5) (get6))))

View File

@@ -1,42 +0,0 @@
/*
* Copyright (c) 2020 Calvin Rose and contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/* A very simple native module */
#include <janet.h>
#include <iostream>
static Janet cfun_get_seven(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
std::cout << "Hello!" << std::endl;
return janet_wrap_number(7.0);
}
static const JanetReg array_cfuns[] = {
{"get7", cfun_get_seven, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

View File

@@ -1,40 +0,0 @@
/*
* Copyright (c) 2020 Calvin Rose and contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/* A very simple native module */
#include <janet.h>
static Janet cfun_get_eight(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(8.0);
}
static const JanetReg array_cfuns[] = {
{"get8", cfun_get_eight, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

View File

@@ -206,10 +206,6 @@
(def 🐮 :cow)
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
(assert (= "\U01F637" "😷") "unicode escape 1")
(assert (= "\u2623" "\U002623" "") "unicode escape 2")
(assert (= "\u24c2" "\U0024c2" "") "unicode escape 3")
(assert (= "\u0061" "a") "unicode escape 4")
# Symbols with @ character
@@ -254,11 +250,6 @@
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
# Gensym tests
(assert (not= (gensym) (gensym)) "two gensyms not equal")
@@ -328,94 +319,5 @@
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
# Struct and Table duplicate elements
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
## Polymorphic comparison -- Issue #272
# confirm polymorphic comparison delegation to primitive comparators:
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
(assert (= 0 (compare 1 1)) "compare integers (1)")
(assert (= -1 (compare 1 2)) "compare integers (2)")
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
(assert (compare< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"
(quote hello)
:hello
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "compare type ordering")
# test polymorphic compare with 'objects' (table/setproto)
(def mynum
@{:type :mynum :v 0 :compare
(fn [self other]
(case (type other)
:number (cmp (self :v) other)
:table (when (= (get other :type) :mynum)
(cmp (self :v) (other :v)))))})
(let [n3 (table/setproto @{:v 3} mynum)]
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
(assert (= -1 (compare n3 4)) "compare object to num (2)")
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
(assert (compare< 2 n3 4) "compare< poly")
(assert (compare> 4 n3 2) "compare> poly")
(assert (compare<= 2 3 n3 4) "compare<= poly")
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
(let [MAX_INT_64_STRING "9223372036854775807"
MAX_UINT_64_STRING "18446744073709551615"
MAX_INT_IN_DBL_STRING "9007199254740991"
NAN (math/log -1)
INF (/ 1 0)
MINUS_INF (/ -1 0)
compare-poly-tests
[[(int/s64 3) (int/u64 3) 0]
[(int/s64 -3) (int/u64 3) -1]
[(int/s64 3) (int/u64 2) 1]
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
[(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
(each [x y c] compare-poly-tests
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
(end-suite)

View File

@@ -1,166 +0,0 @@
# Copyright (c) 2021 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 9)
# Subprocess
(def janet (dyn :executable))
(repeat 10
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(os/proc-wait p)
(def x (:read (p :out) :all))
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn pre close."))
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(def x (:read (p :out) 1024))
(os/proc-wait p)
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn post close."))
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px {:in :pipe})]
(:write (p :in) "hello!\n")
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px {:in :pipe :out :pipe})]
(:write (p :in) "hello!\n")
(def x (:read (p :out) 1024))
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
# Parallel subprocesses
(defn calc-1
"Run subprocess, read from stdout, then wait on subprocess."
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
(os/proc-wait p)
(def output (:read (p :out) :all))
(parse output)))
(assert
(deep=
(ev/gather
(calc-1 "(+ 1 2 3 4)")
(calc-1 "(+ 5 6 7 8)")
(calc-1 "(+ 9 10 11 12)"))
@[10 26 42]) "parallel subprocesses 1")
(defn calc-2
"Run subprocess, wait on subprocess, then read from stdout. Read only up to 10 bytes instead of :all"
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
(def output (:read (p :out) 10))
(os/proc-wait p)
(parse output)))
(assert
(deep=
(ev/gather
(calc-2 "(+ 1 2 3 4)")
(calc-2 "(+ 5 6 7 8)")
(calc-2 "(+ 9 10 11 12)"))
@[10 26 42]) "parallel subprocesses 2")
# File piping
(assert-no-error "file writing 1"
(with [f (file/temp)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
(assert-no-error "file writing 2"
(with [f (file/open "unique.txt" :w)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
(file/flush f)))
# Issue #593
(assert-no-error "file writing 3"
(def outfile (file/open "unique.txt" :w))
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p {:out outfile})
(file/flush outfile)
(file/close outfile)
(os/rm "unique.txt"))
# ev/gather
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
(assert (deep= @[] (ev/gather)) "ev/gather 2")
(assert-error "ev/gather 3" (ev/gather 1 2 (error 3)))
# Net testing
(repeat 10
(defn handler
"Simple handler for connections."
[stream]
(defer (:close stream)
(def id (gensym))
(def b @"")
(net/read stream 1024 b)
(net/write stream b)
(buffer/clear b)))
(def s (net/server "127.0.0.1" "8000" handler))
(assert s "made server 1")
(defn test-echo [msg]
(with [conn (net/connect "127.0.0.1" "8000")]
(net/write conn msg)
(def res (net/read conn 1024))
(assert (= (string res) msg) (string "echo " msg))))
(test-echo "hello")
(test-echo "world")
(test-echo (string/repeat "abcd" 200))
(:close s))
# Create pipe
(var pipe-counter 0)
(def chan (ev/chan 10))
(let [[reader writer] (os/pipe)]
(ev/spawn
(while (ev/read reader 3)
(++ pipe-counter))
(assert (= 20 pipe-counter) "ev/pipe 1")
(ev/give chan 1))
(for i 0 10
(ev/write writer "xxx---"))
(ev/close writer)
(ev/take chan))
(var result nil)
(var fiber nil)
(set fiber
(ev/spawn
(set result (protect (ev/sleep 10)))
(assert (= result '(false "boop")) "ev/cancel 1")))
(ev/sleep 0)
(ev/cancel fiber "boop")
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
(end-suite)

View File

@@ -1,164 +0,0 @@
#- Copyright (c) 2020 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 10)
# index-of
(assert (= nil (index-of 10 [])) "index-of 1")
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
(assert (= nil (index-of :a {})) "index-of 5")
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
(assert (= nil (index-of (chr "a") "")) "index-of 9")
(assert (= nil (index-of 10 @[])) "index-of 10")
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
# Regression
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
# macex testing
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
# Cancel test
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1")
(assert (= 2 (resume f)) "cancel resume 2")
(assert (= :hi (cancel f :hi)) "cancel resume 3")
(assert (= :error (fiber/status f)) "cancel resume 4")
# Curenv
(assert (= (curenv) (curenv 0)) "curenv 1")
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
(assert (= nil (curenv 1000000)) "curenv 3")
(assert (= root-env (curenv 1)) "curenv 4")
# Import macro test
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
(assert (deep= ~(,import* "a" :as "b" :fresh maybe) (macex '(import a :as b :fresh maybe))) "import macro 2")
# #477 walk preserving bracket type
(assert (= :brackets (tuple/type (postwalk identity '[]))) "walk square brackets 1")
(assert (= :brackets (tuple/type (walk identity '[]))) "walk square brackets 2")
# # off by 1 error in inttypes
(assert (= (int/s64 "-0x8000_0000_0000_0000") (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
#
# Longstring indentation
#
(defn reindent
"Reindent a the contents of a longstring as the Janet parser would.
This include removing leading and trailing newlines."
[text indent]
# Detect minimum indent
(var rewrite true)
(each index (string/find-all "\n" text)
(for i (+ index 1) (+ index indent 1)
(case (get text i)
nil (break)
(chr "\n") (break)
(chr " ") nil
(set rewrite false))))
# Only re-indent if no dedented characters.
(def str
(if rewrite
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
text))
(def first-nl (= (chr "\n") (first str)))
(def last-nl (= (chr "\n") (last str)))
(string/slice str (if first-nl 1 0) (if last-nl -2)))
(defn reindent-reference
"Same as reindent but use parser functionality. Useful for validating conformance."
[text indent]
(if (empty? text) (break text))
(def source-code
(string (string/repeat " " indent) "``````"
text
"``````"))
(parse source-code))
(var indent-counter 0)
(defn check-indent
[text indent]
(++ indent-counter)
(let [a (reindent text indent)
b (reindent-reference text indent)]
(assert (= a b) (string "indent " indent-counter " (indent=" indent ")"))))
(check-indent "" 0)
(check-indent "\n" 0)
(check-indent "\n" 1)
(check-indent "\n\n" 0)
(check-indent "\n\n" 1)
(check-indent "\nHello, world!" 0)
(check-indent "\nHello, world!" 1)
(check-indent "Hello, world!" 0)
(check-indent "Hello, world!" 1)
(check-indent "\n Hello, world!" 4)
(check-indent "\n Hello, world!\n" 4)
(check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n dedented text\n " 4)
(check-indent "\n Hello, world!\n indented text\n " 4)
# String bugs
(assert (deep= (string/find-all "qq" "qqq") @[0 1]) "string/find-all 1")
(assert (deep= (string/find-all "q" "qqq") @[0 1 2]) "string/find-all 2")
(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
# Comparisons
(assert (> 1e23 100) "less than immediate 1")
(assert (> 1e23 1000) "less than immediate 2")
(assert (< 100 1e23) "greater than immediate 1")
(assert (< 1000 1e23) "greater than immediate 2")
# os/execute with environment variables
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
# Regression #638
(compwhen
(dyn 'ev/go)
(assert
(= [true :caught]
(protect
(try
(do
(ev/sleep 0)
(with-dyns []
(ev/sleep 0)
(error "oops")))
([err] :caught))))
"regression #638"))
(end-suite)

View File

@@ -281,38 +281,4 @@
(assert (not (even? -10.1)) "even? 8")
(assert (not (even? -10.6)) "even? 9")
# Map arities
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
# Sort function
(assert (deep=
(range 99)
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99))))) "sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# And and or
(assert (= (and true true) true) "and true true")
(assert (= (and true false) false) "and true false")
(assert (= (and false true) false) "and false true")
(assert (= (and true true true) true) "and true true true")
(assert (= (and 0 1 2) 2) "and 0 1 2")
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
(assert (= (and 1) 1) "and 1")
(assert (= (and) true) "and with no arguments")
(assert (= (or true true) true) "or true true")
(assert (= (or true false) true) "or true false")
(assert (= (or false true) true) "or false true")
(assert (= (or false false) false) "or false true")
(assert (= (or true true false) true) "or true true false")
(assert (= (or 0 1 2) 0) "or 0 1 2")
(assert (= (or nil 1 2) 1) "or nil 1 2")
(assert (= (or 1) 1) "or 1")
(assert (= (or) nil) "or with no arguments")
(end-suite)

View File

@@ -49,7 +49,7 @@
# Generators
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
(var gencount 0)
(loop [x :in gen]
(loop [x :generate gen]
(++ gencount)
(assert (pos? (% x 4)) "generate in loop"))
(assert (= gencount 75) "generate loop count")

View File

@@ -91,8 +91,8 @@
# Assembly test
# Fibonacci sequence, implemented with naive recursion.
(def fibasm (asm '{
:arity 1
:bytecode [
arity 1
bytecode [
(ltim 1 0 0x2) # $1 = $0 < 2
(jmpif 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
@@ -360,14 +360,6 @@
(check-match janet-longstring "``` `` ```" true)
(check-match janet-longstring "`` ```" false)
# Line and column capture
(def line-col (peg/compile '(any (* (line) (column) 1))))
(check-deep line-col "abcd" @[1 1 1 2 1 3 1 4])
(check-deep line-col "" @[])
(check-deep line-col "abcd\n" @[1 1 1 2 1 3 1 4 1 5])
(check-deep line-col "abcd\nz" @[1 1 1 2 1 3 1 4 1 5 2 1])
# Backmatch
(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
@@ -451,46 +443,4 @@
(check-match redef-b "aabeef" false)
(check-match redef-b "aaaaaa" false)
# Integer parsing
(check-deep '(int 1) "a" @[(chr "a")])
(check-deep '(uint 1) "a" @[(chr "a")])
(check-deep '(int-be 1) "a" @[(chr "a")])
(check-deep '(uint-be 1) "a" @[(chr "a")])
(check-deep '(int 1) "\xFF" @[-1])
(check-deep '(uint 1) "\xFF" @[255])
(check-deep '(int-be 1) "\xFF" @[-1])
(check-deep '(uint-be 1) "\xFF" @[255])
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(check-deep '(* (int 2) -1) "123" nil)
# to/thru bug
(check-deep '(to -1) "aaaa" @[])
(check-deep '(thru -1) "aaaa" @[])
(check-deep ''(to -1) "aaaa" @["aaaa"])
(check-deep ''(thru -1) "aaaa" @["aaaa"])
(check-deep '(to "b") "aaaa" nil)
(check-deep '(thru "b") "aaaa" nil)
# unref
(def grammar
(peg/compile
~{:main (* :tagged -1)
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
:open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
:value (* (constant :value) (group (any (+ :tagged :untagged))))
:close-tag (* "</" (backmatch :tag-name) ">")
:untagged (capture (any (if-not "<" 1)))}))
(check-deep grammar "<p><em>foobar</em></p>" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
(end-suite)

View File

@@ -48,9 +48,7 @@
(defn check-image
"Run a marshaling test using the make-image and load-image functions."
[x msg]
(def im (make-image x))
# (printf "\nimage-hash: %d" (-> im string hash))
(assert-no-error msg (load-image im)))
(assert-no-error msg (load-image (make-image x))))
(check-image (fn [] (fn [] 1)) "marshal nested functions")
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")

View File

@@ -58,17 +58,6 @@
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
# Issue 408
(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
(def ta (tarray/new :int32 10))
(assert (= (next a nil) 0) "tarray next 1")
(assert (= (next a 0) 1) "tarray next 2")
(assert (= (next a 8) 9) "tarray next 3")
(assert (nil? (next a 9)) "tarray next 4")
(put ta 3 7)
(put ta 9 7)
(assert (= 2 (count |(= $ 7) ta)) "tarray count")
# Array remove
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")

View File

@@ -128,18 +128,6 @@
(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
# Parser line and column numbers
(defn parser-location [input &opt location]
(def p (parser/new))
(parser/consume p input)
(if location
(parser/where p ;location)
(parser/where p)))
(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
# String check-set
(assert (string/check-set "abc" "a") "string/check-set 1")
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
@@ -190,39 +178,4 @@
(assert (= (test-expand "../def.txt" ":all:") "../def.txt") "module/expand-path 7")
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt") "module/expand-path 8")
# Integer type checks
(assert (compare= 0 (- (int/u64 "1000") 1000)) "subtract from int/u64")
(assert (odd? (int/u64 "1001")) "odd? 1")
(assert (not (odd? (int/u64 "1000"))) "odd? 2")
(assert (odd? (int/s64 "1001")) "odd? 3")
(assert (not (odd? (int/s64 "1000"))) "odd? 4")
(assert (odd? (int/s64 "-1001")) "odd? 5")
(assert (not (odd? (int/s64 "-1000"))) "odd? 6")
(assert (even? (int/u64 "1000")) "even? 1")
(assert (not (even? (int/u64 "1001"))) "even? 2")
(assert (even? (int/s64 "1000")) "even? 3")
(assert (not (even? (int/s64 "1001"))) "even? 4")
(assert (even? (int/s64 "-1000")) "even? 5")
(assert (not (even? (int/s64 "-1001"))) "even? 6")
# integer type operations
(defn modcheck [x y]
(assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
(string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
(mod (int/s64 x) y)))
(assert (= (string (% x y)) (string (% (int/s64 x) y)))
(string "int/s64 (% " x " " y ") expected " (% x y) ", got "
(% (int/s64 x) y))))
(modcheck 1 2)
(modcheck 1 3)
(modcheck 4 2)
(modcheck 4 1)
(modcheck 10 3)
(modcheck 10 -3)
(modcheck -10 3)
(modcheck -10 -3)
(end-suite)

View File

@@ -23,6 +23,7 @@
# Using a large test grammar
(def- core-env (table/getproto (fiber/getenv (fiber/current))))
(def- specials {'fn true
'var true
'do true
@@ -40,7 +41,7 @@
(defn capture-sym
[text]
(def sym (symbol text))
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
[(if (or (core-env sym) (specials sym)) :coresym :symbol) text])
(def grammar
~{:ws (set " \v\t\r\f\n\0")
@@ -315,13 +316,4 @@
(assert (= 40 counter) "if-with 1")
(def a @[])
(eachk x [:a :b :c :d]
(array/push a x))
(assert (deep= (range 4) a) "eachk 1")
(tracev (def my-unique-var-name true))
(assert my-unique-var-name "tracev upscopes")
(end-suite)

View File

@@ -36,7 +36,7 @@
:loop (/ (* "[" :main "]") ,(fn [& captures]
~(while (not= (get DATA POS) 0)
,;captures)))
:main (any (+ :s :loop :+ :- :> :< :.))}))
:main (any (+ :s :loop :+ :- :> :< :.)) }))
(defn bf
"Run brainfuck."
@@ -125,7 +125,6 @@
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
# Regression #301
(def b (buffer/new-filled 128 0x78))
@@ -195,153 +194,4 @@
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
# Perm strings
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
# Issue #336 cases - don't segfault
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
(assert-error "unmarshal errors 4"
(unmarshal
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
(gccollect)
# in vs get regression
(assert (nil? (first @"")) "in vs get 1")
(assert (nil? (last @"")) "in vs get 1")
# For undefined behavior sanitizer
0xf&1fffFFFF
# Tuple comparison
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
# Lenprefix rule
(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1)))
(assert (peg/match peg "5:abcde") "lenprefix 1")
(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
# Packet capture
(def peg2
(peg/compile
~{# capture packet length in tag :header-len
:packet-header (* (/ ':d+ ,scan-number :header-len) ":")
# capture n bytes from a backref :header-len
:packet-body '(lenprefix (-> :header-len) 1)
# header, followed by body, and drop the :header-len capture
:packet (/ (* :packet-header :packet-body) ,|$1)
# any exact seqence of packets (no extra characters)
:main (* (any :packet) -1)}))
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4")
(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5")
(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
# Regression #400
(assert (= nil (while (and false false) (fn []) (error "should not happen"))) "strangeloop 1")
(assert (= nil (while (not= nil nil) (fn []) (error "should not happen"))) "strangeloop 2")
# Issue #412
(assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor")
(def peg3
~{:main (* "(" (thru ")"))})
(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
(assert (peg/match peg3 "(12345)") "peg thru 1")
(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
(assert (not (peg/match peg3 "(12345")) "peg thru 3")
(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
(def peg5 (peg/compile [3 "abc"]))
(assert (:match peg5 "abcabcabc") "repeat alias 1")
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
(defn check-jdn [x]
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
(check-jdn 0)
(check-jdn nil)
(check-jdn [])
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
(check-jdn -0.123123123123)
(check-jdn 12837192371923)
(check-jdn "a string")
(check-jdn @"a buffer")
# Issue 428
(var result nil)
(defn f [] (yield {:a :ok}))
(assert-no-error "issue 428 1" (loop [{:a x} :in (fiber/new f)] (set result x)))
(assert (= result :ok) "issue 428 2")
# Inline 3 argument get
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
# Keyword and Symbol slice
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
# Peg find and find-all
(def p "/usr/local/bin/janet")
(assert (= (peg/find '"n/" p) 13) "peg find 1")
(assert (not (peg/find '"t/" p)) "peg find 2")
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
# Peg replace and replace-all
(var ti 0)
(defn check-replacer
[x y z]
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
(check-replacer "abc" "Z" "")
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
# Peg bug
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
(end-suite)

BIN
tools/EnVar.dll Normal file

Binary file not shown.

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