mirror of
https://github.com/janet-lang/janet
synced 2024-12-25 07:50:27 +00:00
Merge branch 'master' into struct-proto
This commit is contained in:
commit
03f99752a7
@ -9,4 +9,3 @@ tasks:
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
|
@ -19,5 +19,3 @@ tasks:
|
||||
ninja
|
||||
ninja test
|
||||
sudo ninja install
|
||||
sudo jpm --verbose install circlet
|
||||
sudo jpm --verbose install spork
|
||||
|
@ -29,5 +29,4 @@ tasks:
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
|
||||
|
35
.github/workflows/release.yml
vendored
Normal file
35
.github/workflows/release.yml
vendored
Normal file
@ -0,0 +1,35 @@
|
||||
name: Release
|
||||
|
||||
on:
|
||||
push:
|
||||
tags:
|
||||
- "v*.*.*"
|
||||
|
||||
jobs:
|
||||
|
||||
release:
|
||||
name: Build release binaries
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Set the version
|
||||
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
|
||||
- name: Set the platform
|
||||
run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
|
||||
- name: Compile the project
|
||||
run: make clean && make
|
||||
- name: Build the artifact
|
||||
run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-x64.tar.gz
|
||||
- name: Draft the release
|
||||
uses: softprops/action-gh-release@v1
|
||||
with:
|
||||
draft: true
|
||||
files: |
|
||||
build/*.gz
|
||||
build/janet.h
|
||||
build/c/janet.c
|
||||
build/c/shell.c
|
34
.github/workflows/test.yml
vendored
Normal file
34
.github/workflows/test.yml
vendored
Normal file
@ -0,0 +1,34 @@
|
||||
name: Test
|
||||
|
||||
on: [push, pull_request]
|
||||
|
||||
jobs:
|
||||
|
||||
test-posix:
|
||||
name: Build and test on POSIX systems
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Compile the project
|
||||
run: make clean && make
|
||||
- name: Test the project
|
||||
run: make test
|
||||
|
||||
test-windows:
|
||||
name: Build and test on Windows
|
||||
runs-on: windows-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup MSVC
|
||||
uses: ilammy/msvc-dev-cmd@v1
|
||||
- name: Build the project
|
||||
shell: cmd
|
||||
run: build_win
|
||||
- name: Test the project
|
||||
shell: cmd
|
||||
run: build_win test
|
3
.gitignore
vendored
3
.gitignore
vendored
@ -32,8 +32,9 @@ lockfile.janet
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Common test file I use.
|
||||
# Common test files I use.
|
||||
temp.janet
|
||||
scratch.janet
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
|
25
.travis.yml
25
.travis.yml
@ -1,25 +0,0 @@
|
||||
language: c
|
||||
script:
|
||||
- make
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
- gcc
|
||||
os:
|
||||
- linux
|
||||
- osx
|
||||
before_deploy:
|
||||
deploy:
|
||||
provider: releases
|
||||
api_key:
|
||||
secure: JSqAOTH1jmfVlbOuPO3BbY1BhPq+ddiBNPCxuAyKHoVwfO4eNAmq9COI+UwCMWY3dg+YlspufRwkHj//B7QQ6hPbSsKu+Mapu6gr/CAE/jxbfO/E98LkIkUwbGjplwtzw2kiBkHN/Bu6J5X76cwo4D8nwQ1JIcV3nWtoG87t7H4W0R4AYQkbLGAPylgUFr11YMPx2cRBBqCdLAGIrny7kQ/0cRBfkN81R/gUJv/q3OjmUvY7sALXp7mFdZb75QPSilKIDuVUU5hLvPYTeRl6cWI/M+m5SmGZx1rjv5S9Qaw070XoNyt9JAADtbOUnADKvDguDZIP1FCuT1Gb+cnJPzrvk6+OBU9s8UjCTFtgV+LKlhmRZcwV5YQBE94PKRMJNC6VvIWM7UeQ8Zhm1jmQS6ONNWbuoUAlkZP57NtDQa2x0GT2wkubNSQKlaY+6/gwTD9KAJIzaZG7HYXH7b+4g7VbccCyhDAtDZtXgrOIS4WAkNc8rWezRO4H0qHMyON9aCEb0eTE8hWIufbx6ymG4gUxnYO+AkrEYMCwQvU6lS8BsevkaMTVtSShqlQtJ9FRlmJA3MA2ONyqzQXJENqRydyVbpFrKSv+0HbMyhEc5BoKbt0QcTh/slouNV4eASNar/GKN7aP8XKGUeMwIoCcRpP+3ehmwX9SUw7Ah5S42pA=
|
||||
file: build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
draft: true
|
||||
skip_cleanup: true
|
||||
on:
|
||||
tags: true
|
||||
repo: janet-lang/janet
|
||||
condition: "$CC = clang"
|
67
CHANGELOG.md
67
CHANGELOG.md
@ -2,9 +2,74 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## ??? - Unreleased
|
||||
- Deadlocked channels will no longer exit early - instead they will hang, which is more intuitive.
|
||||
|
||||
## 1.18.1 - 2021-10-16
|
||||
- Fix some documentation typos
|
||||
- Fix - Set pipes passed to subprocess to blocking mode.
|
||||
- Fix `-r` switch in repl.
|
||||
|
||||
## 1.18.0 - 2021-10-10
|
||||
- Allow `ev/cancel` to work on already scheduled fibers.
|
||||
- Fix bugs with ev/ module.
|
||||
- Add optional `base` argument to scan-number
|
||||
- Add `-i` flag to janet binary to make it easier to run image files from the command line
|
||||
- Remove `thread/` module.
|
||||
- Add `(number ...)` pattern to peg for more efficient number parsing using Janet's
|
||||
scan-number function without immediate string creation.
|
||||
|
||||
## 1.17.2 - 2021-09-18
|
||||
- Remove include of windows.h from janet.h. This caused issues on certain projects.
|
||||
- Fix formatting in doc-format to better handle special characters in signatures.
|
||||
- Fix some marshalling bugs.
|
||||
- Add optional Makefile target to install jpm as well.
|
||||
- Supervisor channels in threads will no longer include a wasteful copy of the fiber in every
|
||||
message across a thread.
|
||||
- Allow passing a closure to `ev/thread` as well as a whole fiber.
|
||||
- Allow passing a closure directly to `ev/go` to spawn fibers on the event loop.
|
||||
|
||||
## 1.17.1 - 2021-08-29
|
||||
- Fix docstring typos
|
||||
- Add `make install-jpm-git` to make jpm co-install simpler if using the Makefile.
|
||||
- Fix bugs with starting ev/threads and fiber marshaling.
|
||||
|
||||
## 1.17.0 - 2021-08-21
|
||||
- Add the `-E` flag for one-liners with the `short-fn` syntax for argument passing.
|
||||
- Add support for threaded abstract types. Threaded abstract types can easily be shared between threads.
|
||||
- Deprecate the `thread` library. Use threaded channels and ev instead.
|
||||
- Channels can now be marshalled.
|
||||
- Add the ability to close channels with `ev/chan-close` (or `:close`).
|
||||
- Add threaded channels with `ev/thread-chan`.
|
||||
- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
|
||||
- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
|
||||
- Add `table/clear`
|
||||
- Add build option to disable the threading library without disabling all threads.
|
||||
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
|
||||
separately like any other package.
|
||||
- Fix issue with `ev/go` when called with an initial value and supervisor.
|
||||
- Add the C API functions `janet_vm_save` and `janet_vm_load` to allow
|
||||
saving and restoring the entire VM state.
|
||||
|
||||
## 1.16.1 - 2021-06-09
|
||||
- Add `maclintf` - a utility for adding linting messages when inside macros.
|
||||
- Print source code of offending line on compiler warnings and errors.
|
||||
- Fix some issues with linting and re-add missing `make docs`.
|
||||
- Allow controlling linting with dynamic bindings `:lint-warn`, `:lint-error`, and `:lint-levels`.
|
||||
- Add `-w` and `-x` command line flags to the `janet` binary to set linting thresholds.
|
||||
linting thresholds are as follows:
|
||||
- :none - will never be trigger.
|
||||
- :relaxed - will only trigger on `:relaxed` lints.
|
||||
- :normal - will trigger on `:relaxed` and `:normal` lints.
|
||||
- :strict - will trigger on `:strict`, `:normal`, and `:relaxed` lints. This will catch the most issues
|
||||
but can be distracting.
|
||||
|
||||
## 1.16.0 - 2021-05-30
|
||||
- Add color documentation to the `doc` macro - enable/disable with `(dyn :doc-color)`.
|
||||
- Remove simpler HTML docs from distribution - use website or built-in documentation instead.
|
||||
- Add compiler warnings and deprecation levels.
|
||||
- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
|
||||
- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
|
||||
- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
|
||||
- Add `native-deps` option to `declare-native` in `jpm`. This lets native libraries link to other
|
||||
native libraries when building with jpm.
|
||||
- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
|
||||
that can be installed via `jpm`.
|
||||
|
2
LICENSE
2
LICENSE
@ -1,4 +1,4 @@
|
||||
Copyright (c) 2020 Calvin Rose and contributors
|
||||
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
|
||||
|
64
Makefile
64
Makefile
@ -36,6 +36,7 @@ JANET_PATH?=$(LIBDIR)/janet
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_DIST_DIR?=janet-dist
|
||||
JPM_TAG?=master
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
@ -61,11 +62,18 @@ ifeq ($(UNAME), Darwin)
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME), Haiku)
|
||||
LDCONFIG:=true
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
# For Android (termux)
|
||||
ifeq ($(UNAME), Linux) # uname on Darwin doesn't recognise -o
|
||||
ifeq ($(shell uname -o), Android)
|
||||
CLIBS:=$(CLIBS) -landroid-spawn
|
||||
endif
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
@ -113,12 +121,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/regalloc.c \
|
||||
src/core/run.c \
|
||||
src/core/specials.c \
|
||||
src/core/state.c \
|
||||
src/core/string.c \
|
||||
src/core/strtod.c \
|
||||
src/core/struct.c \
|
||||
src/core/symcache.c \
|
||||
src/core/table.c \
|
||||
src/core/thread.c \
|
||||
src/core/tuple.c \
|
||||
src/core/util.c \
|
||||
src/core/value.c \
|
||||
@ -157,7 +165,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.16
|
||||
SONAME=libjanet.so.1.18
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
@ -205,12 +213,10 @@ 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
|
||||
|
||||
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
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@ -223,30 +229,33 @@ dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
README.md build/c/janet.c build/c/shell.c jpm
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
README.md build/c/janet.c build/c/shell.c
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
cp jpm build/$(JANET_DIST_DIR)/bin/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||
cp janet.1 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
|
||||
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
#########################
|
||||
|
||||
docs: build/doc.html
|
||||
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
|
||||
########################
|
||||
##### 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
|
||||
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
@ -262,7 +271,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm build/janet.h
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
@ -273,22 +282,30 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
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'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
|
||||
install-jpm-git: $(JANET_TARGET)
|
||||
mkdir -p build
|
||||
rm -rf build/jpm
|
||||
git clone --depth=1 --branch='$(JPM_TAG)' https://github.com/janet-lang/jpm.git build/jpm
|
||||
cd build/jpm && PREFIX='$(PREFIX)' \
|
||||
DESTDIR=$(DESTDIR) \
|
||||
JANET_MANPATH='$(JANET_MANPATH)' \
|
||||
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
|
||||
JANET_BINPATH='$(BINDIR)' \
|
||||
JANET_LIBPATH='$(LIBDIR)' \
|
||||
../../$(JANET_TARGET) ./bootstrap.janet
|
||||
|
||||
uninstall:
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
-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 -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
@ -311,18 +328,7 @@ clean:
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
cd test/install \
|
||||
&& rm -rf build .cache .manifests \
|
||||
&& jpm --verbose build \
|
||||
&& jpm --verbose test \
|
||||
&& 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
|
||||
echo "JPM has been removed from default install."
|
||||
|
||||
help:
|
||||
@echo
|
||||
|
48
README.md
48
README.md
@ -1,9 +1,9 @@
|
||||
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
|
||||
|
||||
[![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?)
|
||||
[![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
@ -30,6 +30,7 @@ Lua, but smaller than GNU Guile or Python.
|
||||
|
||||
## Features
|
||||
|
||||
* Configurable at build time - turn features on or off for a smaller or more featureful build
|
||||
* Minimal setup - one binary and you are good to go!
|
||||
* First-class closures
|
||||
* Garbage collection
|
||||
@ -39,6 +40,8 @@ Lua, but smaller than GNU Guile or Python.
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Macros
|
||||
* Multithreading
|
||||
* Per-thread event loop for efficient evented IO
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tail call Optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
@ -211,7 +214,7 @@ Options are:
|
||||
-- : Stop handling options
|
||||
```
|
||||
|
||||
If installed, you can also run `man janet` and `man jpm` to get usage information.
|
||||
If installed, you can also run `man janet` to get usage information.
|
||||
|
||||
## Embedding
|
||||
|
||||
@ -238,23 +241,19 @@ Gitter provides Matrix and irc bridges as well.
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal 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
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
### Where is (favorite feature from other language)?
|
||||
|
||||
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
|
||||
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||
of 5 others by making the language more complicated.
|
||||
|
||||
### Where is the example code?
|
||||
### Is there a language spec?
|
||||
|
||||
In the examples directory.
|
||||
There is not currently a spec besides the documentation at https://janet-lang.org.
|
||||
|
||||
### Is this Scheme/Common Lisp? Where are the cons cells?
|
||||
|
||||
Nope. There are no cons cells here.
|
||||
|
||||
### Is this a Clojure port?
|
||||
|
||||
@ -266,14 +265,35 @@ Internally, Janet is not at all like Clojure.
|
||||
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
||||
and maps, instead they work well as table keys or other identifiers.
|
||||
|
||||
### Can I do Object Oriented programming with Janet?
|
||||
|
||||
To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
|
||||
That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
|
||||
methods are implemeted with keywords.
|
||||
|
||||
```
|
||||
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
|
||||
(def my-car (table/setproto @{} Car))
|
||||
(:honk my-car "Beep!")
|
||||
```
|
||||
|
||||
### Why can't we add (feature from Clojure) into the core?
|
||||
|
||||
Usually, one of a few reasons:
|
||||
- Often, it already exists in a different form and the Clojure port would be redundant.
|
||||
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
||||
Janet does not run on the JVM. We admittedly have a much more primitive GC.
|
||||
Janet does not run on the JVM, and has a more primitive garbage collector.
|
||||
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
|
||||
without feeling "bolted on", especially when compared to ALGOL like languages.
|
||||
without feeling "bolted on", especially when compared to ALGOL like languages. Adding features
|
||||
to the core also makes it a bit more difficult keep Janet maximally portable.
|
||||
|
||||
### Why is my terminal 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
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
## Why is it called "Janet"?
|
||||
|
||||
|
@ -20,10 +20,6 @@ init:
|
||||
install:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- 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
|
||||
build: off
|
||||
|
@ -14,13 +14,18 @@
|
||||
@if "%1"=="test" goto TEST
|
||||
@if "%1"=="dist" goto DIST
|
||||
@if "%1"=="install" goto INSTALL
|
||||
@if "%1"=="test-install" goto TESTINSTALL
|
||||
@if "%1"=="all" goto ALL
|
||||
|
||||
@rem Set compile and link options here
|
||||
@setlocal
|
||||
|
||||
@rem Example use asan
|
||||
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
|
||||
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
|
||||
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||
@set JANET_LINK=link /nologo
|
||||
|
||||
@set JANET_LINK_STATIC=lib /nologo
|
||||
|
||||
@rem Add janet build tag
|
||||
@ -82,7 +87,7 @@ exit /b 1
|
||||
@echo command prompt.
|
||||
exit /b 0
|
||||
|
||||
@rem Clean build artifacts
|
||||
@rem Clean build artifacts
|
||||
:CLEAN
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
@ -117,8 +122,6 @@ janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h buil
|
||||
copy build\janet.h dist\janet.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy .\jpm dist\jpm
|
||||
|
||||
@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
|
||||
@ -147,34 +150,6 @@ FOR %%a in (janet-*-windows-*-installer.msi) DO (
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@rem Test the installation.
|
||||
:TESTINSTALL
|
||||
pushd test\install
|
||||
call jpm clean
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm test
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call build\testexec
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose quickbin testexec.janet build\testexec2.exe
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call build\testexec2.exe
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
popd
|
||||
exit /b 0
|
||||
|
||||
:TESTINSTALLFAIL
|
||||
popd
|
||||
goto :TESTFAIL
|
||||
|
||||
@rem build, test, dist, install. Useful for local dev.
|
||||
:ALL
|
||||
call %0 build
|
||||
|
@ -10,3 +10,13 @@
|
||||
(ev/call worker :b 5)
|
||||
(ev/sleep 0.3)
|
||||
(ev/call worker :c 12)
|
||||
|
||||
(defn worker2
|
||||
[name]
|
||||
(repeat 10
|
||||
(ev/sleep 0.2)
|
||||
(print name " working")))
|
||||
|
||||
(ev/go worker2 :bob)
|
||||
(ev/go worker2 :joe)
|
||||
(ev/go worker2 :sally)
|
||||
|
22
examples/threaded-channels.janet
Normal file
22
examples/threaded-channels.janet
Normal file
@ -0,0 +1,22 @@
|
||||
(def chan (ev/thread-chan 10))
|
||||
|
||||
(ev/spawn
|
||||
(ev/sleep 0)
|
||||
(print "started fiber!")
|
||||
(ev/give chan (math/random))
|
||||
(ev/give chan (math/random))
|
||||
(ev/give chan (math/random))
|
||||
(ev/sleep 0.5)
|
||||
(for i 0 10
|
||||
(print "giving to channel...")
|
||||
(ev/give chan (math/random))
|
||||
(ev/sleep 1))
|
||||
(print "finished fiber!")
|
||||
(:close chan))
|
||||
|
||||
(ev/do-thread
|
||||
(print "started thread!")
|
||||
(ev/sleep 1)
|
||||
(while (def x (do (print "taking from channel...") (ev/take chan)))
|
||||
(print "got " x " from thread!"))
|
||||
(print "finished thread!"))
|
@ -1,68 +0,0 @@
|
||||
(defn worker-main
|
||||
"Sends 11 messages back to parent"
|
||||
[parent]
|
||||
(def name (thread/receive))
|
||||
(def interval (thread/receive))
|
||||
(for i 0 10
|
||||
(os/sleep interval)
|
||||
(:send parent (string/format "thread %s wakeup no. %d" name i)))
|
||||
(:send parent name))
|
||||
|
||||
(defn make-worker
|
||||
[name interval]
|
||||
(-> (thread/new worker-main)
|
||||
(:send name)
|
||||
(:send interval)))
|
||||
|
||||
(def bob (make-worker "bob" 0.02))
|
||||
(def joe (make-worker "joe" 0.03))
|
||||
(def sam (make-worker "sam" 0.05))
|
||||
|
||||
# Receive out of order
|
||||
(for i 0 33
|
||||
(print (thread/receive)))
|
||||
|
||||
#
|
||||
# Recursive Thread Tree - should pause for a bit, and then print a cool zigzag.
|
||||
#
|
||||
|
||||
(def rng (math/rng (os/cryptorand 16)))
|
||||
|
||||
(defn choose [& xs]
|
||||
(in xs (:int rng (length xs))))
|
||||
|
||||
(defn worker-tree
|
||||
[parent]
|
||||
(def name (thread/receive))
|
||||
(def depth (thread/receive))
|
||||
(if (< depth 5)
|
||||
(do
|
||||
(defn subtree []
|
||||
(-> (thread/new worker-tree)
|
||||
(:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
|
||||
(:send (inc depth))))
|
||||
(let [l (subtree)
|
||||
r (subtree)
|
||||
lrep (thread/receive)
|
||||
rrep (thread/receive)]
|
||||
(:send parent [name ;lrep ;rrep])))
|
||||
(do
|
||||
(:send parent [name]))))
|
||||
|
||||
(-> (thread/new worker-tree) (:send "adam") (:send 0))
|
||||
(def lines (thread/receive))
|
||||
(map print lines)
|
||||
|
||||
#
|
||||
# Receive timeout
|
||||
#
|
||||
|
||||
(def slow (make-worker "slow-loras" 0.5))
|
||||
(for i 0 50
|
||||
(try
|
||||
(let [msg (thread/receive 0.1)]
|
||||
(print "\n" msg))
|
||||
([err] (prin ".") (:flush stdout))))
|
||||
|
||||
(print "\ndone timing, timeouts ending.")
|
||||
(try (while true (print (thread/receive))) ([err] (print "done")))
|
28
janet.1
28
janet.1
@ -3,11 +3,14 @@
|
||||
janet \- run the Janet language abstract machine
|
||||
.SH SYNOPSIS
|
||||
.B janet
|
||||
[\fB\-hvsrpnqk\fR]
|
||||
[\fB\-hvsrpnqik\fR]
|
||||
[\fB\-e\fR \fISOURCE\fR]
|
||||
[\fB\-E\fR \fISOURCE ...ARGUMENTS\fR]
|
||||
[\fB\-l\fR \fIMODULE\fR]
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||
[\fB\-w\fR \fILEVEL\fR]
|
||||
[\fB\-x\fR \fILEVEL\fR]
|
||||
[\fB\-\-\fR]
|
||||
.BR script
|
||||
.BR args ...
|
||||
@ -160,6 +163,11 @@ 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 \-E\ code arguments
|
||||
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
||||
more concise one-liners with command line arguments.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
@ -205,12 +213,28 @@ Precompiles Janet source code into an image, a binary dump that can be efficient
|
||||
Source should be a path to the Janet module to compile, and output should be the file path of
|
||||
resulting image. Output should usually end with the .jimage extension.
|
||||
|
||||
.TP
|
||||
.BR \-i
|
||||
When this flag is passed, a script passed to the interpreter will be treated as a janet image file
|
||||
rather than a janet source file.
|
||||
|
||||
.TP
|
||||
.BR \-l\ lib
|
||||
Import a Janet module 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.
|
||||
|
||||
.TP
|
||||
.BR \-w\ level
|
||||
Set the warning linting level for Janet.
|
||||
This linting level should be one of :relaxed, :none, :strict, :normal, or a
|
||||
Janet number. Any linting message that is of a greater lint level than this setting will be displayed as
|
||||
a warning, but not stop compilation or execution.
|
||||
.TP
|
||||
.BR \-x\ level
|
||||
Set the error linting level for Janet.
|
||||
This linting level should be one of :relaxed, :none, :strict, :normal, or a
|
||||
Janet number. Any linting message that is of a greater lint level will cause a compilation error
|
||||
and stop compilation.
|
||||
.TP
|
||||
.BR \-\-
|
||||
Stop parsing command line arguments. All arguments after this one will be considered file names
|
||||
|
298
jpm.1
298
jpm.1
@ -1,298 +0,0 @@
|
||||
.TH JPM 1
|
||||
.SH NAME
|
||||
jpm \- the Janet Project Manager, a build tool for Janet
|
||||
.SH SYNOPSIS
|
||||
.B jpm
|
||||
[\fB\-\-flag ...\fR]
|
||||
[\fB\-\-option=value ...\fR]
|
||||
.IR command
|
||||
.IR args ...
|
||||
.SH DESCRIPTION
|
||||
jpm is the build tool that ships with a standard Janet install. It is
|
||||
used for building Janet projects, installing dependencies, installing
|
||||
projects, building native modules, and exporting your Janet project to a
|
||||
standalone executable. Although not required for working with Janet, it
|
||||
removes much of the boilerplate with installing dependencies and
|
||||
building native modules. jpm requires only Janet to run, and uses git
|
||||
to install dependencies (jpm will work without git installed).
|
||||
.SH DOCUMENTATION
|
||||
|
||||
jpm has several subcommands, each used for managing either a single Janet project or
|
||||
all Janet modules installed on the system. Global commands, those that manage modules
|
||||
at the system level, do things like install and uninstall packages, as well as clear the cache.
|
||||
More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
|
||||
|
||||
.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.
|
||||
|
||||
.TP
|
||||
.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
|
||||
.BR \-\-modpath=/some/path
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this.
|
||||
|
||||
.TP
|
||||
.BR \-\-headerpath=/some/path
|
||||
Set the path the jpm will include when building C source code. This lets
|
||||
you specify the location of janet.h and janetconf.h on your system. On a
|
||||
normal install, this option is not needed.
|
||||
|
||||
.TP
|
||||
.BR \-\-binpath=/some/path
|
||||
Set the path that jpm will install scripts and standalone executables to. Executables
|
||||
defined via declare-execuatble or scripts declared via declare-binscript will be installed
|
||||
here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
|
||||
See JANET_BINPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-libpath=/some/path
|
||||
Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
|
||||
is \fBnot\fR used for building native modules or standalone executables, only
|
||||
for linking into applications that want to embed janet as a dynamic module.
|
||||
Linking statically might be a better idea, even in that case. Defaults to
|
||||
$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
|
||||
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
|
||||
it defaults to link.exe.
|
||||
|
||||
.TP
|
||||
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
|
||||
Sets the git repository for the package listing used to resolve shorthand package names.
|
||||
|
||||
.TP
|
||||
.BR \-\-archiver=$AR
|
||||
Sets the command used for creating static libraries, use for linking into the standalone executable.
|
||||
Native modules are compiled twice, once a normal native module (shared object), and once as an
|
||||
archive. Defaults to ar.
|
||||
|
||||
.SH COMMANDS
|
||||
.TP
|
||||
.BR help
|
||||
Shows the usage text and exits immediately.
|
||||
|
||||
.TP
|
||||
.BR build
|
||||
Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
|
||||
be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.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.
|
||||
|
||||
.TP
|
||||
.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
|
||||
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.
|
||||
|
||||
.TP
|
||||
.BR clean
|
||||
Remove all artifacts created by jpm. This just deletes the build folder.
|
||||
|
||||
.TP
|
||||
.BR test
|
||||
Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
|
||||
is considered failing if it exits with a non-zero exit code.
|
||||
|
||||
.TP
|
||||
.BR deps
|
||||
Install all dependencies that this project requires recursively. jpm does not
|
||||
resolve dependency issues, like conflicting versions of the same module are required, or
|
||||
different modules with the same name. Dependencies are installed with git, so deps requires
|
||||
git to be on the PATH.
|
||||
|
||||
.TP
|
||||
.BR clear-cache
|
||||
jpm caches git repositories that are needed to install modules from a remote
|
||||
source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
|
||||
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
|
||||
contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
|
||||
A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
|
||||
like make. run will run a single rule or build a single file.
|
||||
|
||||
.TP
|
||||
.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.
|
||||
|
||||
.TP
|
||||
.BR update-pkgs
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
|
||||
.TP
|
||||
.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
|
||||
.RS
|
||||
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||
the default location set at compile time, which can be determined with (dyn :syspath)
|
||||
.RE
|
||||
|
||||
.B JANET_MODPATH
|
||||
.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.
|
||||
This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
.RE
|
||||
|
||||
.B JANET_HEADERPATH
|
||||
.RS
|
||||
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
||||
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
||||
default includes on your system, this value is not required. If not provided, will default to
|
||||
<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
|
||||
variable.
|
||||
.RE
|
||||
|
||||
.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
|
||||
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.
|
||||
.RE
|
||||
|
||||
.B JANET_BINPATH
|
||||
.RS
|
||||
The directory where jpm will install binary scripts and executables to.
|
||||
Defaults to
|
||||
(dyn :syspath)/bin
|
||||
The --binpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_PKGLIST
|
||||
.RS
|
||||
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
|
||||
|
||||
.B JPM_OS_WHICH
|
||||
.RS
|
||||
Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
|
||||
environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
|
||||
set this environment variable. Set this to one of the following
|
||||
strings:
|
||||
.IP
|
||||
\- windows
|
||||
.IP
|
||||
\- macos
|
||||
.IP
|
||||
\- linux
|
||||
.IP
|
||||
\- freebsd
|
||||
.IP
|
||||
\- openbsd
|
||||
.IP
|
||||
\- netbsd
|
||||
.IP
|
||||
\- bsd
|
||||
.IP
|
||||
\- posix
|
||||
.RE
|
||||
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
30
meson.build
30
meson.build
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose and contributors
|
||||
# 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
|
||||
@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.16.0')
|
||||
version : '1.18.2')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
|
||||
cc = meson.get_compiler('c')
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
android_spawn_dep = cc.find_library('android-spawn', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
# Link options
|
||||
@ -72,7 +73,9 @@ 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'))
|
||||
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
||||
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
||||
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@ -127,12 +130,12 @@ core_src = [
|
||||
'src/core/regalloc.c',
|
||||
'src/core/run.c',
|
||||
'src/core/specials.c',
|
||||
'src/core/state.c',
|
||||
'src/core/string.c',
|
||||
'src/core/strtod.c',
|
||||
'src/core/struct.c',
|
||||
'src/core/symcache.c',
|
||||
'src/core/table.c',
|
||||
'src/core/thread.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/util.c',
|
||||
'src/core/value.c',
|
||||
@ -158,7 +161,7 @@ mainclient_src = [
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
|
||||
native : true)
|
||||
|
||||
# Build janet.c
|
||||
@ -168,10 +171,10 @@ janetc = custom_target('janetc',
|
||||
capture : true,
|
||||
command : [
|
||||
janet_boot, meson.current_source_dir(),
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
'JANET_PATH', janet_path
|
||||
])
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep]
|
||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
endif
|
||||
@ -260,16 +263,3 @@ patched_janet = custom_target('patched-janeth',
|
||||
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
|
||||
|
@ -17,6 +17,8 @@ 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('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2020 © Calvin Rose
|
||||
# Copyright 2021 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@ -51,7 +51,7 @@
|
||||
``Use a function or macro literal `f` as a macro. This lets
|
||||
any function be used as a macro. Inside a quasiquote, the
|
||||
idiom `(as-macro ,my-custom-macro arg1 arg2...)` can be used
|
||||
to avoid unwanted variable capture.``
|
||||
to avoid unwanted variable capture of `my-custom-macro`.``
|
||||
[f & args]
|
||||
(f ;args))
|
||||
|
||||
@ -149,10 +149,15 @@
|
||||
(defmacro /= "Shorthand for (set x (/ x n))." [x n] ~(set ,x (,/ ,x ,n)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
|
||||
|
||||
(defn assert
|
||||
"Throw an error if x is not truthy."
|
||||
(defmacro assert
|
||||
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
||||
[x &opt err]
|
||||
(if x x (error (if err err "assert failure"))))
|
||||
(def v (gensym))
|
||||
~(do
|
||||
(def ,v ,x)
|
||||
(if ,v
|
||||
,v
|
||||
(,error ,(if err err "assert failure")))))
|
||||
|
||||
(defn errorf
|
||||
"A combination of error and string/format. Equivalent to (error (string/format fmt ;args))"
|
||||
@ -588,10 +593,15 @@
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ;body) :yi)."
|
||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as (fiber/new (fn [] ;body) :yi)."
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
|
||||
(defmacro fiber-fn
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ;body) flags)."
|
||||
[flags & body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) flags))
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
[xs]
|
||||
@ -688,6 +698,14 @@
|
||||
"Returns the numeric minimum of the arguments."
|
||||
[& args] (extreme < args))
|
||||
|
||||
(defn max-of
|
||||
"Returns the numeric maximum of the argument sequence."
|
||||
[args] (extreme > args))
|
||||
|
||||
(defn min-of
|
||||
"Returns the numeric minimum of the argument sequence."
|
||||
[args] (extreme < args))
|
||||
|
||||
(defn first
|
||||
"Get the first element from an indexed data structure."
|
||||
[xs]
|
||||
@ -1026,35 +1044,65 @@
|
||||
(set k (next ind k)))
|
||||
ret)
|
||||
|
||||
(defn take
|
||||
"Take first n elements in an indexed type. Returns new indexed instance."
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(defn- take-n-fallback
|
||||
[n xs]
|
||||
(def res @[])
|
||||
(when (> n 0)
|
||||
(var left n)
|
||||
(each x xs
|
||||
(array/push res x)
|
||||
(-- left)
|
||||
(if (= 0 left) (break))))
|
||||
res)
|
||||
|
||||
(defn- take-until-fallback
|
||||
[pred xs]
|
||||
(def res @[])
|
||||
(each x xs
|
||||
(if (pred x) (break))
|
||||
(array/push res x))
|
||||
res)
|
||||
|
||||
(defn- slice-n
|
||||
[f n ind]
|
||||
(def len (length ind))
|
||||
# make sure end is in [0, len]
|
||||
(def m (if (> n 0) n 0))
|
||||
(def end (if (> m len) len m))
|
||||
(f ind 0 end))
|
||||
|
||||
(defn take-until
|
||||
"Same as (take-while (complement pred) ind)."
|
||||
[pred ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(defn take
|
||||
"Take the first n elements of a fiber, indexed or bytes type. Returns a new array, tuple or string, respectively."
|
||||
[n ind]
|
||||
(cond
|
||||
(bytes? ind) (slice-n string/slice n ind)
|
||||
(indexed? ind) (slice-n tuple/slice n ind)
|
||||
(take-n-fallback n ind)))
|
||||
|
||||
(defn- slice-until
|
||||
[f pred ind]
|
||||
(def len (length ind))
|
||||
(def i (find-index pred ind))
|
||||
(def end (if (nil? i) len i))
|
||||
(f ind 0 end))
|
||||
|
||||
(defn take-until
|
||||
"Same as `(take-while (complement pred) ind)`."
|
||||
[pred ind]
|
||||
(cond
|
||||
(bytes? ind) (slice-until string/slice pred ind)
|
||||
(indexed? ind) (slice-until tuple/slice pred ind)
|
||||
(take-until-fallback pred ind)))
|
||||
|
||||
(defn take-while
|
||||
`Given a predicate, take only elements from an indexed type that satisfy
|
||||
the predicate, and abort on first failure. Returns a new array.`
|
||||
`Given a predicate, take only elements from a fiber, indexed or bytes type that satisfy
|
||||
the predicate, and abort on first failure. Returns a new array, tuple or string, respectively.`
|
||||
[pred ind]
|
||||
(take-until (complement pred) ind))
|
||||
|
||||
(defn drop
|
||||
"Drop first n elements in an indexed type. Returns new indexed instance."
|
||||
``Drop the first n elements in an indexed or bytes type. Returns a new tuple or string
|
||||
instance, respectively.``
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
@ -1065,7 +1113,7 @@
|
||||
(f ind start -1))
|
||||
|
||||
(defn drop-until
|
||||
"Same as (drop-while (complement pred) ind)."
|
||||
"Same as `(drop-while (complement pred) ind)`."
|
||||
[pred ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
@ -1075,8 +1123,8 @@
|
||||
(f ind start))
|
||||
|
||||
(defn drop-while
|
||||
`Given a predicate, remove elements from an indexed type that satisfy
|
||||
the predicate, and abort on first failure. Returns a new array.`
|
||||
`Given a predicate, remove elements from an indexed or bytes type that satisfy
|
||||
the predicate, and abort on first failure. Returns a new tuple or string, respectively.`
|
||||
[pred ind]
|
||||
(drop-until (complement pred) ind))
|
||||
|
||||
@ -1316,9 +1364,10 @@
|
||||
ret)
|
||||
|
||||
(defn invert
|
||||
`Returns a table where the keys of an associative data structure
|
||||
are the values, and the values of the keys. If multiple keys have the same
|
||||
value, one key will be ignored.`
|
||||
``Returns a table where the keys of an associative data structure
|
||||
are the values, and the values are the keys. If multiple keys in `ds`
|
||||
are mapped to the same value, only one of those values will
|
||||
become a key in the returned table.``
|
||||
[ds]
|
||||
(def ret @{})
|
||||
(loop [k :keys ds]
|
||||
@ -1345,7 +1394,7 @@
|
||||
a sequence of keys.`
|
||||
[ds ks &opt dflt]
|
||||
(var d ds)
|
||||
(loop [k :in ks :while d] (set d (get d k)))
|
||||
(loop [k :in ks :while (not (nil? d))] (set d (get d k)))
|
||||
(if (= nil d) dflt d))
|
||||
|
||||
(defn update-in
|
||||
@ -1628,9 +1677,13 @@
|
||||
* tuple -- a tuple pattern will match if its first element matches, and the
|
||||
following elements are treated as predicates and are true.
|
||||
|
||||
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
|
||||
* `\_` symbol -- the last special case is the `\_` symbol, which is a wildcard
|
||||
that will match any value without creating a binding.
|
||||
|
||||
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
|
||||
where <sym> is any symbol, will attempt to match `x` against a value
|
||||
already bound to `<sym>`, rather than matching and rebinding it.
|
||||
|
||||
Any other value pattern will only match if it is equal to `x`.
|
||||
```
|
||||
[x & cases]
|
||||
@ -1784,6 +1837,20 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defn maclintf
|
||||
``When inside a macro, call this function to add a linter warning. Takes
|
||||
a `fmt` argument like `string/format` which is used to format the message.``
|
||||
[level fmt & args]
|
||||
(def lints (dyn :macro-lints))
|
||||
(when lints
|
||||
(def form (dyn :macro-form))
|
||||
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
|
||||
(def l (if-not (= -1 l) l))
|
||||
(def c (if-not (= -1 c) c))
|
||||
(def msg (string/format fmt ;args))
|
||||
(array/push lints [level l c msg]))
|
||||
nil)
|
||||
|
||||
(defn macex1
|
||||
``Expand macros in a form, but do not recursively expand macros.
|
||||
See `macex` docs for info on on-binding.``
|
||||
@ -2065,11 +2132,10 @@
|
||||
###
|
||||
###
|
||||
|
||||
# Initialize syspath and header path
|
||||
# Initialize syspath
|
||||
(each [k v] (partition 2 (tuple/slice boot/args 2))
|
||||
(case k
|
||||
"JANET_PATH" (setdyn :syspath v)
|
||||
"JANET_HEADERPATH" (setdyn :headerpath v)))
|
||||
"JANET_PATH" (setdyn :syspath v)))
|
||||
|
||||
(defn make-env
|
||||
`Create a new environment table. The new environment
|
||||
@ -2097,6 +2163,43 @@
|
||||
(if ec "\e[0m" ""))
|
||||
(eflush))
|
||||
|
||||
(defn- print-line-col
|
||||
"Print the source code at a line, column in a source file. If unable to open
|
||||
the file, prints nothing."
|
||||
[where line col]
|
||||
(if-not line (break))
|
||||
(when-with [f (file/open where :r)]
|
||||
(def source-code (file/read f :all))
|
||||
(var index 0)
|
||||
(repeat (dec line)
|
||||
(if-not index (break))
|
||||
(set index (inc (string/find "\n" source-code index))))
|
||||
(when index
|
||||
(def line-end (string/find "\n" source-code index))
|
||||
(eprint " " (string/slice source-code index line-end))
|
||||
(when col
|
||||
(+= index col)
|
||||
(eprint (string/repeat " " (inc col)) "^"))
|
||||
(eflush))))
|
||||
|
||||
(defn warn-compile
|
||||
"Default handler for a compile warning"
|
||||
[msg level where &opt line col]
|
||||
(def ec (dyn :err-color))
|
||||
(eprin
|
||||
(if ec "\e[33m" "")
|
||||
where
|
||||
":"
|
||||
line
|
||||
":"
|
||||
col
|
||||
": compile warning (" level "): ")
|
||||
(eprint msg)
|
||||
(when ec
|
||||
(print-line-col where line col)
|
||||
(eprin "\e[0m"))
|
||||
(eflush))
|
||||
|
||||
(defn bad-compile
|
||||
"Default handler for a compile error."
|
||||
[msg macrof where &opt line col]
|
||||
@ -2111,7 +2214,10 @@
|
||||
": compile error: ")
|
||||
(if macrof
|
||||
(debug/stacktrace macrof msg)
|
||||
(eprint msg (if ec "\e[0m" "")))
|
||||
(eprint msg))
|
||||
(when ec
|
||||
(print-line-col where line col)
|
||||
(eprin "\e[0m"))
|
||||
(eflush))
|
||||
|
||||
(defn curenv
|
||||
@ -2122,6 +2228,13 @@
|
||||
(if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
|
||||
e)
|
||||
|
||||
(def- lint-levels
|
||||
{:none 0
|
||||
:relaxed 1
|
||||
:normal 2
|
||||
:strict 3
|
||||
:all math/inf})
|
||||
|
||||
(defn run-context
|
||||
```
|
||||
Run a context. This evaluates expressions in an environment,
|
||||
@ -2134,6 +2247,7 @@
|
||||
* `:env` - the environment to compile against - default is the current env
|
||||
* `:source` - string path of source for better errors - default is "<anonymous>"
|
||||
* `:on-compile-error` - callback when compilation fails - default is bad-compile
|
||||
* `:on-compile-warning` - callback for any linting error - default is warn-compile
|
||||
* `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
|
||||
* `:on-status` - callback when a value is evaluated - default is debug/stacktrace.
|
||||
* `:fiber-flags` - what flags to wrap the compilation fiber with. Default is :ia.
|
||||
@ -2148,6 +2262,7 @@
|
||||
:chunks chunks
|
||||
:on-status onstatus
|
||||
:on-compile-error on-compile-error
|
||||
:on-compile-warning on-compile-warning
|
||||
:on-parse-error on-parse-error
|
||||
:fiber-flags guard
|
||||
:evaluator evaluator
|
||||
@ -2159,6 +2274,7 @@
|
||||
(default chunks (fn [buf p] (getline "" buf env)))
|
||||
(default onstatus debug/stacktrace)
|
||||
(default on-compile-error bad-compile)
|
||||
(default on-compile-warning warn-compile)
|
||||
(default on-parse-error bad-parse)
|
||||
(default evaluator (fn evaluate [x &] (x)))
|
||||
(default default-where "<anonymous>")
|
||||
@ -2167,6 +2283,7 @@
|
||||
(var where default-where)
|
||||
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(def lints @[])
|
||||
(defn eval1 [source &opt l c]
|
||||
(def source (if expand (expand source) source))
|
||||
(var good true)
|
||||
@ -2174,13 +2291,29 @@
|
||||
(def f
|
||||
(fiber/new
|
||||
(fn []
|
||||
(def res (compile source env where))
|
||||
(if (= (type res) :function)
|
||||
(evaluator res source env where)
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :line line :column column :fiber errf} res)
|
||||
(on-compile-error err errf where (or line l) (or column c)))))
|
||||
(array/clear lints)
|
||||
(def res (compile source env where lints))
|
||||
(unless (empty? lints)
|
||||
# Convert lint levels to numbers.
|
||||
(def levels (get env :lint-levels lint-levels))
|
||||
(def lint-error (get env :lint-error))
|
||||
(def lint-warning (get env :lint-warn))
|
||||
(def lint-error (or (get levels lint-error lint-error) 0))
|
||||
(def lint-warning (or (get levels lint-warning lint-warning) 2))
|
||||
(each [level line col msg] lints
|
||||
(def lvl (get lint-levels level 0))
|
||||
(cond
|
||||
(<= lvl lint-error) (do
|
||||
(set good false)
|
||||
(on-compile-error msg nil where (or line l) (or col c)))
|
||||
(<= lvl lint-warning) (on-compile-warning msg level where (or line l) (or col c)))))
|
||||
(when good
|
||||
(if (= (type res) :function)
|
||||
(evaluator res source env where)
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :line line :column column :fiber errf} res)
|
||||
(on-compile-error err errf where (or line l) (or column c))))))
|
||||
guard))
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
@ -2254,6 +2387,7 @@
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where)))
|
||||
|
||||
(put env :exit nil)
|
||||
(in env :exit-value env))
|
||||
|
||||
(defn quit
|
||||
@ -2298,7 +2432,7 @@
|
||||
(def res (compile form (fiber/getenv (fiber/current)) "eval"))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error (res :error))))
|
||||
(error (get res :error))))
|
||||
|
||||
(defn parse
|
||||
`Parse a string and return the first value. For complex parsing, such as for a repl with error handling,
|
||||
@ -2660,8 +2794,8 @@
|
||||
(def delimiters
|
||||
(if has-color
|
||||
{:underline ["\e[4m" "\e[24m"]
|
||||
:code ["\e[3;97m" "\e[39;23m"]
|
||||
:italics ["\e[3m" "\e[23m"]
|
||||
:code ["\e[97m" "\e[39m"]
|
||||
:italics ["\e[4m" "\e[24m"]
|
||||
:bold ["\e[1m" "\e[22m"]}
|
||||
{:underline ["_" "_"]
|
||||
:code ["`" "`"]
|
||||
@ -2694,7 +2828,7 @@
|
||||
(c++)
|
||||
(- cursor x))
|
||||
|
||||
# Detection helpers - return number of characters natched
|
||||
# Detection helpers - return number of characters matched
|
||||
(defn ul? []
|
||||
(let [x (c) x1 (cn 1)]
|
||||
(and
|
||||
@ -2828,6 +2962,14 @@
|
||||
(finish-p)
|
||||
new-indent))
|
||||
|
||||
# Handle first line specially for defn, defmacro, etc.
|
||||
(when (= (chr "(") (in str 0))
|
||||
(skipline)
|
||||
(def first-line (string/slice str 0 (- cursor 1)))
|
||||
(def fl-open (if has-color "\e[97m" ""))
|
||||
(def fl-close (if has-color "\e[39m" ""))
|
||||
(push [[(string fl-open first-line fl-close) (length first-line)]]))
|
||||
|
||||
(parse-blocks 0)
|
||||
|
||||
# Emission state
|
||||
@ -2965,10 +3107,10 @@
|
||||
(print-index identity)))
|
||||
|
||||
(defmacro doc
|
||||
`Shows documentation for the given symbol, or can show a list of available bindings.
|
||||
If sym is a symbol, will look for documentation for that symbol. If sym is a string
|
||||
or is not provided, will show all lexical and dynamic bindings in the current environment with
|
||||
that prefix (all bindings will be shown if no prefix is given).`
|
||||
``Shows documentation for the given symbol, or can show a list of available bindings.
|
||||
If `sym` is a symbol, will look for documentation for that symbol. If `sym` is a string
|
||||
or is not provided, will show all lexical and dynamic bindings in the current environment
|
||||
containing that string (all bindings will be shown if no string is given).``
|
||||
[&opt sym]
|
||||
~(,doc* ',sym))
|
||||
|
||||
@ -3234,18 +3376,23 @@
|
||||
Returns a fiber that is scheduled to run the function.
|
||||
```
|
||||
[f & args]
|
||||
(ev/go (fiber/new (fn [&] (f ;args)) :tp)))
|
||||
(ev/go (fn _call [&] (f ;args))))
|
||||
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
|
||||
[& body]
|
||||
~(,ev/go (fiber/new (fn _spawn [&] ,;body) :tp)))
|
||||
~(,ev/go (fn _spawn [&] ,;body)))
|
||||
|
||||
(defmacro ev/do-thread
|
||||
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
||||
evaluates to nil.``
|
||||
[& body]
|
||||
~(,ev/thread (fiber/new (fn _thread [&] ,;body) :t)))
|
||||
~(,ev/thread (fn _do-thread [&] ,;body)))
|
||||
|
||||
(defmacro ev/spawn-thread
|
||||
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
||||
[& body]
|
||||
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
|
||||
|
||||
(defmacro ev/with-deadline
|
||||
`Run a body of code with a deadline, such that if the code does not complete before
|
||||
@ -3276,7 +3423,7 @@
|
||||
(def ,res @[])
|
||||
(,wait-for-fibers ,chan
|
||||
,(seq [[i body] :pairs bodies]
|
||||
~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan)))
|
||||
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
|
||||
,res))))
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
@ -3369,6 +3516,12 @@
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
|
||||
|
||||
(defn- run-main
|
||||
[env subargs arg]
|
||||
(if-let [main (get (in env 'main) :value)]
|
||||
(let [thunk (compile [main ;subargs] env arg)]
|
||||
(if (function? thunk) (thunk) (error (thunk :error))))))
|
||||
|
||||
(defn cli-main
|
||||
`Entrance for the Janet CLI tool. Call this function with the command line
|
||||
arguments as an array or tuple of strings to invoke the CLI interface.`
|
||||
@ -3376,20 +3529,27 @@
|
||||
|
||||
(setdyn :args args)
|
||||
|
||||
(var *should-repl* false)
|
||||
(var *no-file* true)
|
||||
(var *quiet* false)
|
||||
(var *raw-stdin* false)
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
(var *colorize* true)
|
||||
(var *debug* false)
|
||||
(var *compile-only* false)
|
||||
(var should-repl false)
|
||||
(var no-file true)
|
||||
(var quiet false)
|
||||
(var raw-stdin false)
|
||||
(var handleopts true)
|
||||
(var exit-on-error true)
|
||||
(var colorize true)
|
||||
(var debug-flag false)
|
||||
(var compile-only false)
|
||||
(var warn-level nil)
|
||||
(var error-level nil)
|
||||
(var expect-image false)
|
||||
|
||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (getenv-alias "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile))
|
||||
|
||||
(defn- get-lint-level
|
||||
[i]
|
||||
(def x (in args (+ i 1)))
|
||||
(or (scan-number x) (keyword x)))
|
||||
|
||||
# Flag handlers
|
||||
(def handlers
|
||||
{"h" (fn [&]
|
||||
@ -3401,6 +3561,7 @@
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
-d : Set the debug flag in the REPL
|
||||
-r : Enter the REPL after running all scripts
|
||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
||||
@ -3409,35 +3570,51 @@
|
||||
-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
|
||||
-i : Load the script argument as an image file instead of source code
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-l lib : Import a module before processing more arguments
|
||||
-l lib : Use a module before processing more arguments
|
||||
-w level : Set the lint warning level - default is "normal"
|
||||
-x level : Set the lint error level - default is "none"
|
||||
-- : Stop handling options
|
||||
```)
|
||||
(os/exit 0)
|
||||
1)
|
||||
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
||||
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
||||
"r" (fn [&] (set *should-repl* true) 1)
|
||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||
"q" (fn [&] (set *quiet* true) 1)
|
||||
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||
"n" (fn [&] (set *colorize* false) 1)
|
||||
"s" (fn [&] (set raw-stdin true) (set should-repl true) 1)
|
||||
"r" (fn [&] (set should-repl true) 1)
|
||||
"p" (fn [&] (set exit-on-error false) 1)
|
||||
"q" (fn [&] (set quiet true) 1)
|
||||
"i" (fn [&] (set expect-image true) 1)
|
||||
"k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
|
||||
"n" (fn [&] (set colorize false) 1)
|
||||
"m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2)
|
||||
"c" (fn c-switch [i &]
|
||||
(def e (dofile (in args (+ i 1))))
|
||||
(def path (in args (+ i 1)))
|
||||
(def e (dofile path))
|
||||
(spit (in args (+ i 2)) (make-image e))
|
||||
(set *no-file* false)
|
||||
(set no-file false)
|
||||
3)
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"-" (fn [&] (set handleopts false) 1)
|
||||
"l" (fn l-switch [i &]
|
||||
(import* (in args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
:prefix "" :exit exit-on-error)
|
||||
2)
|
||||
"e" (fn e-switch [i &]
|
||||
(set *no-file* false)
|
||||
(set no-file false)
|
||||
(eval-string (in args (+ i 1)))
|
||||
2)
|
||||
"d" (fn [&] (set *debug* true) 1)
|
||||
"E" (fn E-switch [i &]
|
||||
(set no-file false)
|
||||
(def subargs (array/slice args (+ i 2)))
|
||||
(def src ~|,(parse (in args (+ i 1))))
|
||||
(def thunk (compile src))
|
||||
(if (function? thunk)
|
||||
((thunk) ;subargs)
|
||||
(error (get thunk :error)))
|
||||
math/inf)
|
||||
"d" (fn [&] (set debug-flag true) 1)
|
||||
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
||||
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
||||
"R" (fn [&] (setdyn :profilepath nil) 1)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
@ -3449,27 +3626,37 @@
|
||||
(def lenargs (length args))
|
||||
(while (< i lenargs)
|
||||
(def arg (in args i))
|
||||
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
||||
(if (and handleopts (= "-" (string/slice arg 0 1)))
|
||||
(+= i (dohandler (string/slice arg 1) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(def env (make-env))
|
||||
(def subargs (array/slice args i))
|
||||
(put env :args subargs)
|
||||
(if *compile-only*
|
||||
(flycheck arg :exit *exit-on-error* :env env)
|
||||
(set no-file false)
|
||||
(if expect-image
|
||||
(do
|
||||
(dofile arg :exit *exit-on-error* :env env)
|
||||
(if-let [main (get (in env 'main) :value)]
|
||||
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
|
||||
(if (function? thunk) (thunk) (error (thunk :error)))))))
|
||||
(def env (load-image (slurp arg)))
|
||||
(put env :args subargs)
|
||||
(put env :lint-error error-level)
|
||||
(put env :lint-warn warn-level)
|
||||
(if debug-flag (put env :debug true))
|
||||
(run-main env subargs arg))
|
||||
(do
|
||||
(def env (make-env))
|
||||
(put env :args subargs)
|
||||
(put env :lint-error error-level)
|
||||
(put env :lint-warn warn-level)
|
||||
(if debug-flag (put env :debug true))
|
||||
(if compile-only
|
||||
(flycheck arg :exit exit-on-error :env env)
|
||||
(do
|
||||
(dofile arg :exit exit-on-error :env env)
|
||||
(run-main env subargs arg)))))
|
||||
(set i lenargs))))
|
||||
|
||||
(if (or *should-repl* *no-file*)
|
||||
(if (or should-repl no-file)
|
||||
(if
|
||||
*compile-only* (flycheck stdin :source "stdin" :exit *exit-on-error*)
|
||||
compile-only (flycheck stdin :source "stdin" :exit exit-on-error)
|
||||
(do
|
||||
(if-not *quiet*
|
||||
(if-not quiet
|
||||
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
|
||||
(flush)
|
||||
(defn getprompt [p]
|
||||
@ -3483,13 +3670,15 @@
|
||||
(when-let [profile.janet (dyn :profilepath)]
|
||||
(def new-env (dofile profile.janet :exit true))
|
||||
(merge-module env new-env "" false))
|
||||
(if *debug* (put env :debug true))
|
||||
(def getter (if *raw-stdin* getstdin getline))
|
||||
(if debug-flag (put env :debug true))
|
||||
(def getter (if raw-stdin getstdin getline))
|
||||
(defn getchunk [buf p]
|
||||
(getter (getprompt p) buf env))
|
||||
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(setdyn :doc-color (if *colorize* true))
|
||||
(setdyn :pretty-format (if colorize "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if colorize true))
|
||||
(setdyn :doc-color (if colorize true))
|
||||
(setdyn :lint-error error-level)
|
||||
(setdyn :lint-warn error-level)
|
||||
(repl getchunk nil env)))))
|
||||
|
||||
###
|
||||
@ -3509,6 +3698,10 @@
|
||||
(put into k (x k))))
|
||||
into)
|
||||
|
||||
# Deprecate file/popen
|
||||
(when-let [v (get root-env 'file/popen)]
|
||||
(put v :deprecated true))
|
||||
|
||||
# Modify root-env to remove private symbols and
|
||||
# flatten nested tables.
|
||||
(loop [[k v] :in (pairs root-env)
|
||||
@ -3518,6 +3711,9 @@
|
||||
(put flat :doc nil))
|
||||
(when (boot/config :no-sourcemaps)
|
||||
(put flat :source-map nil))
|
||||
# Fix directory separators on windows to make image identical between windows and non-windows
|
||||
(when-let [sm (get flat :source-map)]
|
||||
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))
|
||||
(if (v :private)
|
||||
(put root-env k nil)
|
||||
(put root-env k flat)))
|
||||
@ -3547,8 +3743,8 @@
|
||||
(def feature-header "src/core/features.h")
|
||||
|
||||
(def local-headers
|
||||
["src/core/util.h"
|
||||
"src/core/state.h"
|
||||
["src/core/state.h"
|
||||
"src/core/util.h"
|
||||
"src/core/gc.h"
|
||||
"src/core/vector.h"
|
||||
"src/core/fiber.h"
|
||||
@ -3584,12 +3780,12 @@
|
||||
"src/core/regalloc.c"
|
||||
"src/core/run.c"
|
||||
"src/core/specials.c"
|
||||
"src/core/state.c"
|
||||
"src/core/string.c"
|
||||
"src/core/strtod.c"
|
||||
"src/core/struct.c"
|
||||
"src/core/symcache.c"
|
||||
"src/core/table.c"
|
||||
"src/core/thread.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 16
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_MINOR 18
|
||||
#define JANET_VERSION_PATCH 2
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.16.0-dev"
|
||||
#define JANET_VERSION "1.18.2-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@ -32,6 +32,7 @@
|
||||
/* #define JANET_NO_REALPATH */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
/* #define JANET_NO_THREADS */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
@ -46,7 +47,9 @@
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_OS_NAME my-custom-os */
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_EPOLL */
|
||||
/* #define JANET_EV_NO_EPOLL */
|
||||
/* #define JANET_EV_NO_KQUEUE */
|
||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
||||
|
||||
/* Custom vm allocator support */
|
||||
/* #include <mimalloc.h> */
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -24,6 +24,12 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Create new userdata */
|
||||
@ -43,3 +49,100 @@ void *janet_abstract_end(void *x) {
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||
return janet_abstract_end(janet_abstract_begin(atype, size));
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
/*
|
||||
* Threaded abstracts
|
||||
*/
|
||||
|
||||
void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size) {
|
||||
JanetAbstractHead *header = janet_malloc(sizeof(JanetAbstractHead) + size);
|
||||
if (NULL == header) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.next_collection += size + sizeof(JanetAbstractHead);
|
||||
header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
|
||||
header->gc.data.next = NULL; /* Clear memory for address sanitizers */
|
||||
header->gc.data.refcount = 1;
|
||||
header->size = size;
|
||||
header->type = atype;
|
||||
void *abstract = (void *) & (header->data);
|
||||
janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(abstract), janet_wrap_false());
|
||||
return abstract;
|
||||
}
|
||||
|
||||
void *janet_abstract_end_threaded(void *x) {
|
||||
janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_THREADED_ABSTRACT);
|
||||
return x;
|
||||
}
|
||||
|
||||
void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
||||
return janet_abstract_end_threaded(janet_abstract_begin_threaded(atype, size));
|
||||
}
|
||||
|
||||
/* Refcounting primitives and sync primitives */
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement(&ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
||||
DeleteCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||
EnterCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
pthread_mutex_init(mutex, NULL);
|
||||
}
|
||||
|
||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
||||
pthread_mutex_destroy(mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||
pthread_mutex_lock(mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||
pthread_mutex_unlock(mutex);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
int32_t janet_abstract_incref(void *abst) {
|
||||
return janet_incref(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
int32_t janet_abstract_decref(void *abst) {
|
||||
return janet_decref(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
#endif
|
||||
|
190
src/core/array.c
190
src/core/array.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -35,7 +35,7 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
janet_vm.next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@ -72,7 +72,7 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet);
|
||||
janet_vm.next_collection += (capacity - array->capacity) * sizeof(Janet);
|
||||
array->data = newData;
|
||||
array->capacity = capacity;
|
||||
}
|
||||
@ -122,14 +122,19 @@ Janet janet_array_peek(JanetArray *array) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_new,
|
||||
"(array/new capacity)",
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_new_filled,
|
||||
"(array/new-filled count &opt value)",
|
||||
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
@ -141,7 +146,10 @@ static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_fill,
|
||||
"(array/fill arr &opt value)",
|
||||
"Replace all elements of an array with `value` (defaulting to nil) without changing the length of the array. "
|
||||
"Returns the modified array.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
@ -151,19 +159,26 @@ static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_pop,
|
||||
"(array/pop arr)",
|
||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||
"the input array.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_pop(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_peek,
|
||||
"(array/peek arr)",
|
||||
"Returns the last element of the array. Does not modify the array.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_peek(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_push,
|
||||
"(array/push arr x)",
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (INT32_MAX - argc + 1 <= array->count) {
|
||||
@ -176,7 +191,12 @@ static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_ensure,
|
||||
"(array/ensure arr capacity growth)",
|
||||
"Ensures that the memory backing the array is large enough for `capacity` "
|
||||
"items at the given rate of growth. Capacity and growth must be integers. "
|
||||
"If the backing capacity is already enough, then this function does nothing. "
|
||||
"Otherwise, the backing memory will be reallocated so that there is enough space.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = janet_getinteger(argv, 1);
|
||||
@ -186,7 +206,13 @@ static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_slice,
|
||||
"(array/slice arrtup &opt start end)",
|
||||
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the "
|
||||
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
|
||||
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
|
||||
"negative slice range. Returns a new array.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
@ -196,7 +222,12 @@ static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_concat,
|
||||
"(array/concat arr & parts)",
|
||||
"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 "
|
||||
"be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. "
|
||||
"Return the modified array `arr`.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@ -210,6 +241,11 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
int32_t j, len = 0;
|
||||
const Janet *vals = NULL;
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
if (array->data == vals) {
|
||||
int32_t newcount = array->count + len;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
}
|
||||
for (j = 0; j < len; j++)
|
||||
janet_array_push(array, vals[j]);
|
||||
}
|
||||
@ -219,7 +255,12 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_insert,
|
||||
"(array/insert arr at & xs)",
|
||||
"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 "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.") {
|
||||
size_t chunksize, restsize;
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@ -245,7 +286,12 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_remove,
|
||||
"(array/remove arr at &opt n)",
|
||||
"Remove up to `n` elements starting at index `at` in array `arr`. `at` can index from "
|
||||
"the end of the array with a negative index, and `n` must be a non-negative integer. "
|
||||
"By default, `n` is 1. "
|
||||
"Returns the array.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
@ -270,7 +316,9 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_trim,
|
||||
"(array/trim arr)",
|
||||
"Set the backing capacity of an array to its current length. Returns the modified array.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
@ -290,103 +338,33 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_clear(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_array_clear,
|
||||
"(array/clear arr)",
|
||||
"Empties an array, setting it's count to 0 but does not free the backing capacity. "
|
||||
"Returns the modified array.") {
|
||||
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,
|
||||
JDOC("(array/new capacity)\n\n"
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||
},
|
||||
{
|
||||
"array/new-filled", cfun_array_new_filled,
|
||||
JDOC("(array/new-filled count &opt value)\n\n"
|
||||
"Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.")
|
||||
},
|
||||
{
|
||||
"array/fill", cfun_array_fill,
|
||||
JDOC("(array/fill arr &opt value)\n\n"
|
||||
"Replace all elements of an array with value (defaulting to nil) without changing the length of the array. "
|
||||
"Returns the modified array.")
|
||||
},
|
||||
{
|
||||
"array/pop", cfun_array_pop,
|
||||
JDOC("(array/pop arr)\n\n"
|
||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||
"the input array.")
|
||||
},
|
||||
{
|
||||
"array/peek", cfun_array_peek,
|
||||
JDOC("(array/peek arr)\n\n"
|
||||
"Returns the last element of the array. Does not modify the array.")
|
||||
},
|
||||
{
|
||||
"array/push", cfun_array_push,
|
||||
JDOC("(array/push arr x)\n\n"
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||
},
|
||||
{
|
||||
"array/ensure", cfun_array_ensure,
|
||||
JDOC("(array/ensure arr capacity growth)\n\n"
|
||||
"Ensures that the memory backing the array is large enough for capacity "
|
||||
"items at the given rate of growth. Capacity and growth must be integers. "
|
||||
"If the backing capacity is already enough, then this function does nothing. "
|
||||
"Otherwise, the backing memory will be reallocated so that there is enough space.")
|
||||
},
|
||||
{
|
||||
"array/slice", cfun_array_slice,
|
||||
JDOC("(array/slice arrtup &opt start end)\n\n"
|
||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||
"Note that index -1 is synonymous with index (length arrtup) to allow a full "
|
||||
"negative slice range. Returns a new array.")
|
||||
},
|
||||
{
|
||||
"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 "
|
||||
"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 "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{
|
||||
"array/remove", cfun_array_remove,
|
||||
JDOC("(array/remove arr at &opt n)\n\n"
|
||||
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||
"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}
|
||||
};
|
||||
|
||||
/* Load the array module */
|
||||
void janet_lib_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, array_cfuns);
|
||||
JanetRegExt array_cfuns[] = {
|
||||
JANET_CORE_REG("array/new", cfun_array_new),
|
||||
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
|
||||
JANET_CORE_REG("array/fill", cfun_array_fill),
|
||||
JANET_CORE_REG("array/pop", cfun_array_pop),
|
||||
JANET_CORE_REG("array/peek", cfun_array_peek),
|
||||
JANET_CORE_REG("array/push", cfun_array_push),
|
||||
JANET_CORE_REG("array/ensure", cfun_array_ensure),
|
||||
JANET_CORE_REG("array/slice", cfun_array_slice),
|
||||
JANET_CORE_REG("array/concat", cfun_array_concat),
|
||||
JANET_CORE_REG("array/insert", cfun_array_insert),
|
||||
JANET_CORE_REG("array/remove", cfun_array_remove),
|
||||
JANET_CORE_REG("array/trim", cfun_array_trim),
|
||||
JANET_CORE_REG("array/clear", cfun_array_clear),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, array_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -942,8 +942,12 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||
}
|
||||
|
||||
/* C Function for assembly */
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_asm,
|
||||
"(asm assembly)",
|
||||
"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"
|
||||
"error on invalid assembly.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
@ -953,7 +957,24 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_disasm,
|
||||
"(disasm func &opt field)",
|
||||
"Returns assembly that could be used to compile the given function. "
|
||||
"func must be a function, not a c function. Will throw on error on a badly "
|
||||
"typed argument. If given a field name, will only return that part of the function assembly. "
|
||||
"Possible fields are:\n\n"
|
||||
"* :arity - number of required and optional arguments.\n"
|
||||
"* :min-arity - minimum number of arguments function can be called with.\n"
|
||||
"* :max-arity - maximum number of arguments function can be called with.\n"
|
||||
"* :vararg - true if function can take a variable number of arguments.\n"
|
||||
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||
"* :source - name of source file that this function was compiled from.\n"
|
||||
"* :name - name of function.\n"
|
||||
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"* :constants - an array of constants referenced by this function.\n"
|
||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
"* :defs - other function definitions that this function may instantiate.\n") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
if (argc == 2) {
|
||||
@ -976,41 +997,14 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
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"
|
||||
"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"
|
||||
"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")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
void janet_lib_asm(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||
JanetRegExt asm_cfuns[] = {
|
||||
JANET_CORE_REG("asm", cfun_asm),
|
||||
JANET_CORE_REG("disasm", cfun_disasm),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, asm_cfuns);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -162,14 +162,20 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
|
||||
/* C functions */
|
||||
|
||||
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_new,
|
||||
"(buffer/new capacity)",
|
||||
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||
"Returns a new buffer of length 0.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(cap);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_new_filled,
|
||||
"(buffer/new-filled count &opt byte)",
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Returns the new buffer.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
int32_t byte = 0;
|
||||
@ -183,7 +189,10 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_fill,
|
||||
"(buffer/fill buffer &opt byte)",
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t byte = 0;
|
||||
@ -196,7 +205,10 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_trim,
|
||||
"(buffer/trim buffer)",
|
||||
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
|
||||
"modified buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
@ -211,7 +223,10 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_u8,
|
||||
"(buffer/push-byte buffer & xs)",
|
||||
"Append bytes to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@ -221,7 +236,11 @@ static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_word,
|
||||
"(buffer/push-word buffer & xs)",
|
||||
"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 "
|
||||
"throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@ -235,7 +254,12 @@ static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_chars,
|
||||
"(buffer/push-string buffer & xs)",
|
||||
"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.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@ -250,7 +274,13 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_push,
|
||||
"(buffer/push buffer & xs)",
|
||||
"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. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@ -270,14 +300,19 @@ static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_clear,
|
||||
"(buffer/clear buffer)",
|
||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||
"its memory so it can be efficiently refilled. Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer->count = 0;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_popn,
|
||||
"(buffer/popn buffer n)",
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
@ -290,7 +325,12 @@ static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_slice,
|
||||
"(buffer/slice bytes &opt start end)",
|
||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||
"Returns a new buffer.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||
@ -314,7 +354,9 @@ static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, i
|
||||
*bit = which_bit;
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_bitset,
|
||||
"(buffer/bit-set buffer index)",
|
||||
"Sets the bit at the given bit-index. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@ -323,7 +365,9 @@ static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_bitclear,
|
||||
"(buffer/bit-clear buffer index)",
|
||||
"Clears the bit at the given bit-index. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@ -332,7 +376,9 @@ static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_bitget,
|
||||
"(buffer/bit buffer index)",
|
||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@ -340,7 +386,9 @@ static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_bittoggle,
|
||||
"(buffer/bit-toggle buffer index)",
|
||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@ -349,7 +397,11 @@ static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_blit,
|
||||
"(buffer/blit dest src &opt dest-start src-start src-end)",
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.") {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
@ -386,7 +438,10 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_buffer_format,
|
||||
"(buffer/format buffer format & args)",
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
" the modified buffer.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||
@ -394,116 +449,26 @@ static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg buffer_cfuns[] = {
|
||||
{
|
||||
"buffer/new", cfun_buffer_new,
|
||||
JDOC("(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||
"Returns a new buffer of length 0.")
|
||||
},
|
||||
{
|
||||
"buffer/new-filled", cfun_buffer_new_filled,
|
||||
JDOC("(buffer/new-filled count &opt byte)\n\n"
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Returns the new buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/fill", cfun_buffer_fill,
|
||||
JDOC("(buffer/fill buffer &opt byte)\n\n"
|
||||
"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. "
|
||||
"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 "
|
||||
"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. "
|
||||
"Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
"buffer/popn", cfun_buffer_popn,
|
||||
JDOC("(buffer/popn buffer n)\n\n"
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/clear", cfun_buffer_clear,
|
||||
JDOC("(buffer/clear buffer)\n\n"
|
||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/slice", cfun_buffer_slice,
|
||||
JDOC("(buffer/slice bytes &opt start end)\n\n"
|
||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||
"Returns a new buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/bit-set", cfun_buffer_bitset,
|
||||
JDOC("(buffer/bit-set buffer index)\n\n"
|
||||
"Sets the bit at the given bit-index. Returns the buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/bit-clear", cfun_buffer_bitclear,
|
||||
JDOC("(buffer/bit-clear buffer index)\n\n"
|
||||
"Clears the bit at the given bit-index. Returns the buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/bit", cfun_buffer_bitget,
|
||||
JDOC("(buffer/bit buffer index)\n\n"
|
||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
||||
},
|
||||
{
|
||||
"buffer/bit-toggle", cfun_buffer_bittoggle,
|
||||
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/blit", cfun_buffer_blit,
|
||||
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.")
|
||||
},
|
||||
{
|
||||
"buffer/format", cfun_buffer_format,
|
||||
JDOC("(buffer/format buffer format & args)\n\n"
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
" the modified buffer.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_buffer(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||
JanetRegExt buffer_cfuns[] = {
|
||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
|
||||
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
|
||||
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
|
||||
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
|
||||
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
|
||||
JANET_CORE_REG("buffer/bit-set", cfun_buffer_bitset),
|
||||
JANET_CORE_REG("buffer/bit-clear", cfun_buffer_bitclear),
|
||||
JANET_CORE_REG("buffer/bit", cfun_buffer_bitget),
|
||||
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
||||
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
||||
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -51,15 +51,15 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
}
|
||||
|
||||
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;
|
||||
if (janet_vm.return_reg != NULL) {
|
||||
*janet_vm.return_reg = message;
|
||||
if (NULL != janet_vm.fiber) {
|
||||
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
}
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(*janet_vm_jmp_buf, sig);
|
||||
_longjmp(*janet_vm.signal_buf, sig);
|
||||
#else
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
longjmp(*janet_vm.signal_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||
@ -212,7 +212,7 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
const uint8_t *jstr = janet_getstring(argv, n);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
janet_panic("string contains embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
@ -358,26 +358,26 @@ 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) {
|
||||
if (!janet_vm.top_dyns) return janet_wrap_nil();
|
||||
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
||||
}
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
if (janet_vm.fiber->env) {
|
||||
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
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);
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
janet_table_put(janet_vm.fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -53,6 +53,36 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
|
||||
janetc_error(c, janet_cstring(m));
|
||||
}
|
||||
|
||||
static const char *janet_lint_level_names[] = {
|
||||
"relaxed",
|
||||
"normal",
|
||||
"strict"
|
||||
};
|
||||
|
||||
/* Emit compiler linter messages */
|
||||
void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
|
||||
if (NULL != c->lints) {
|
||||
/* format message */
|
||||
va_list args;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
const uint8_t *str = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
/* construct linting payload */
|
||||
Janet *payload = janet_tuple_begin(4);
|
||||
payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
|
||||
payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line);
|
||||
payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column);
|
||||
payload[3] = janet_wrap_string(str);
|
||||
janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
|
||||
}
|
||||
}
|
||||
|
||||
/* Free a slot */
|
||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
|
||||
@ -199,24 +229,41 @@ JanetSlot janetc_resolve(
|
||||
|
||||
/* Symbol not found - check for global */
|
||||
{
|
||||
Janet check;
|
||||
JanetBindingType btype = janet_resolve(c->env, sym, &check);
|
||||
switch (btype) {
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
switch (binding.type) {
|
||||
default:
|
||||
case JANET_BINDING_NONE:
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
case JANET_BINDING_DEF:
|
||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||
return janetc_cslot(check);
|
||||
ret = janetc_cslot(binding.value);
|
||||
break;
|
||||
case JANET_BINDING_VAR: {
|
||||
JanetSlot ret = janetc_cslot(check);
|
||||
/* TODO save type info */
|
||||
ret = janetc_cslot(binding.value);
|
||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||
ret.flags &= ~JANET_SLOT_CONSTANT;
|
||||
return ret;
|
||||
break;
|
||||
}
|
||||
}
|
||||
JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
|
||||
switch (binding.deprecation) {
|
||||
case JANET_BINDING_DEP_NONE:
|
||||
break;
|
||||
case JANET_BINDING_DEP_RELAXED:
|
||||
depLevel = JANET_C_LINT_RELAXED;
|
||||
break;
|
||||
case JANET_BINDING_DEP_NORMAL:
|
||||
depLevel = JANET_C_LINT_NORMAL;
|
||||
break;
|
||||
case JANET_BINDING_DEP_STRICT:
|
||||
depLevel = JANET_C_LINT_STRICT;
|
||||
break;
|
||||
}
|
||||
if (binding.deprecation != JANET_BINDING_DEP_NONE) {
|
||||
janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Symbol was found */
|
||||
@ -399,6 +446,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
||||
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
|
||||
janetc_value(opts, x);
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
|
||||
janetc_popscope(c);
|
||||
if (c->buffer) {
|
||||
janet_v__cnt(c->buffer) = bufstart;
|
||||
@ -631,6 +679,9 @@ static int macroexpand1(
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
if (c->lints) {
|
||||
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
|
||||
}
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@ -825,7 +876,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Initialize a compiler */
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
c->scope = NULL;
|
||||
c->buffer = NULL;
|
||||
c->mapbuffer = NULL;
|
||||
@ -834,6 +885,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
|
||||
c->source = where;
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
c->lints = lints;
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
@ -851,12 +903,13 @@ static void janetc_deinit(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Compile a form. */
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
JanetCompileResult janet_compile_lint(Janet source,
|
||||
JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
JanetCompiler c;
|
||||
JanetScope rootscope;
|
||||
JanetFopts fopts;
|
||||
|
||||
janetc_init(&c, env, where);
|
||||
janetc_init(&c, env, where, lints);
|
||||
|
||||
/* Push a function scope */
|
||||
janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
|
||||
@ -884,19 +937,31 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
return c.result;
|
||||
}
|
||||
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
return janet_compile_lint(source, env, where, NULL);
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
JANET_CORE_FN(cfun,
|
||||
"(compile ast &opt env source lints)",
|
||||
"Compiles an Abstract Syntax Tree (ast) into a 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. "
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm_fiber->env = env;
|
||||
janet_vm.fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc == 3) {
|
||||
if (argc >= 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
} else {
|
||||
@ -915,18 +980,10 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a 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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||
JanetRegExt cfuns[] = {
|
||||
JANET_CORE_REG("compile", cfun),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -29,6 +29,13 @@
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
/* Levels for compiler warnings */
|
||||
typedef enum {
|
||||
JANET_C_LINT_RELAXED,
|
||||
JANET_C_LINT_NORMAL,
|
||||
JANET_C_LINT_STRICT
|
||||
} JanetCompileLintLevel;
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
#define JANET_FUN_ERROR 2
|
||||
@ -78,10 +85,10 @@ typedef struct JanetSpecial JanetSpecial;
|
||||
#define JANET_SLOT_MUTABLE 0x40000
|
||||
#define JANET_SLOT_REF 0x80000
|
||||
#define JANET_SLOT_RETURNED 0x100000
|
||||
/* Needed for handling single element arrays as global vars. */
|
||||
|
||||
/* Used for unquote-splicing */
|
||||
#define JANET_SLOT_SPLICED 0x200000
|
||||
#define JANET_SLOT_DEP_NOTE 0x200000
|
||||
#define JANET_SLOT_DEP_WARN 0x400000
|
||||
#define JANET_SLOT_DEP_ERROR 0x800000
|
||||
#define JANET_SLOT_SPLICED 0x1000000
|
||||
|
||||
#define JANET_SLOTTYPE_ANY 0xFFFF
|
||||
|
||||
@ -164,6 +171,9 @@ struct JanetCompiler {
|
||||
|
||||
/* Prevent unbounded recursion */
|
||||
int recursion_guard;
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@ -230,6 +240,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_error(JanetCompiler *c, const uint8_t *m);
|
||||
void janetc_cerror(JanetCompiler *c, const char *m);
|
||||
|
||||
/* Linting */
|
||||
void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
|
||||
|
||||
/* Dispatch to correct form compiler */
|
||||
JanetSlot janetc_value(JanetFopts opts, Janet x);
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -35,6 +35,13 @@ extern const unsigned char *janet_core_image;
|
||||
extern size_t janet_core_image_size;
|
||||
#endif
|
||||
|
||||
/* Docstrings should only exist during bootstrap */
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
#define JDOC(x) (x)
|
||||
#else
|
||||
#define JDOC(x) NULL
|
||||
#endif
|
||||
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
@ -130,7 +137,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
|
||||
const uint8_t *jstr = janet_unwrap_string(x);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
janet_panicf("string %v contains embedded 0s", x);
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
@ -143,7 +150,18 @@ static int is_path_sep(char c) {
|
||||
}
|
||||
|
||||
/* Used for module system. */
|
||||
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_expand_path,
|
||||
"(module/expand-path path template)",
|
||||
"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, "
|
||||
"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)") {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *input = janet_getcstring(argv, 0);
|
||||
const char *template = janet_getcstring(argv, 1);
|
||||
@ -266,11 +284,13 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(out);
|
||||
}
|
||||
|
||||
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_dyn,
|
||||
"(dyn key &opt default)",
|
||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet value;
|
||||
if (janet_vm_fiber->env) {
|
||||
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||
if (janet_vm.fiber->env) {
|
||||
value = janet_table_get(janet_vm.fiber->env, argv[0]);
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
@ -280,16 +300,24 @@ static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
return value;
|
||||
}
|
||||
|
||||
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_setdyn,
|
||||
"(setdyn key value)",
|
||||
"Set a dynamic binding. Returns value.") {
|
||||
janet_fixarity(argc, 2);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(2);
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(2);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||
janet_table_put(janet_vm.fiber->env, argv[0], argv[1]);
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_native,
|
||||
"(native path &opt env)",
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.") {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *path = janet_getstring(argv, 0);
|
||||
@ -309,67 +337,104 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_describe,
|
||||
"(describe x)",
|
||||
"Returns a string that is a human-readable description of a value x.") {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_description_b(b, argv[i]);
|
||||
return janet_stringv(b->data, b->count);
|
||||
}
|
||||
|
||||
static Janet janet_core_string(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_string,
|
||||
"(string & xs)",
|
||||
"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`. "
|
||||
"Returns the new string.") {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_stringv(b->data, b->count);
|
||||
}
|
||||
|
||||
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_symbol,
|
||||
"(symbol & xs)",
|
||||
"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.") {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_symbolv(b->data, b->count);
|
||||
}
|
||||
|
||||
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_keyword,
|
||||
"(keyword & xs)",
|
||||
"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.") {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_keywordv(b->data, b->count);
|
||||
}
|
||||
|
||||
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_buffer,
|
||||
"(buffer & xs)",
|
||||
"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.") {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_wrap_buffer(b);
|
||||
}
|
||||
|
||||
static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_is_abstract,
|
||||
"(abstract? x)",
|
||||
"Check if x is an abstract type.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktype(argv[0], JANET_ABSTRACT));
|
||||
}
|
||||
|
||||
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_scannumber,
|
||||
"(scan-number str &opt base)",
|
||||
"Parse a number from a byte sequence and return that number, either an integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number. Optionally provide a base - if a base is provided, no "
|
||||
"radix specifier is expected at the beginning of the number.") {
|
||||
double number;
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
if (janet_scan_number(view.bytes, view.len, &number))
|
||||
int32_t base = janet_optinteger(argv, argc, 1, 0);
|
||||
int valid = base == 0 || (base >= 2 && base <= 36);
|
||||
if (!valid) {
|
||||
janet_panicf("expected base between 2 and 36, got %d", base);
|
||||
}
|
||||
if (janet_scan_number_base(view.bytes, view.len, base, &number))
|
||||
return janet_wrap_nil();
|
||||
return janet_wrap_number(number);
|
||||
}
|
||||
|
||||
static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_tuple,
|
||||
"(tuple & items)",
|
||||
"Creates a new tuple that contains items. Returns the new tuple.") {
|
||||
return janet_wrap_tuple(janet_tuple_n(argv, argc));
|
||||
}
|
||||
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_array,
|
||||
"(array & items)",
|
||||
"Create a new array that contains items. Returns the new array.") {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
safe_memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet janet_core_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_slice,
|
||||
"(slice x &opt start end)",
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.") {
|
||||
JanetRange range;
|
||||
JanetByteView bview;
|
||||
JanetView iview;
|
||||
@ -384,7 +449,12 @@ static Janet janet_core_slice(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_table(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_table,
|
||||
"(table & kvs)",
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table.") {
|
||||
int32_t i;
|
||||
if (argc & 1)
|
||||
janet_panic("expected even number of arguments");
|
||||
@ -395,7 +465,9 @@ static Janet janet_core_table(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
static Janet janet_core_getproto(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_getproto,
|
||||
"(getproto x)",
|
||||
"Get the prototype of a table or struct. Will return nil if `x` has no prototype.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *t = janet_unwrap_table(argv[0]);
|
||||
@ -412,10 +484,16 @@ static Janet janet_core_getproto(int32_t argc, Janet *argv) {
|
||||
janet_panicf("expected struct|table, got %v", argv[0]);
|
||||
}
|
||||
|
||||
static Janet janet_core_struct(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_struct,
|
||||
"(struct & kvs)",
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct.") {
|
||||
int32_t i;
|
||||
if (argc & 1)
|
||||
if (argc & 1) {
|
||||
janet_panic("expected even number of arguments");
|
||||
}
|
||||
JanetKV *st = janet_struct_begin(argc >> 1);
|
||||
for (i = 0; i < argc; i += 2) {
|
||||
janet_struct_put(st, argv[i], argv[i + 1]);
|
||||
@ -423,20 +501,30 @@ static Janet janet_core_struct(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet janet_core_gensym(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_gensym,
|
||||
"(gensym)",
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_symbol(janet_symbol_gen());
|
||||
}
|
||||
|
||||
static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_gccollect,
|
||||
"(gccollect)",
|
||||
"Run garbage collection. You should probably not call this manually.") {
|
||||
(void) argv;
|
||||
(void) argc;
|
||||
janet_collect();
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_gcsetinterval,
|
||||
"(gcsetinterval interval)",
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low values for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.") {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t s = janet_getsize(argv, 0);
|
||||
/* limit interval to 48 bits */
|
||||
@ -445,17 +533,37 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_panic("interval too large");
|
||||
}
|
||||
#endif
|
||||
janet_vm_gc_interval = s;
|
||||
janet_vm.gc_interval = s;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_gcinterval,
|
||||
"(gcinterval)",
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number((double) janet_vm_gc_interval);
|
||||
return janet_wrap_number((double) janet_vm.gc_interval);
|
||||
}
|
||||
|
||||
static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_type,
|
||||
"(type x)",
|
||||
"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"
|
||||
"or another keyword for an abstract type.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetType t = janet_type(argv[0]);
|
||||
if (t == JANET_ABSTRACT) {
|
||||
@ -465,12 +573,21 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_hash,
|
||||
"(hash value)",
|
||||
"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, "
|
||||
"then they will have the same hash value.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
}
|
||||
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_getline,
|
||||
"(getline &opt prompt buf env)",
|
||||
"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. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.") {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 3);
|
||||
@ -495,21 +612,27 @@ static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static Janet janet_core_trace(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_trace,
|
||||
"(trace func)",
|
||||
"Enable tracing on a function. Returns the function.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags |= JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_untrace,
|
||||
"(untrace func)",
|
||||
"Disables tracing on a function. Returns the function.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_check_int,
|
||||
"(int? x)",
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
@ -518,7 +641,9 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_check_nat,
|
||||
"(nat? x)",
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
@ -527,7 +652,9 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
if (janet_checkint(argv[0])) {
|
||||
@ -552,210 +679,6 @@ static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
janet_signalv(sig, payload);
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
JDOC("(native path &opt env)\n\n"
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.")
|
||||
},
|
||||
{
|
||||
"describe", janet_core_describe,
|
||||
JDOC("(describe x)\n\n"
|
||||
"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`. "
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"abstract?", janet_core_is_abstract,
|
||||
JDOC("(abstract? x)\n\n"
|
||||
"Check if x is an abstract type.")
|
||||
},
|
||||
{
|
||||
"table", janet_core_table,
|
||||
JDOC("(table & kvs)\n\n"
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table.")
|
||||
},
|
||||
{
|
||||
"array", janet_core_array,
|
||||
JDOC("(array & items)\n\n"
|
||||
"Create a new array that contains items. Returns the new array.")
|
||||
},
|
||||
{
|
||||
"scan-number", janet_core_scannumber,
|
||||
JDOC("(scan-number str)\n\n"
|
||||
"Parse a number from a byte sequence an return that number, either and integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number.")
|
||||
},
|
||||
{
|
||||
"tuple", janet_core_tuple,
|
||||
JDOC("(tuple & items)\n\n"
|
||||
"Creates a new tuple that contains items. Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
"struct", janet_core_struct,
|
||||
JDOC("(struct & kvs)\n\n"
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct.")
|
||||
},
|
||||
{
|
||||
"gensym", janet_core_gensym,
|
||||
JDOC("(gensym)\n\n"
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings.")
|
||||
},
|
||||
{
|
||||
"gccollect", janet_core_gccollect,
|
||||
JDOC("(gccollect)\n\n"
|
||||
"Run garbage collection. You should probably not call this manually.")
|
||||
},
|
||||
{
|
||||
"gcsetinterval", janet_core_gcsetinterval,
|
||||
JDOC("(gcsetinterval interval)\n\n"
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low values for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.")
|
||||
},
|
||||
{
|
||||
"gcinterval", janet_core_gcinterval,
|
||||
JDOC("(gcinterval)\n\n"
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection.")
|
||||
},
|
||||
{
|
||||
"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"
|
||||
"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, "
|
||||
"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. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
"dyn", janet_core_dyn,
|
||||
JDOC("(dyn key &opt default)\n\n"
|
||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
|
||||
},
|
||||
{
|
||||
"setdyn", janet_core_setdyn,
|
||||
JDOC("(setdyn key value)\n\n"
|
||||
"Set a dynamic binding. Returns value.")
|
||||
},
|
||||
{
|
||||
"trace", janet_core_trace,
|
||||
JDOC("(trace func)\n\n"
|
||||
"Enable tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"untrace", janet_core_untrace,
|
||||
JDOC("(untrace func)\n\n"
|
||||
"Disables tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"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, "
|
||||
"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)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
JDOC("(int? x)\n\n"
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"nat?", janet_core_check_nat,
|
||||
JDOC("(nat? x)\n\n"
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
JDOC("(signal what x)\n\n"
|
||||
"Raise a signal with payload x. ")
|
||||
},
|
||||
{
|
||||
"getproto", janet_core_getproto,
|
||||
JDOC("(getproto x)\n\n"
|
||||
"Get the prototype of a table or struct. Will return nil if `x` has no prototype.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
/* Utility for inline assembly */
|
||||
@ -1028,7 +951,39 @@ static const uint32_t cmp_asm[] = {
|
||||
*/
|
||||
|
||||
static void janet_load_libs(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||
JanetRegExt corelib_cfuns[] = {
|
||||
JANET_CORE_REG("native", janet_core_native),
|
||||
JANET_CORE_REG("describe", janet_core_describe),
|
||||
JANET_CORE_REG("string", janet_core_string),
|
||||
JANET_CORE_REG("symbol", janet_core_symbol),
|
||||
JANET_CORE_REG("keyword", janet_core_keyword),
|
||||
JANET_CORE_REG("buffer", janet_core_buffer),
|
||||
JANET_CORE_REG("abstract?", janet_core_is_abstract),
|
||||
JANET_CORE_REG("table", janet_core_table),
|
||||
JANET_CORE_REG("array", janet_core_array),
|
||||
JANET_CORE_REG("scan-number", janet_core_scannumber),
|
||||
JANET_CORE_REG("tuple", janet_core_tuple),
|
||||
JANET_CORE_REG("struct", janet_core_struct),
|
||||
JANET_CORE_REG("gensym", janet_core_gensym),
|
||||
JANET_CORE_REG("gccollect", janet_core_gccollect),
|
||||
JANET_CORE_REG("gcsetinterval", janet_core_gcsetinterval),
|
||||
JANET_CORE_REG("gcinterval", janet_core_gcinterval),
|
||||
JANET_CORE_REG("type", janet_core_type),
|
||||
JANET_CORE_REG("hash", janet_core_hash),
|
||||
JANET_CORE_REG("getline", janet_core_getline),
|
||||
JANET_CORE_REG("dyn", janet_core_dyn),
|
||||
JANET_CORE_REG("setdyn", janet_core_setdyn),
|
||||
JANET_CORE_REG("trace", janet_core_trace),
|
||||
JANET_CORE_REG("untrace", janet_core_untrace),
|
||||
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
|
||||
JANET_CORE_REG("int?", janet_core_check_int),
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
|
||||
janet_lib_io(env);
|
||||
janet_lib_math(env);
|
||||
janet_lib_array(env);
|
||||
@ -1052,9 +1007,6 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
janet_lib_inttypes(env);
|
||||
#endif
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_lib_ev(env);
|
||||
#endif
|
||||
@ -1238,8 +1190,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Memoize core env, ignoring replacements the second time around. */
|
||||
if (NULL != janet_vm_core_env) {
|
||||
return janet_vm_core_env;
|
||||
if (NULL != janet_vm.core_env) {
|
||||
return janet_vm.core_env;
|
||||
}
|
||||
|
||||
JanetTable *dict = janet_core_lookup_table(replacements);
|
||||
@ -1255,7 +1207,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Memoize */
|
||||
janet_gcroot(marsh_out);
|
||||
JanetTable *env = janet_unwrap_table(marsh_out);
|
||||
janet_vm_core_env = env;
|
||||
janet_vm.core_env = env;
|
||||
|
||||
/* Invert image dict manually here. We can't do this in boot.janet as it
|
||||
* breaks deterministic builds */
|
||||
@ -1287,9 +1239,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
/* Add replacement functions to registry? */
|
||||
}
|
||||
}
|
||||
}
|
||||
|
202
src/core/debug.c
202
src/core/debug.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -55,7 +55,7 @@ void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
||||
/* Scan the heap for right func def */
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
/* Keep track of the best source mapping we have seen so far */
|
||||
int32_t besti = -1;
|
||||
int32_t best_line = -1;
|
||||
@ -86,7 +86,7 @@ void janet_debug_find(
|
||||
}
|
||||
}
|
||||
}
|
||||
current = current->next;
|
||||
current = current->data.next;
|
||||
}
|
||||
if (best_def) {
|
||||
*def_out = best_def;
|
||||
@ -118,6 +118,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
fiber = fibers[fi];
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetCFunRegistry *reg = NULL;
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
JanetFuncDef *def = NULL;
|
||||
i = frame->prevframe;
|
||||
@ -144,11 +145,19 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL))
|
||||
janet_eprintf(" %s", (const char *)janet_to_string(name));
|
||||
else
|
||||
reg = janet_registry_get(cfun);
|
||||
if (NULL != reg && NULL != reg->name) {
|
||||
if (reg->name_prefix) {
|
||||
janet_eprintf(" %s/%s", reg->name_prefix, reg->name);
|
||||
} else {
|
||||
janet_eprintf(" %s", reg->name);
|
||||
}
|
||||
if (NULL != reg->source_file) {
|
||||
janet_eprintf(" [%s]", reg->source_file);
|
||||
}
|
||||
} else {
|
||||
janet_eprintf(" <cfunction>");
|
||||
}
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
@ -161,6 +170,11 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
} else {
|
||||
janet_eprintf(" pc=%d", off);
|
||||
}
|
||||
} else if (NULL != reg) {
|
||||
/* C Function */
|
||||
if (reg->source_line > 0) {
|
||||
janet_eprintf(" on line %d", (long) reg->source_line);
|
||||
}
|
||||
}
|
||||
janet_eprintf("\n");
|
||||
}
|
||||
@ -195,7 +209,13 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
|
||||
*bytecode_offset = offset;
|
||||
}
|
||||
|
||||
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_break,
|
||||
"(debug/break source line col)",
|
||||
"Sets a breakpoint in `source` 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"
|
||||
"will set a breakpoint at line 10, 4th column of the file core.janet.") {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
@ -203,7 +223,11 @@ static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_unbreak,
|
||||
"(debug/unbreak source line column)",
|
||||
"Remove a breakpoint with a source key at a given line and column. "
|
||||
"Will throw an error if the breakpoint "
|
||||
"cannot be found.") {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset = 0;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
@ -211,7 +235,11 @@ static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_fbreak,
|
||||
"(debug/fbreak fun &opt pc)",
|
||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||
"if the offset is too large or negative.") {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset = 0;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
@ -219,7 +247,9 @@ static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_unfbreak,
|
||||
"(debug/unfbreak fun &opt pc)",
|
||||
"Unset a breakpoint set with debug/fbreak.") {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
@ -227,7 +257,12 @@ static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_lineage,
|
||||
"(debug/lineage fib)",
|
||||
"Returns an array of all child fibers from a root fiber. This function "
|
||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
@ -252,9 +287,20 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL)) {
|
||||
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||
JanetCFunRegistry *reg = janet_registry_get(cfun);
|
||||
if (NULL != reg->name) {
|
||||
if (NULL != reg->name_prefix) {
|
||||
janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(janet_formatc("%s/%s", reg->name_prefix, reg->name)));
|
||||
} else {
|
||||
janet_table_put(t, janet_ckeywordv("name"), janet_cstringv(reg->name));
|
||||
}
|
||||
if (NULL != reg->source_file) {
|
||||
janet_table_put(t, janet_ckeywordv("source"), janet_cstringv(reg->source_file));
|
||||
}
|
||||
if (reg->source_line > 0) {
|
||||
janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(reg->source_line));
|
||||
janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(1));
|
||||
}
|
||||
}
|
||||
}
|
||||
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||
@ -284,7 +330,21 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_stack,
|
||||
"(debug/stack fib)",
|
||||
"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 "
|
||||
"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") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
@ -300,7 +360,11 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_stacktrace,
|
||||
"(debug/stacktrace fiber &opt err)",
|
||||
"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 skip the error line. Returns the fiber.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
@ -308,7 +372,11 @@ static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_argstack,
|
||||
"(debug/arg-stack fiber)",
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
@ -317,7 +385,11 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_debug_step,
|
||||
"(debug/step fiber &opt x)",
|
||||
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
|
||||
"pass in a value that will be passed as the resuming value. Returns the signal value, "
|
||||
"which will usually be nil, as breakpoints raise nil signals.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet out = janet_wrap_nil();
|
||||
@ -325,85 +397,19 @@ static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||
return out;
|
||||
}
|
||||
|
||||
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. "
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"debug/unbreak", cfun_debug_unbreak,
|
||||
JDOC("(debug/unbreak source line column)\n\n"
|
||||
"Remove a breakpoint with a source key at a given line and column. "
|
||||
"Will throw an error if the breakpoint "
|
||||
"cannot be found.")
|
||||
},
|
||||
{
|
||||
"debug/fbreak", cfun_debug_fbreak,
|
||||
JDOC("(debug/fbreak fun &opt pc)\n\n"
|
||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||
"if the offset is too large or negative.")
|
||||
},
|
||||
{
|
||||
"debug/unfbreak", cfun_debug_unfbreak,
|
||||
JDOC("(debug/unfbreak fun &opt pc)\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak.")
|
||||
},
|
||||
{
|
||||
"debug/arg-stack", cfun_debug_argstack,
|
||||
JDOC("(debug/arg-stack fiber)\n\n"
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array.")
|
||||
},
|
||||
{
|
||||
"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 "
|
||||
"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")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"debug/lineage", cfun_debug_lineage,
|
||||
JDOC("(debug/lineage fib)\n\n"
|
||||
"Returns an array of all child fibers from a root fiber. This function "
|
||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes.")
|
||||
},
|
||||
{
|
||||
"debug/step", cfun_debug_step,
|
||||
JDOC("(debug/step fiber &opt x)\n\n"
|
||||
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
|
||||
"pass in a value that will be passed as the resuming value. Returns the signal value, "
|
||||
"which will usually be nil, as breakpoints raise nil signals.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_debug(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||
JanetRegExt debug_cfuns[] = {
|
||||
JANET_CORE_REG("debug/break", cfun_debug_break),
|
||||
JANET_CORE_REG("debug/unbreak", cfun_debug_unbreak),
|
||||
JANET_CORE_REG("debug/fbreak", cfun_debug_fbreak),
|
||||
JANET_CORE_REG("debug/unfbreak", cfun_debug_unfbreak),
|
||||
JANET_CORE_REG("debug/arg-stack", cfun_debug_argstack),
|
||||
JANET_CORE_REG("debug/stack", cfun_debug_stack),
|
||||
JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
|
||||
JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
|
||||
JANET_CORE_REG("debug/step", cfun_debug_step),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, debug_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
1670
src/core/ev.c
1670
src/core/ev.c
File diff suppressed because it is too large
Load Diff
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
203
src/core/fiber.c
203
src/core/fiber.c
@ -57,7 +57,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_next_collection += sizeof(Janet) * capacity;
|
||||
janet_vm.next_collection += sizeof(Janet) * capacity;
|
||||
fiber->data = data;
|
||||
return fiber;
|
||||
}
|
||||
@ -121,7 +121,7 @@ void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
}
|
||||
fiber->data = newData;
|
||||
fiber->capacity = n;
|
||||
janet_vm_next_collection += sizeof(Janet) * diff;
|
||||
janet_vm.next_collection += sizeof(Janet) * diff;
|
||||
}
|
||||
|
||||
/* Grow fiber if needed */
|
||||
@ -255,7 +255,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = janet_malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
janet_vm.next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@ -442,16 +442,19 @@ JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||
}
|
||||
|
||||
JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
return janet_vm.fiber;
|
||||
}
|
||||
|
||||
JanetFiber *janet_root_fiber(void) {
|
||||
return janet_vm_root_fiber;
|
||||
return janet_vm.root_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_getenv,
|
||||
"(fiber/getenv fiber)",
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->env ?
|
||||
@ -459,7 +462,10 @@ static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_setenv,
|
||||
"(fiber/setenv fiber table)",
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||
@ -470,7 +476,30 @@ static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_new,
|
||||
"(fiber/new func &opt sigmask)",
|
||||
"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"
|
||||
"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"
|
||||
"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") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
@ -520,17 +549,17 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_vm_fiber->env;
|
||||
fiber->env = janet_vm.fiber->env;
|
||||
break;
|
||||
case 'p':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_table(0);
|
||||
fiber->env->proto = janet_vm_fiber->env;
|
||||
fiber->env->proto = janet_vm.fiber->env;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@ -539,32 +568,53 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_status,
|
||||
"(fiber/status fib)",
|
||||
"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") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = janet_fiber_status(fiber);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_current,
|
||||
"(fiber/current)",
|
||||
"Returns the currently running fiber.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
return janet_wrap_fiber(janet_vm.fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_root,
|
||||
"(fiber/root)",
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_root_fiber);
|
||||
return janet_wrap_fiber(janet_vm.root_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_maxstack,
|
||||
"(fiber/maxstack fib)",
|
||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||
"than this amount and will throw a stack-overflow error if more memory is needed. ") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return janet_wrap_integer(fiber->maxstack);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_setmaxstack,
|
||||
"(fiber/setmaxstack fib maxstack)",
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
int32_t maxs = janet_getinteger(argv, 1);
|
||||
@ -575,7 +625,9 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
"(fiber/can-resume? fiber)",
|
||||
"Check if a fiber is finished and cannot be resumed.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetFiberStatus s = janet_fiber_status(fiber);
|
||||
@ -589,101 +641,28 @@ 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_CORE_FN(cfun_fiber_last_value,
|
||||
"(fiber/last-value)",
|
||||
"Get the last value returned or signaled from the fiber.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->last_value;
|
||||
}
|
||||
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
JDOC("(fiber/new func &opt sigmask)\n\n"
|
||||
"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"
|
||||
"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"
|
||||
"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")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"fiber/current", cfun_fiber_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
"Returns the currently running fiber.")
|
||||
},
|
||||
{
|
||||
"fiber/maxstack", cfun_fiber_maxstack,
|
||||
JDOC("(fiber/maxstack fib)\n\n"
|
||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||
},
|
||||
{
|
||||
"fiber/setmaxstack", cfun_fiber_setmaxstack,
|
||||
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{
|
||||
"fiber/getenv", cfun_fiber_getenv,
|
||||
JDOC("(fiber/getenv fiber)\n\n"
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.")
|
||||
},
|
||||
{
|
||||
"fiber/setenv", cfun_fiber_setenv,
|
||||
JDOC("(fiber/setenv fiber table)\n\n"
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{
|
||||
"fiber/can-resume?", cfun_fiber_can_resume,
|
||||
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}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_fiber(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||
JanetRegExt fiber_cfuns[] = {
|
||||
JANET_CORE_REG("fiber/new", cfun_fiber_new),
|
||||
JANET_CORE_REG("fiber/status", cfun_fiber_status),
|
||||
JANET_CORE_REG("fiber/root", cfun_fiber_root),
|
||||
JANET_CORE_REG("fiber/current", cfun_fiber_current),
|
||||
JANET_CORE_REG("fiber/maxstack", cfun_fiber_maxstack),
|
||||
JANET_CORE_REG("fiber/setmaxstack", cfun_fiber_setmaxstack),
|
||||
JANET_CORE_REG("fiber/getenv", cfun_fiber_getenv),
|
||||
JANET_CORE_REG("fiber/setenv", cfun_fiber_setenv),
|
||||
JANET_CORE_REG("fiber/can-resume?", cfun_fiber_can_resume),
|
||||
JANET_CORE_REG("fiber/last-value", cfun_fiber_last_value),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, fiber_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -47,7 +47,6 @@
|
||||
#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_OFFSET 16
|
||||
|
||||
@ -57,8 +56,6 @@
|
||||
#define JANET_FIBER_DID_LONGJUMP 0x8000000
|
||||
#define JANET_FIBER_FLAG_MASK 0xF000000
|
||||
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
#define janet_fiber_set_status(f, s) do {\
|
||||
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
||||
(f)->flags |= (s) << JANET_FIBER_STATUS_OFFSET;\
|
||||
|
202
src/core/gc.c
202
src/core/gc.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,28 +31,6 @@
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
};
|
||||
|
||||
/* GC State */
|
||||
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 */
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Helpers for marking the various gc types */
|
||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||
@ -72,7 +50,7 @@ static JANET_THREAD_LOCAL size_t orig_rootcount;
|
||||
|
||||
/* Hint to the GC that we may need to collect */
|
||||
void janet_gcpressure(size_t s) {
|
||||
janet_vm_next_collection += s;
|
||||
janet_vm.next_collection += s;
|
||||
}
|
||||
|
||||
/* Mark a value */
|
||||
@ -127,6 +105,14 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
static void janet_mark_abstract(void *adata) {
|
||||
#ifdef JANET_EV
|
||||
/* Check if abstract type is a threaded abstract type. If it is, marking means
|
||||
* updating the threaded_abstract table. */
|
||||
if ((janet_abstract_head(adata)->gc.flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_THREADED_ABSTRACT) {
|
||||
janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(adata), janet_wrap_true());
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||
return;
|
||||
janet_gc_mark(janet_abstract_head(adata));
|
||||
@ -137,6 +123,8 @@ static void janet_mark_abstract(void *adata) {
|
||||
|
||||
/* Mark a bunch of items in memory */
|
||||
static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
if (values == NULL)
|
||||
return;
|
||||
const Janet *end = values + n;
|
||||
while (values < end) {
|
||||
janet_mark(*values);
|
||||
@ -174,10 +162,13 @@ recur: /* Manual tail recursion */
|
||||
}
|
||||
|
||||
static void janet_mark_struct(const JanetKV *st) {
|
||||
recur:
|
||||
if (janet_gc_reachable(janet_struct_head(st)))
|
||||
return;
|
||||
janet_gc_mark(janet_struct_head(st));
|
||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||
st = janet_struct_proto(st);
|
||||
if (st) goto recur;
|
||||
}
|
||||
|
||||
static void janet_mark_tuple(const Janet *tuple) {
|
||||
@ -332,25 +323,61 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||
void janet_sweep() {
|
||||
JanetGCObject *previous = NULL;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
JanetGCObject *next;
|
||||
while (NULL != current) {
|
||||
next = current->next;
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
previous = current;
|
||||
current->flags &= ~JANET_MEM_REACHABLE;
|
||||
} else {
|
||||
janet_vm_block_count--;
|
||||
janet_vm.block_count--;
|
||||
janet_deinit_block(current);
|
||||
if (NULL != previous) {
|
||||
previous->next = next;
|
||||
previous->data.next = next;
|
||||
} else {
|
||||
janet_vm_blocks = next;
|
||||
janet_vm.blocks = next;
|
||||
}
|
||||
janet_free(current);
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
/* Sweep threaded abstract types for references to decrement */
|
||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
||||
|
||||
/* If item was not visited during the mark phase, then this
|
||||
* abstract type isn't present in the heap and needs its refcount
|
||||
* decremented, and shouuld be removed from table. If the refcount is
|
||||
* then 0, the item will be collected. This ensures that only one interpreter
|
||||
* will clean up the threaded abstract. */
|
||||
|
||||
/* If not visited... */
|
||||
if (!janet_truthy(items[i].value)) {
|
||||
void *abst = janet_unwrap_abstract(items[i].key);
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
/* Run finalizer */
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
/* Free memory */
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
}
|
||||
|
||||
/* Reset for next sweep */
|
||||
items[i].value = janet_wrap_false();
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Allocate some memory that is tracked for garbage collection */
|
||||
@ -358,7 +385,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
JanetGCObject *mem;
|
||||
|
||||
/* Make sure everything is inited */
|
||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||
janet_assert(NULL != janet_vm.cache, "please initialize janet before use");
|
||||
mem = janet_malloc(size);
|
||||
|
||||
/* Check for bad malloc */
|
||||
@ -370,10 +397,10 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
mem->flags = type;
|
||||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm_next_collection += size;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
janet_vm_block_count++;
|
||||
janet_vm.next_collection += size;
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
janet_vm.block_count++;
|
||||
|
||||
return (void *)mem;
|
||||
}
|
||||
@ -387,10 +414,10 @@ static void free_one_scratch(JanetScratch *s) {
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
static void janet_free_all_scratch(void) {
|
||||
for (size_t i = 0; i < janet_scratch_len; i++) {
|
||||
free_one_scratch(janet_scratch_mem[i]);
|
||||
for (size_t i = 0; i < janet_vm.scratch_len; i++) {
|
||||
free_one_scratch(janet_vm.scratch_mem[i]);
|
||||
}
|
||||
janet_scratch_len = 0;
|
||||
janet_vm.scratch_len = 0;
|
||||
}
|
||||
|
||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
@ -401,29 +428,29 @@ static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
if (janet_vm_gc_suspend) return;
|
||||
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.
|
||||
* 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);
|
||||
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;
|
||||
orig_rootcount = janet_vm.root_count;
|
||||
#ifdef JANET_EV
|
||||
janet_ev_mark();
|
||||
#endif
|
||||
janet_mark_fiber(janet_vm_root_fiber);
|
||||
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) {
|
||||
Janet x = janet_vm_roots[--janet_vm_root_count];
|
||||
janet_mark(janet_vm.roots[i]);
|
||||
while (orig_rootcount < janet_vm.root_count) {
|
||||
Janet x = janet_vm.roots[--janet_vm.root_count];
|
||||
janet_mark(x);
|
||||
}
|
||||
janet_sweep();
|
||||
janet_vm_next_collection = 0;
|
||||
janet_vm.next_collection = 0;
|
||||
janet_free_all_scratch();
|
||||
}
|
||||
|
||||
@ -431,17 +458,17 @@ void janet_collect(void) {
|
||||
* and all of its children. If gcroot is called on a value n times, unroot
|
||||
* must also be called n times to remove it as a gc root. */
|
||||
void janet_gcroot(Janet root) {
|
||||
size_t newcount = janet_vm_root_count + 1;
|
||||
if (newcount > janet_vm_root_capacity) {
|
||||
size_t newcount = janet_vm.root_count + 1;
|
||||
if (newcount > janet_vm.root_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm_roots) {
|
||||
janet_vm.roots = janet_realloc(janet_vm.roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm.roots) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_root_capacity = newcap;
|
||||
janet_vm.root_capacity = newcap;
|
||||
}
|
||||
janet_vm_roots[janet_vm_root_count] = root;
|
||||
janet_vm_root_count = newcount;
|
||||
janet_vm.roots[janet_vm.root_count] = root;
|
||||
janet_vm.root_count = newcount;
|
||||
}
|
||||
|
||||
/* Identity equality for GC purposes */
|
||||
@ -462,11 +489,11 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
||||
/* Remove a root value from the GC. This allows the gc to potentially reclaim
|
||||
* a value and all its children. */
|
||||
int janet_gcunroot(Janet root) {
|
||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||
Janet *vtop = janet_vm.roots + janet_vm.root_count;
|
||||
/* Search from top to bottom as access is most likely LIFO */
|
||||
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||
for (Janet *v = janet_vm.roots; v < vtop; v++) {
|
||||
if (janet_gc_idequals(root, *v)) {
|
||||
*v = janet_vm_roots[--janet_vm_root_count];
|
||||
*v = janet_vm.roots[--janet_vm.root_count];
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
@ -475,12 +502,12 @@ int janet_gcunroot(Janet root) {
|
||||
|
||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||
int janet_gcunrootall(Janet root) {
|
||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||
Janet *vtop = janet_vm.roots + janet_vm.root_count;
|
||||
int ret = 0;
|
||||
/* Search from top to bottom as access is most likely LIFO */
|
||||
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||
for (Janet *v = janet_vm.roots; v < vtop; v++) {
|
||||
if (janet_gc_idequals(root, *v)) {
|
||||
*v = janet_vm_roots[--janet_vm_root_count];
|
||||
*v = janet_vm.roots[--janet_vm.root_count];
|
||||
vtop--;
|
||||
ret = 1;
|
||||
}
|
||||
@ -490,24 +517,39 @@ int janet_gcunrootall(Janet root) {
|
||||
|
||||
/* Free all allocated memory */
|
||||
void janet_clear_memory(void) {
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
#ifdef JANET_EV
|
||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(items[i].key);
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
while (NULL != current) {
|
||||
janet_deinit_block(current);
|
||||
JanetGCObject *next = current->next;
|
||||
JanetGCObject *next = current->data.next;
|
||||
janet_free(current);
|
||||
current = next;
|
||||
}
|
||||
janet_vm_blocks = NULL;
|
||||
janet_vm.blocks = NULL;
|
||||
janet_free_all_scratch();
|
||||
janet_free(janet_scratch_mem);
|
||||
janet_free(janet_vm.scratch_mem);
|
||||
}
|
||||
|
||||
/* Primitives for suspending GC. */
|
||||
int janet_gclock(void) {
|
||||
return janet_vm_gc_suspend++;
|
||||
return janet_vm.gc_suspend++;
|
||||
}
|
||||
void janet_gcunlock(int handle) {
|
||||
janet_vm_gc_suspend = handle;
|
||||
janet_vm.gc_suspend = handle;
|
||||
}
|
||||
|
||||
/* Scratch memory API */
|
||||
@ -518,16 +560,16 @@ void *janet_smalloc(size_t size) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
s->finalize = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (janet_vm.scratch_len == janet_vm.scratch_cap) {
|
||||
size_t newcap = 2 * janet_vm.scratch_cap + 2;
|
||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_vm.scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
janet_vm.scratch_cap = newcap;
|
||||
janet_vm.scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = s;
|
||||
janet_vm.scratch_mem[janet_vm.scratch_len++] = s;
|
||||
return (char *)(s->mem);
|
||||
}
|
||||
|
||||
@ -544,14 +586,14 @@ void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
if (janet_vm.scratch_len) {
|
||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
||||
if (janet_vm.scratch_mem[i] == s) {
|
||||
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = news;
|
||||
janet_vm.scratch_mem[i] = news;
|
||||
return (char *)(news->mem);
|
||||
}
|
||||
if (i == 0) break;
|
||||
@ -568,10 +610,10 @@ void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
if (janet_vm.scratch_len) {
|
||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
||||
if (janet_vm.scratch_mem[i] == s) {
|
||||
janet_vm.scratch_mem[i] = janet_vm.scratch_mem[--janet_vm.scratch_len];
|
||||
free_one_scratch(s);
|
||||
return;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -55,10 +55,11 @@ enum JanetMemoryType {
|
||||
JANET_MEMORY_FUNCTION,
|
||||
JANET_MEMORY_ABSTRACT,
|
||||
JANET_MEMORY_FUNCENV,
|
||||
JANET_MEMORY_FUNCDEF
|
||||
JANET_MEMORY_FUNCDEF,
|
||||
JANET_MEMORY_THREADED_ABSTRACT,
|
||||
};
|
||||
|
||||
/* To allocate collectable memory, one must calk janet_alloc, initialize the memory,
|
||||
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
|
||||
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
|
||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
|
||||
|
||||
|
@ -193,12 +193,16 @@ Janet janet_wrap_u64(uint64_t x) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_it_s64_new,
|
||||
"(int/s64 value)",
|
||||
"Create a boxed signed 64 bit integer from a string value.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_it_u64_new,
|
||||
"(int/u64 value)",
|
||||
"Create a boxed unsigned 64 bit integer from a string value.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
@ -505,23 +509,14 @@ static int it_u64_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg it_cfuns[] = {
|
||||
{
|
||||
"int/s64", cfun_it_s64_new,
|
||||
JDOC("(int/s64 value)\n\n"
|
||||
"Create a boxed signed 64 bit integer from a string value.")
|
||||
},
|
||||
{
|
||||
"int/u64", cfun_it_u64_new,
|
||||
JDOC("(int/u64 value)\n\n"
|
||||
"Create a boxed unsigned 64 bit integer from a string value.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_inttypes(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, it_cfuns);
|
||||
JanetRegExt it_cfuns[] = {
|
||||
JANET_CORE_REG("int/s64", cfun_it_s64_new),
|
||||
JANET_CORE_REG("int/u64", cfun_it_u64_new),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, it_cfuns);
|
||||
janet_register_abstract_type(&janet_s64_type);
|
||||
janet_register_abstract_type(&janet_u64_type);
|
||||
}
|
||||
|
325
src/core/io.c
325
src/core/io.c
@ -114,7 +114,12 @@ static void *makef(FILE *f, int32_t flags) {
|
||||
|
||||
/* Open a process */
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_popen,
|
||||
"(file/popen command &opt mode) (DEPRECATED for os/spawn)",
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
@ -143,7 +148,10 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_temp,
|
||||
"(file/temp)",
|
||||
"Open an anonymous temporary file that is removed on close. "
|
||||
"Raises an error on failure.") {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
@ -153,7 +161,20 @@ static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||
}
|
||||
|
||||
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fopen,
|
||||
"(file/open path &opt mode)",
|
||||
"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") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
@ -184,7 +205,16 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
}
|
||||
|
||||
/* Read a certain number of bytes into memory */
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fread,
|
||||
"(file/read f what &opt buf)",
|
||||
"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 "
|
||||
"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") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
@ -224,7 +254,10 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Write bytes to a file */
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fwrite,
|
||||
"(file/write f bytes)",
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@ -247,7 +280,10 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Flush the bytes in the file */
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fflush,
|
||||
"(file/flush f)",
|
||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@ -291,7 +327,12 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
}
|
||||
|
||||
/* Close a file */
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fclose,
|
||||
"(file/close f)",
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file. If the file is the result of a file/popen "
|
||||
"call, close waits for and returns the process exit status.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@ -318,7 +359,15 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_fseek,
|
||||
"(file/seek f &opt whence 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.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@ -480,28 +529,47 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_print,
|
||||
"(print & xs)",
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Use the value of (dyn :out stdout) to determine "
|
||||
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
|
||||
"a buffer. Returns nil.") {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_prin(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_prin,
|
||||
"(prin & xs)",
|
||||
"Same as print, but does not add trailing newline.") {
|
||||
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_eprint,
|
||||
"(eprint & xs)",
|
||||
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
|
||||
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_eprin,
|
||||
"(eprin & xs)",
|
||||
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_xprint,
|
||||
"(xprint to & xs)",
|
||||
"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.") {
|
||||
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_CORE_FN(cfun_io_xprin,
|
||||
"(xprin to & xs)",
|
||||
"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.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
@ -557,28 +625,40 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_printf,
|
||||
"(printf fmt & xs)",
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_prinf,
|
||||
"(prinf fmt & xs)",
|
||||
"Like printf but with no trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_eprintf,
|
||||
"(eprintf fmt & xs)",
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_eprinf,
|
||||
"(eprinf fmt & xs)",
|
||||
"Like eprintf but with no trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_xprintf,
|
||||
"(xprintf to fmt & xs)",
|
||||
"Like printf but prints to an explicit file or value to. Returns nil.") {
|
||||
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_CORE_FN(cfun_io_xprinf,
|
||||
"(xprinf to fmt & xs)",
|
||||
"Like prinf but prints to an explicit file or value to. Returns nil.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
@ -601,14 +681,18 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_flush,
|
||||
"(flush)",
|
||||
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("out", stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_io_eflush,
|
||||
"(eflush)",
|
||||
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("err", stderr);
|
||||
@ -651,162 +735,6 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
return;
|
||||
}
|
||||
|
||||
static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"print", cfun_io_print,
|
||||
JDOC("(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Use the value of (dyn :out stdout) to determine "
|
||||
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
|
||||
"a buffer. Returns nil.")
|
||||
},
|
||||
{
|
||||
"prin", cfun_io_prin,
|
||||
JDOC("(prin & xs)\n\n"
|
||||
"Same as print, but does not add trailing newline.")
|
||||
},
|
||||
{
|
||||
"printf", cfun_io_printf,
|
||||
JDOC("(printf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.")
|
||||
},
|
||||
{
|
||||
"prinf", cfun_io_prinf,
|
||||
JDOC("(prinf fmt & xs)\n\n"
|
||||
"Like printf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"eprin", cfun_io_eprin,
|
||||
JDOC("(eprin & xs)\n\n"
|
||||
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||
},
|
||||
{
|
||||
"eprint", cfun_io_eprint,
|
||||
JDOC("(eprint & xs)\n\n"
|
||||
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||
},
|
||||
{
|
||||
"eprintf", cfun_io_eprintf,
|
||||
JDOC("(eprintf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.")
|
||||
},
|
||||
{
|
||||
"eprinf", cfun_io_eprinf,
|
||||
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"
|
||||
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"eflush", cfun_io_eflush,
|
||||
JDOC("(eflush)\n\n"
|
||||
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"file/temp", cfun_io_temp,
|
||||
JDOC("(file/temp)\n\n"
|
||||
"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 "
|
||||
"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")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file. If the file is the result of a file/popen "
|
||||
"call, close waits for and returns the process exit status.")
|
||||
},
|
||||
{
|
||||
"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 "
|
||||
"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")
|
||||
},
|
||||
{
|
||||
"file/write", cfun_io_fwrite,
|
||||
JDOC("(file/write f bytes)\n\n"
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file.")
|
||||
},
|
||||
{
|
||||
"file/flush", cfun_io_fflush,
|
||||
JDOC("(file/flush f)\n\n"
|
||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle.")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\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) {
|
||||
@ -839,20 +767,47 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
JanetRegExt io_cfuns[] = {
|
||||
JANET_CORE_REG("print", cfun_io_print),
|
||||
JANET_CORE_REG("prin", cfun_io_prin),
|
||||
JANET_CORE_REG("printf", cfun_io_printf),
|
||||
JANET_CORE_REG("prinf", cfun_io_prinf),
|
||||
JANET_CORE_REG("eprin", cfun_io_eprin),
|
||||
JANET_CORE_REG("eprint", cfun_io_eprint),
|
||||
JANET_CORE_REG("eprintf", cfun_io_eprintf),
|
||||
JANET_CORE_REG("eprinf", cfun_io_eprinf),
|
||||
JANET_CORE_REG("xprint", cfun_io_xprint),
|
||||
JANET_CORE_REG("xprin", cfun_io_xprin),
|
||||
JANET_CORE_REG("xprintf", cfun_io_xprintf),
|
||||
JANET_CORE_REG("xprinf", cfun_io_xprinf),
|
||||
JANET_CORE_REG("flush", cfun_io_flush),
|
||||
JANET_CORE_REG("eflush", cfun_io_eflush),
|
||||
JANET_CORE_REG("file/temp", cfun_io_temp),
|
||||
JANET_CORE_REG("file/open", cfun_io_fopen),
|
||||
JANET_CORE_REG("file/close", cfun_io_fclose),
|
||||
JANET_CORE_REG("file/read", cfun_io_fread),
|
||||
JANET_CORE_REG("file/write", cfun_io_fwrite),
|
||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_REG("file/popen", cfun_io_popen),
|
||||
#endif
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(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_CORE_DEF(env, "stdout",
|
||||
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard output file."));
|
||||
"The standard output file.");
|
||||
/* stderr */
|
||||
janet_core_def(env, "stderr",
|
||||
JANET_CORE_DEF(env, "stderr",
|
||||
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard error file."));
|
||||
"The standard error file.");
|
||||
/* stdin */
|
||||
janet_core_def(env, "stdin",
|
||||
JANET_CORE_DEF(env, "stdin",
|
||||
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
||||
JDOC("The standard input file."));
|
||||
"The standard input file.");
|
||||
|
||||
}
|
||||
|
146
src/core/marsh.c
146
src/core/marsh.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -65,6 +65,9 @@ enum {
|
||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||
LB_UNSAFE_POINTER, /* 222 */
|
||||
LB_STRUCT_PROTO, /* 223 */
|
||||
#ifdef JANET_EV
|
||||
LB_THREADED_ABSTRACT/* 224 */
|
||||
#endif
|
||||
} LeadBytes;
|
||||
|
||||
/* Helper to look inside an entry in an environment */
|
||||
@ -326,6 +329,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
}
|
||||
if (fiber->child)
|
||||
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
||||
marshal_one(st, fiber->last_value, flags + 1);
|
||||
}
|
||||
|
||||
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
|
||||
@ -370,6 +374,21 @@ void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
#ifdef JANET_EV
|
||||
/* Threaded abstract types get passed through as pointers in the unsafe mode */
|
||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
||||
(JANET_MEMORY_THREADED_ABSTRACT == (janet_abstract_head(abstract)->gc.flags & JANET_MEM_TYPEBITS))) {
|
||||
|
||||
/* Increment refcount before sending message. This prevents a "death in transit" problem
|
||||
* where a message is garbage collected while in transit between two threads - i.e., the sending threads
|
||||
* loses the reference and runs a garbage collection before the receiving thread gets the message. */
|
||||
janet_abstract_incref(abstract);
|
||||
pushbyte(st, LB_THREADED_ABSTRACT);
|
||||
pushbytes(st, (uint8_t *) &abstract, sizeof(abstract));
|
||||
MARK_SEEN();
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
const JanetAbstractType *at = janet_abstract_type(abstract);
|
||||
if (at->marshal) {
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
@ -377,7 +396,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||
janet_panicf("cannot marshal %p", x);
|
||||
}
|
||||
}
|
||||
|
||||
@ -545,9 +564,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_FUNCTION: {
|
||||
pushbyte(st, LB_FUNCTION);
|
||||
JanetFunction *func = janet_unwrap_function(x);
|
||||
pushint(st, func->def->environments_length);
|
||||
/* Mark seen before reading def */
|
||||
MARK_SEEN();
|
||||
pushint(st, func->def->environments_length);
|
||||
marshal_one_def(st, func->def, flags);
|
||||
for (int32_t i = 0; i < func->def->environments_length; i++)
|
||||
marshal_one_env(st, func->envs[i], flags + 1);
|
||||
@ -938,6 +957,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
@ -1049,6 +1069,9 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
/* Get the fiber last value */
|
||||
data = unmarshal_one(st, data, &fiber->last_value, flags + 1);
|
||||
|
||||
/* We have valid fiber, finally construct remaining fields. */
|
||||
fiber->frame = frame;
|
||||
fiber->flags = fiber_flags;
|
||||
@ -1106,14 +1129,18 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
||||
void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
if (ctx->at == NULL) {
|
||||
janet_panicf("janet_unmarshal_abstract called more than once");
|
||||
}
|
||||
void *p = janet_abstract(ctx->at, size);
|
||||
janet_v_push(st->lookup, janet_wrap_abstract(p));
|
||||
ctx->at = NULL;
|
||||
}
|
||||
|
||||
void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
||||
void *p = janet_abstract(ctx->at, size);
|
||||
janet_unmarshal_abstract_reuse(ctx, p);
|
||||
return p;
|
||||
}
|
||||
|
||||
@ -1121,17 +1148,16 @@ 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) janet_panic("unknown abstract type");
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
if (context.at != NULL) {
|
||||
janet_panicf("janet_unmarshal_abstract not called");
|
||||
janet_panic("janet_unmarshal_abstract not called");
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
oops:
|
||||
janet_panic("invalid abstract type");
|
||||
janet_panic("invalid abstract type - no unmarshal function pointer");
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one(
|
||||
@ -1236,18 +1262,16 @@ static const uint8_t *unmarshal_one(
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
if (len > 255) {
|
||||
janet_panicf("invalid function");
|
||||
janet_panicf("invalid function - too many environments (%d)", len);
|
||||
}
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
len * sizeof(JanetFuncEnv));
|
||||
func->def = NULL;
|
||||
*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++) {
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
||||
}
|
||||
return data;
|
||||
@ -1367,6 +1391,42 @@ static const uint8_t *unmarshal_one(
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
case LB_THREADED_ABSTRACT: {
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal threaded abstract 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 *);
|
||||
|
||||
if (flags & JANET_MARSHAL_DECREF) {
|
||||
/* Decrement immediately and don't bother putting into heap */
|
||||
janet_abstract_decref(u.ptr);
|
||||
*out = janet_wrap_nil();
|
||||
} else {
|
||||
*out = janet_wrap_abstract(u.ptr);
|
||||
Janet check = janet_table_get(&janet_vm.threaded_abstracts, *out);
|
||||
if (janet_checktype(check, JANET_NIL)) {
|
||||
/* Transfers reference from threaded channel buffer to current heap */
|
||||
janet_table_put(&janet_vm.threaded_abstracts, *out, janet_wrap_false());
|
||||
} else {
|
||||
/* Heap reference already accounted for, remove threaded channel reference. */
|
||||
janet_abstract_decref(u.ptr);
|
||||
}
|
||||
}
|
||||
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#endif
|
||||
default: {
|
||||
janet_panicf("unknown byte %x at index %d",
|
||||
*data,
|
||||
@ -1374,7 +1434,6 @@ static const uint8_t *unmarshal_one(
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
#undef EXTRA
|
||||
}
|
||||
|
||||
Janet janet_unmarshal(
|
||||
@ -1401,13 +1460,24 @@ Janet janet_unmarshal(
|
||||
|
||||
/* C functions */
|
||||
|
||||
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_env_lookup,
|
||||
"(env-lookup env)",
|
||||
"Creates a forward lookup table for unmarshalling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *env = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_env_lookup(env));
|
||||
}
|
||||
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_marshal,
|
||||
"(marshal x &opt reverse-lookup buffer)",
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can then 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 "
|
||||
"unmarshalling.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
@ -1423,7 +1493,11 @@ static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_unmarshal,
|
||||
"(unmarshal buffer &opt lookup)",
|
||||
"Unmarshal a 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.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetTable *reg = NULL;
|
||||
@ -1433,35 +1507,13 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
|
||||
}
|
||||
|
||||
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. "
|
||||
"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 "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a 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.")
|
||||
},
|
||||
{
|
||||
"env-lookup", cfun_env_lookup,
|
||||
JDOC("(env-lookup env)\n\n"
|
||||
"Creates a forward lookup table for unmarshalling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_marsh(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, marsh_cfuns);
|
||||
JanetRegExt marsh_cfuns[] = {
|
||||
JANET_CORE_REG("marshal", cfun_marshal),
|
||||
JANET_CORE_REG("unmarshal", cfun_unmarshal),
|
||||
JANET_CORE_REG("env-lookup", cfun_env_lookup),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, marsh_cfuns);
|
||||
}
|
||||
|
450
src/core/math.c
450
src/core/math.c
@ -23,13 +23,12 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
|
||||
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);
|
||||
|
||||
@ -69,7 +68,7 @@ const JanetAbstractType janet_rng_type = {
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
return &janet_vm_rng;
|
||||
return &janet_vm.rng;
|
||||
}
|
||||
|
||||
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||
@ -118,7 +117,12 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
return ldexp((double)(big >> (64 - 52)), -52);
|
||||
}
|
||||
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_rng_make,
|
||||
"(math/rng &opt seed)",
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type."
|
||||
) {
|
||||
janet_arity(argc, 0, 1);
|
||||
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
||||
if (argc == 1) {
|
||||
@ -135,13 +139,20 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(rng);
|
||||
}
|
||||
|
||||
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_rng_uniform,
|
||||
"(math/rng-uniform rng)",
|
||||
"Extract a random number in the range [0, 1) from the RNG."
|
||||
) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
return janet_wrap_number(janet_rng_double(rng));
|
||||
}
|
||||
|
||||
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_rng_int,
|
||||
"(math/rng-int rng &opt max)",
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1."
|
||||
) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
if (argc == 1) {
|
||||
@ -169,7 +180,11 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
||||
buf[3] = (word >> 24) & 0xFF;
|
||||
}
|
||||
|
||||
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_rng_buffer,
|
||||
"(math/rng-buffer rng n &opt buf)",
|
||||
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
|
||||
"provided, otherwise appends to the given buffer. Returns the buffer."
|
||||
) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
@ -214,314 +229,193 @@ static Janet janet_rng_next(void *p, Janet key) {
|
||||
}
|
||||
|
||||
/* Get a random number */
|
||||
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_rand,
|
||||
"(math/random)",
|
||||
"Returns a uniformly distributed random number between 0 and 1") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(janet_rng_double(&janet_vm_rng));
|
||||
return janet_wrap_number(janet_rng_double(&janet_vm.rng));
|
||||
}
|
||||
|
||||
/* Seed the random number generator */
|
||||
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_srand,
|
||||
"(math/seedrandom seed)",
|
||||
"Set the seed for the random number generator. seed should be "
|
||||
"an integer or a buffer."
|
||||
) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checkint(argv[0])) {
|
||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||
janet_rng_seed(&janet_vm_rng, seed);
|
||||
janet_rng_seed(&janet_vm.rng, seed);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len);
|
||||
janet_rng_longseed(&janet_vm.rng, bytes.bytes, bytes.len);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos)
|
||||
JANET_DEFINE_MATHOP(asin, asin)
|
||||
JANET_DEFINE_MATHOP(atan, atan)
|
||||
JANET_DEFINE_MATHOP(cos, cos)
|
||||
JANET_DEFINE_MATHOP(cosh, cosh)
|
||||
JANET_DEFINE_MATHOP(acosh, acosh)
|
||||
JANET_DEFINE_MATHOP(sin, sin)
|
||||
JANET_DEFINE_MATHOP(sinh, sinh)
|
||||
JANET_DEFINE_MATHOP(asinh, asinh)
|
||||
JANET_DEFINE_MATHOP(tan, tan)
|
||||
JANET_DEFINE_MATHOP(tanh, tanh)
|
||||
JANET_DEFINE_MATHOP(atanh, atanh)
|
||||
JANET_DEFINE_MATHOP(exp, exp)
|
||||
JANET_DEFINE_MATHOP(exp2, exp2)
|
||||
JANET_DEFINE_MATHOP(expm1, expm1)
|
||||
JANET_DEFINE_MATHOP(log, log)
|
||||
JANET_DEFINE_MATHOP(log10, log10)
|
||||
JANET_DEFINE_MATHOP(log2, log2)
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt)
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt)
|
||||
JANET_DEFINE_MATHOP(ceil, ceil)
|
||||
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)
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosize of x.")
|
||||
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
|
||||
JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(exp, exp, "Returns e to the power of x.")
|
||||
JANET_DEFINE_MATHOP(exp2, exp2, "Returns 2 to the power of x.")
|
||||
JANET_DEFINE_MATHOP(expm1, expm1, "Returns e to the power of x minus 1.")
|
||||
JANET_DEFINE_MATHOP(log, log, "Returns the natural logarithm of x.")
|
||||
JANET_DEFINE_MATHOP(log10, log10, "Returns the log base 10 of x.")
|
||||
JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(gamma, lgamma, "Returns gamma(x).")
|
||||
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
|
||||
JANET_CORE_FN(janet_##name, signature, doc) {\
|
||||
janet_fixarity(argc, 2); \
|
||||
double lhs = janet_getnumber(argv, 0); \
|
||||
double rhs = janet_getnumber(argv, 1); \
|
||||
return janet_wrap_number(fop(lhs, rhs)); \
|
||||
}\
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter)
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
|
||||
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
|
||||
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||
}
|
||||
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
},
|
||||
{
|
||||
"math/random", janet_rand,
|
||||
JDOC("(math/random)\n\n"
|
||||
"Returns a uniformly distributed random number between 0 and 1.")
|
||||
},
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. seed should be "
|
||||
"an integer or a buffer.")
|
||||
},
|
||||
{
|
||||
"math/cos", janet_cos,
|
||||
JDOC("(math/cos x)\n\n"
|
||||
"Returns the cosine of x.")
|
||||
},
|
||||
{
|
||||
"math/sin", janet_sin,
|
||||
JDOC("(math/sin x)\n\n"
|
||||
"Returns the sine of x.")
|
||||
},
|
||||
{
|
||||
"math/tan", janet_tan,
|
||||
JDOC("(math/tan x)\n\n"
|
||||
"Returns the tangent of x.")
|
||||
},
|
||||
{
|
||||
"math/acos", janet_acos,
|
||||
JDOC("(math/acos x)\n\n"
|
||||
"Returns the arccosine of x.")
|
||||
},
|
||||
{
|
||||
"math/asin", janet_asin,
|
||||
JDOC("(math/asin x)\n\n"
|
||||
"Returns the arcsine of x.")
|
||||
},
|
||||
{
|
||||
"math/atan", janet_atan,
|
||||
JDOC("(math/atan x)\n\n"
|
||||
"Returns the arctangent of x.")
|
||||
},
|
||||
{
|
||||
"math/exp", janet_exp,
|
||||
JDOC("(math/exp x)\n\n"
|
||||
"Returns e to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/log", janet_log,
|
||||
JDOC("(math/log x)\n\n"
|
||||
"Returns log base natural number of x.")
|
||||
},
|
||||
{
|
||||
"math/log10", janet_log10,
|
||||
JDOC("(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x.")
|
||||
},
|
||||
{
|
||||
"math/log2", janet_log2,
|
||||
JDOC("(math/log2 x)\n\n"
|
||||
"Returns log base 2 of x.")
|
||||
},
|
||||
{
|
||||
"math/sqrt", janet_sqrt,
|
||||
JDOC("(math/sqrt x)\n\n"
|
||||
"Returns the square root of x.")
|
||||
},
|
||||
{
|
||||
"math/cbrt", janet_cbrt,
|
||||
JDOC("(math/cbrt x)\n\n"
|
||||
"Returns the cube root of x.")
|
||||
},
|
||||
{
|
||||
"math/floor", janet_floor,
|
||||
JDOC("(math/floor x)\n\n"
|
||||
"Returns the largest integer value number that is not greater than x.")
|
||||
},
|
||||
{
|
||||
"math/ceil", janet_ceil,
|
||||
JDOC("(math/ceil x)\n\n"
|
||||
"Returns the smallest integer value number that is not less than x.")
|
||||
},
|
||||
{
|
||||
"math/pow", janet_pow,
|
||||
JDOC("(math/pow a x)\n\n"
|
||||
"Return a to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/abs", janet_fabs,
|
||||
JDOC("(math/abs x)\n\n"
|
||||
"Return the absolute value of x.")
|
||||
},
|
||||
{
|
||||
"math/sinh", janet_sinh,
|
||||
JDOC("(math/sinh x)\n\n"
|
||||
"Return the hyperbolic sine of x.")
|
||||
},
|
||||
{
|
||||
"math/cosh", janet_cosh,
|
||||
JDOC("(math/cosh x)\n\n"
|
||||
"Return the hyperbolic cosine of x.")
|
||||
},
|
||||
{
|
||||
"math/tanh", janet_tanh,
|
||||
JDOC("(math/tanh x)\n\n"
|
||||
"Return the hyperbolic tangent of x.")
|
||||
},
|
||||
{
|
||||
"math/atanh", janet_atanh,
|
||||
JDOC("(math/atanh x)\n\n"
|
||||
"Return the hyperbolic arctangent of x.")
|
||||
},
|
||||
{
|
||||
"math/asinh", janet_asinh,
|
||||
JDOC("(math/asinh x)\n\n"
|
||||
"Return the hyperbolic arcsine of x.")
|
||||
},
|
||||
{
|
||||
"math/acosh", janet_acosh,
|
||||
JDOC("(math/acosh x)\n\n"
|
||||
"Return the hyperbolic arccosine of x.")
|
||||
},
|
||||
{
|
||||
"math/atan2", janet_atan2,
|
||||
JDOC("(math/atan2 y x)\n\n"
|
||||
"Return the arctangent of y/x. Works even when x is 0.")
|
||||
},
|
||||
{
|
||||
"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. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||
},
|
||||
{
|
||||
"math/rng-uniform", cfun_rng_uniform,
|
||||
JDOC("(math/rng-seed rng seed)\n\n"
|
||||
"Extract a random number in the range [0, 1) from the RNG.")
|
||||
},
|
||||
{
|
||||
"math/rng-int", cfun_rng_int,
|
||||
JDOC("(math/rng-int rng &opt max)\n\n"
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1.")
|
||||
},
|
||||
{
|
||||
"math/rng-buffer", cfun_rng_buffer,
|
||||
JDOC("(math/rng-buffer rng n &opt buf)\n\n"
|
||||
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
|
||||
"provided, otherwise appends to the given buffer. Returns the buffer.")
|
||||
},
|
||||
{
|
||||
"math/hypot", janet_hypot,
|
||||
JDOC("(math/hypot a b)\n\n"
|
||||
"Returns the c from the equation c^2 = a^2 + b^2")
|
||||
},
|
||||
{
|
||||
"math/exp2", janet_exp2,
|
||||
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"
|
||||
"Returns e to the power of x minus 1.")
|
||||
},
|
||||
{
|
||||
"math/trunc", janet_trunc,
|
||||
JDOC("(math/trunc x)\n\n"
|
||||
"Returns the integer between x and 0 nearest to x.")
|
||||
},
|
||||
{
|
||||
"math/round", janet_round,
|
||||
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}
|
||||
};
|
||||
static double janet_gcd(double x, double y) {
|
||||
if (isnan(x) || isnan(y)) {
|
||||
#ifdef NAN
|
||||
return NAN;
|
||||
#else
|
||||
return 0.0 \ 0.0;
|
||||
#endif
|
||||
}
|
||||
if (isinf(x) || isinf(y)) return INFINITY;
|
||||
while (y != 0) {
|
||||
double temp = y;
|
||||
y = fmod(x, y);
|
||||
x = temp;
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
||||
static double janet_lcm(double x, double y) {
|
||||
return (x / janet_gcd(x, y)) * y;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_gcd, "(math/gcd x y)",
|
||||
"Returns the greatest common divisor between x and y.") {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(janet_gcd(x, y));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
|
||||
"Returns the least common multiple of x and y.") {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(janet_lcm(x, y));
|
||||
}
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
JanetRegExt math_cfuns[] = {
|
||||
JANET_CORE_REG("not", janet_not),
|
||||
JANET_CORE_REG("math/random", janet_rand),
|
||||
JANET_CORE_REG("math/seedrandom", janet_srand),
|
||||
JANET_CORE_REG("math/cos", janet_cos),
|
||||
JANET_CORE_REG("math/sin", janet_sin),
|
||||
JANET_CORE_REG("math/tan", janet_tan),
|
||||
JANET_CORE_REG("math/acos", janet_acos),
|
||||
JANET_CORE_REG("math/asin", janet_asin),
|
||||
JANET_CORE_REG("math/atan", janet_atan),
|
||||
JANET_CORE_REG("math/exp", janet_exp),
|
||||
JANET_CORE_REG("math/log", janet_log),
|
||||
JANET_CORE_REG("math/log10", janet_log10),
|
||||
JANET_CORE_REG("math/log2", janet_log2),
|
||||
JANET_CORE_REG("math/sqrt", janet_sqrt),
|
||||
JANET_CORE_REG("math/cbrt", janet_cbrt),
|
||||
JANET_CORE_REG("math/floor", janet_floor),
|
||||
JANET_CORE_REG("math/ceil", janet_ceil),
|
||||
JANET_CORE_REG("math/pow", janet_pow),
|
||||
JANET_CORE_REG("math/abs", janet_fabs),
|
||||
JANET_CORE_REG("math/sinh", janet_sinh),
|
||||
JANET_CORE_REG("math/cosh", janet_cosh),
|
||||
JANET_CORE_REG("math/tanh", janet_tanh),
|
||||
JANET_CORE_REG("math/atanh", janet_atanh),
|
||||
JANET_CORE_REG("math/asinh", janet_asinh),
|
||||
JANET_CORE_REG("math/acosh", janet_acosh),
|
||||
JANET_CORE_REG("math/atan2", janet_atan2),
|
||||
JANET_CORE_REG("math/rng", cfun_rng_make),
|
||||
JANET_CORE_REG("math/rng-uniform", cfun_rng_uniform),
|
||||
JANET_CORE_REG("math/rng-int", cfun_rng_int),
|
||||
JANET_CORE_REG("math/rng-buffer", cfun_rng_buffer),
|
||||
JANET_CORE_REG("math/hypot", janet_hypot),
|
||||
JANET_CORE_REG("math/exp2", janet_exp2),
|
||||
JANET_CORE_REG("math/log1p", janet_log1p),
|
||||
JANET_CORE_REG("math/gamma", janet_gamma),
|
||||
JANET_CORE_REG("math/erfc", janet_erfc),
|
||||
JANET_CORE_REG("math/erf", janet_erf),
|
||||
JANET_CORE_REG("math/expm1", janet_expm1),
|
||||
JANET_CORE_REG("math/trunc", janet_trunc),
|
||||
JANET_CORE_REG("math/round", janet_round),
|
||||
JANET_CORE_REG("math/next", janet_nextafter),
|
||||
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
||||
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
||||
janet_register_abstract_type(&janet_rng_type);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
JDOC("The base of the natural log."));
|
||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
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))"));
|
||||
JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
"The value pi.");
|
||||
JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
"The base of the natural log.");
|
||||
JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
"The number representing positive infinity");
|
||||
JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
"The number representing negative infinity");
|
||||
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
"The minimum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
"The maximum contiguous integer represtenable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
"The minimum contiguous integer representable by a double (2^53)");
|
||||
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
"The maximum contiguous integer represtenable by a double (-(2^53))");
|
||||
#ifdef NAN
|
||||
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
|
||||
#else
|
||||
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(0.0 / 0.0), "Not a number (IEEE-754 NaN)");
|
||||
#endif
|
||||
JDOC("Not a number (IEEE-754 NaN)"));
|
||||
#endif
|
||||
}
|
||||
|
367
src/core/net.c
367
src/core/net.c
@ -38,6 +38,7 @@
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#else
|
||||
#include <arpa/inet.h>
|
||||
#include <unistd.h>
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
@ -73,6 +74,15 @@ const JanetAbstractType janet_address_type = {
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
||||
typedef unsigned short in_port_t;
|
||||
#else
|
||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#endif
|
||||
|
||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||
|
||||
/* We pass this flag to all send calls to prevent sigpipe */
|
||||
@ -259,7 +269,8 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||
}
|
||||
|
||||
/* Needs argc >= offset + 2 */
|
||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
|
||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
|
||||
* otherwise 0. Also, ignores is_bind when is a unix socket. */
|
||||
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
|
||||
@ -285,12 +296,12 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
}
|
||||
#endif
|
||||
/* Get host and port */
|
||||
const char *host = janet_getcstring(argv, offset);
|
||||
const char *port;
|
||||
char *host = (char *)janet_getcstring(argv, offset);
|
||||
char *port = NULL;
|
||||
if (janet_checkint(argv[offset + 1])) {
|
||||
port = (const char *)janet_to_string(argv[offset + 1]);
|
||||
port = (char *)janet_to_string(argv[offset + 1]);
|
||||
} else {
|
||||
port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
||||
port = (char *)janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo *ai = NULL;
|
||||
@ -311,7 +322,14 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
* C Funs
|
||||
*/
|
||||
|
||||
static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_net_sockaddr,
|
||||
"(net/address host port &opt type multi)",
|
||||
"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. If `multi` is truthy, will "
|
||||
"return all address that match in an array instead of just the first.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
@ -350,13 +368,49 @@ static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JANET_CORE_FN(cfun_net_connect,
|
||||
"(net/connect host port &opt type bindhost bindport)",
|
||||
"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. "
|
||||
"Bindhost is an optional string to select from what address to make the outgoing "
|
||||
"connection, with the default being the same as using the OS's preferred address. ") {
|
||||
janet_arity(argc, 2, 5);
|
||||
|
||||
/* Check arguments */
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
char *bindhost = (char *) janet_optcstring(argv, argc, 3, NULL);
|
||||
char *bindport = NULL;
|
||||
if (janet_checkint(argv[4])) {
|
||||
bindport = (char *)janet_to_string(argv[4]);
|
||||
} else {
|
||||
bindport = (char *)janet_optcstring(argv, argc, 4, NULL);
|
||||
}
|
||||
|
||||
/* Where we're connecting to */
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
|
||||
/* Check if we're binding address */
|
||||
struct addrinfo *binding = NULL;
|
||||
if (bindhost != NULL) {
|
||||
if (is_unix) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("bindhost not supported for unix domain sockets");
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = socktype;
|
||||
hints.ai_flags = 0;
|
||||
int status = getaddrinfo(bindhost, bindport, &hints, &binding);
|
||||
if (status) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panicf("could not get address info for bindhost: %s", gai_strerror(status));
|
||||
}
|
||||
}
|
||||
|
||||
/* Create socket */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
@ -365,7 +419,9 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
if (is_unix) {
|
||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
Janet v = janet_ev_lasterr();
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
addr = (void *) ai;
|
||||
addrlen = sizeof(struct sockaddr_un);
|
||||
@ -386,17 +442,42 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
if (NULL == addr) {
|
||||
Janet v = janet_ev_lasterr();
|
||||
if (binding) freeaddrinfo(binding);
|
||||
freeaddrinfo(ai);
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
}
|
||||
|
||||
/* Bind to bindhost and bindport if given */
|
||||
if (binding) {
|
||||
struct addrinfo *rp = NULL;
|
||||
int did_bind = 0;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
|
||||
did_bind = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!did_bind) {
|
||||
Janet v = janet_ev_lasterr();
|
||||
freeaddrinfo(binding);
|
||||
freeaddrinfo(ai);
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panicf("could not bind outgoing address: %V", v);
|
||||
} else {
|
||||
freeaddrinfo(binding);
|
||||
}
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
#ifdef JANET_WINDOWS
|
||||
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
||||
Janet lasterr = janet_ev_lasterr();
|
||||
freeaddrinfo(ai);
|
||||
#else
|
||||
int status = connect(sock, addr, addrlen);
|
||||
Janet lasterr = janet_ev_lasterr();
|
||||
if (is_unix) {
|
||||
janet_free(ai);
|
||||
} else {
|
||||
@ -406,7 +487,7 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
|
||||
janet_panicf("could not connect socket: %V", lasterr);
|
||||
}
|
||||
|
||||
/* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
|
||||
@ -442,7 +523,14 @@ static const char *serverify_socket(JSock sfd) {
|
||||
#define JANET_SHUTDOWN_W SHUT_WR
|
||||
#endif
|
||||
|
||||
static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_net_shutdown,
|
||||
"(net/shutdown stream &opt mode)",
|
||||
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
||||
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
||||
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
||||
"* `:r` disables reading new data from the socket.\n"
|
||||
"* `:w` disable writing data to the socket.\n\n"
|
||||
"Returns the original socket.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
||||
@ -473,7 +561,13 @@ static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_net_listen,
|
||||
"(net/listen host port &opt type)",
|
||||
"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.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
@ -547,7 +641,98 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
|
||||
/* Types of socket's we need to deal with - relevant type puns below.
|
||||
struct sockaddr *sa; // Common base structure
|
||||
struct sockaddr_storage *ss; // Size of largest socket address type
|
||||
struct sockaddr_in *sin; // IPv4 address + port
|
||||
struct sockaddr_in6 *sin6; // IPv6 address + port
|
||||
struct sockaddr_un *sun; // Unix Domain Socket Address
|
||||
*/
|
||||
|
||||
/* Turn a socket address into a host, port pair (port is optional).
|
||||
* For unix domain sockets, returned tuple will have only a single element, the path string. */
|
||||
static Janet janet_so_getname(const void *sa_any) {
|
||||
const struct sockaddr *sa = sa_any;
|
||||
char buffer[SA_ADDRSTRLEN];
|
||||
switch (sa->sa_family) {
|
||||
default:
|
||||
janet_panic("unknown address family");
|
||||
case AF_INET: {
|
||||
const struct sockaddr_in *sai = sa_any;
|
||||
if (!inet_ntop(AF_INET, &(sai->sin_addr), buffer, sizeof(buffer))) {
|
||||
janet_panic("unable to decode ipv4 host address");
|
||||
}
|
||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, sai->sin_port ? 2 : 1));
|
||||
}
|
||||
case AF_INET6: {
|
||||
const struct sockaddr_in6 *sai6 = sa_any;
|
||||
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
||||
janet_panic("unable to decode ipv4 host address");
|
||||
}
|
||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, sai6->sin6_port ? 2 : 1));
|
||||
}
|
||||
#ifndef JANET_WINDOWS
|
||||
case AF_UNIX: {
|
||||
const struct sockaddr_un *sun = sa_any;
|
||||
Janet pathname;
|
||||
if (sun->sun_path[0] == '\0') {
|
||||
memcpy(buffer, sun->sun_path, sizeof(sun->sun_path));
|
||||
buffer[0] = '@';
|
||||
pathname = janet_cstringv(buffer);
|
||||
} else {
|
||||
pathname = janet_cstringv(sun->sun_path);
|
||||
}
|
||||
return janet_wrap_tuple(janet_tuple_n(&pathname, 1));
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_getsockname,
|
||||
"(net/localname stream)",
|
||||
"Gets the local address and port in a tuple in that order.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
struct sockaddr_storage ss;
|
||||
socklen_t slen = sizeof(ss);
|
||||
memset(&ss, 0, slen);
|
||||
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
|
||||
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_getpeername,
|
||||
"(net/peername stream)",
|
||||
"Gets the remote peer's address and port in a tuple in that order.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
struct sockaddr_storage ss;
|
||||
socklen_t slen = sizeof(ss);
|
||||
memset(&ss, 0, slen);
|
||||
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
|
||||
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_address_unpack,
|
||||
"(net/address-unpack address)",
|
||||
"Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
|
||||
"will have only the path in the returned tuple.") {
|
||||
janet_fixarity(argc, 1);
|
||||
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
|
||||
return janet_so_getname(sa);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_accept_loop,
|
||||
"(net/accept-loop stream handler)",
|
||||
"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.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
@ -555,7 +740,11 @@ static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
|
||||
janet_sched_accept(stream, fun);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_accept,
|
||||
"(net/accept stream &opt timeout)",
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
@ -564,7 +753,13 @@ static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
|
||||
janet_sched_accept(stream, NULL);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_read,
|
||||
"(net/read stream nbytes &opt buf timeout)",
|
||||
"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.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
@ -581,7 +776,10 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_chunk,
|
||||
"(net/chunk stream nbytes &opt buf timeout)",
|
||||
"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.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
@ -593,7 +791,10 @@ static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
"(net/recv-from stream nbytes buf &opt timoeut)",
|
||||
"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.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||
@ -605,7 +806,11 @@ static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_write,
|
||||
"(net/write stream data &opt timeout)",
|
||||
"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.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||
@ -621,7 +826,11 @@ static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_send_to,
|
||||
"(net/send-to stream dest data &opt timeout)",
|
||||
"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.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||
@ -638,7 +847,10 @@ static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_stream_flush,
|
||||
"(net/flush stream)",
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||
@ -660,7 +872,6 @@ static const JanetMethod net_stream_methods[] = {
|
||||
{"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},
|
||||
@ -672,101 +883,27 @@ 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. ")
|
||||
},
|
||||
{
|
||||
"net/shutdown", cfun_net_shutdown,
|
||||
JDOC("(net/shutdown stream &opt mode)\n\n"
|
||||
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
||||
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
||||
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
||||
"* `:r` disables reading new data from the socket.\n"
|
||||
"* `:w` disable writing data to the socket.\n\n"
|
||||
"Returns the original socket.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, net_cfuns);
|
||||
JanetRegExt net_cfuns[] = {
|
||||
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
||||
JANET_CORE_REG("net/listen", cfun_net_listen),
|
||||
JANET_CORE_REG("net/accept", cfun_stream_accept),
|
||||
JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
|
||||
JANET_CORE_REG("net/read", cfun_stream_read),
|
||||
JANET_CORE_REG("net/chunk", cfun_stream_chunk),
|
||||
JANET_CORE_REG("net/write", cfun_stream_write),
|
||||
JANET_CORE_REG("net/send-to", cfun_stream_send_to),
|
||||
JANET_CORE_REG("net/recv-from", cfun_stream_recv_from),
|
||||
JANET_CORE_REG("net/flush", cfun_stream_flush),
|
||||
JANET_CORE_REG("net/connect", cfun_net_connect),
|
||||
JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
|
||||
JANET_CORE_REG("net/peername", cfun_net_getpeername),
|
||||
JANET_CORE_REG("net/localname", cfun_net_getsockname),
|
||||
JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, net_cfuns);
|
||||
}
|
||||
|
||||
void janet_net_init(void) {
|
||||
|
652
src/core/os.c
652
src/core/os.c
@ -84,7 +84,6 @@ time_t timegm(struct tm *tm);
|
||||
* setenv/getenv are not thread safe. */
|
||||
#ifdef JANET_THREADS
|
||||
# ifdef JANET_WINDOWS
|
||||
static int env_lock_initialized = 0;
|
||||
static CRITICAL_SECTION env_lock;
|
||||
static void janet_lock_environ(void) {
|
||||
EnterCriticalSection(&env_lock);
|
||||
@ -117,7 +116,18 @@ static void janet_unlock_environ(void) {
|
||||
#define janet_stringify1(x) #x
|
||||
#define janet_stringify(x) janet_stringify1(x)
|
||||
|
||||
static Janet os_which(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_which,
|
||||
"(os/which)",
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :macos\n\n"
|
||||
"* :web - Web assembly (emscripten)\n\n"
|
||||
"* :linux\n\n"
|
||||
"* :freebsd\n\n"
|
||||
"* :openbsd\n\n"
|
||||
"* :netbsd\n\n"
|
||||
"* :posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#if defined(JANET_OS_NAME)
|
||||
@ -144,7 +154,16 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Detect the ISA we are compiled for */
|
||||
static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_arch,
|
||||
"(os/arch)",
|
||||
"Check the ISA that janet was compiled for. Returns one of:\n\n"
|
||||
"* :x86\n\n"
|
||||
"* :x64\n\n"
|
||||
"* :arm\n\n"
|
||||
"* :aarch64\n\n"
|
||||
"* :sparc\n\n"
|
||||
"* :wasm\n\n"
|
||||
"* :unknown\n") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
/* Check 64-bit vs 32-bit */
|
||||
@ -172,7 +191,10 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
#undef janet_stringify1
|
||||
#undef janet_stringify
|
||||
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_exit,
|
||||
"(os/exit &opt x)",
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
int status;
|
||||
if (argc == 0) {
|
||||
@ -353,6 +375,7 @@ static const JanetAbstractType ProcAT;
|
||||
#define JANET_PROC_OWNS_STDIN 16
|
||||
#define JANET_PROC_OWNS_STDOUT 32
|
||||
#define JANET_PROC_OWNS_STDERR 64
|
||||
#define JANET_PROC_ALLOW_ZOMBIE 128
|
||||
typedef struct {
|
||||
int flags;
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -410,6 +433,7 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
|
||||
/* Callback that is called in main thread when subroutine completes. */
|
||||
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
janet_ev_dec_refcount();
|
||||
int status = args.argi;
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
@ -434,11 +458,14 @@ static int janet_proc_gc(void *p, size_t s) {
|
||||
JanetProc *proc = (JanetProc *) p;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (!(proc->flags & JANET_PROC_CLOSED)) {
|
||||
if (!(proc->flags & JANET_PROC_ALLOW_ZOMBIE)) {
|
||||
TerminateProcess(proc->pHandle, 1);
|
||||
}
|
||||
CloseHandle(proc->pHandle);
|
||||
CloseHandle(proc->tHandle);
|
||||
}
|
||||
#else
|
||||
if (!(proc->flags & JANET_PROC_WAITED)) {
|
||||
if (!(proc->flags & (JANET_PROC_WAITED | JANET_PROC_ALLOW_ZOMBIE))) {
|
||||
/* Kill and wait to prevent zombies */
|
||||
kill(proc->pid, SIGKILL);
|
||||
int status;
|
||||
@ -497,7 +524,9 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_proc_wait(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_proc_wait,
|
||||
"(os/proc-wait proc)",
|
||||
"Block until the subprocess completes. Returns the subprocess return code.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@ -508,7 +537,11 @@ static Janet os_proc_wait(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_proc_kill,
|
||||
"(os/proc-kill proc &opt wait)",
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If wait is truthy, will wait for the process to finsih and "
|
||||
"returns the exit code. Otherwise, returns proc.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
@ -519,6 +552,7 @@ static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
janet_panicf("cannot close process handle that is already closed");
|
||||
}
|
||||
proc->flags |= JANET_PROC_CLOSED;
|
||||
TerminateProcess(proc->pHandle, 1);
|
||||
CloseHandle(proc->pHandle);
|
||||
CloseHandle(proc->tHandle);
|
||||
#else
|
||||
@ -540,7 +574,10 @@ static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_proc_close(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_proc_close,
|
||||
"(os/proc-close proc)",
|
||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
||||
"if they have not been closed. Returns nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@ -757,7 +794,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
/* Get flags */
|
||||
uint64_t flags = 0;
|
||||
if (argc > 1) {
|
||||
flags = janet_getflags(argv, 1, "epx");
|
||||
flags = janet_getflags(argv, 1, "epxd");
|
||||
}
|
||||
|
||||
/* Get environment */
|
||||
@ -775,7 +812,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
JanetHandle new_in = JANET_HANDLE_NONE, new_out = JANET_HANDLE_NONE, new_err = JANET_HANDLE_NONE;
|
||||
JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
|
||||
int pipe_errflag = 0; /* Track errors setting up pipes */
|
||||
int pipe_owner_flags = 0;
|
||||
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
|
||||
|
||||
/* Get optional redirections */
|
||||
if (argc > 2) {
|
||||
@ -991,11 +1028,32 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_execute,
|
||||
"(os/execute args &opt flags env)",
|
||||
"Execute a program on the system and pass it string arguments. `flags` "
|
||||
"is a keyword that modifies how the program will execute.\n"
|
||||
"* :e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n"
|
||||
"* :p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n"
|
||||
"* :x - raise error if exit code is non-zero.\n"
|
||||
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"One can also pass in the :pipe keyword "
|
||||
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
|
||||
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
|
||||
"the same parameters as `os/execute`, but will return an object that contains references to these "
|
||||
"files via (return-value :in), (return-value :out), and (return-value :err). "
|
||||
"Returns the exit status of the program.") {
|
||||
return os_execute_impl(argc, argv, 0);
|
||||
}
|
||||
|
||||
static Janet os_spawn(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_spawn,
|
||||
"(os/spawn args &opt flags env)",
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, the "
|
||||
"same arguments as os/execute. Does not wait for the process.") {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
}
|
||||
|
||||
@ -1014,7 +1072,9 @@ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_shell,
|
||||
"(os/shell str)",
|
||||
"Pass a command string str directly to the system shell.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? janet_getcstring(argv, 0)
|
||||
@ -1031,7 +1091,9 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
|
||||
#endif /* JANET_NO_PROCESSES */
|
||||
|
||||
static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_environ,
|
||||
"(os/environ)",
|
||||
"Get a copy of the os environment table.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
@ -1060,7 +1122,9 @@ static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_getenv,
|
||||
"(os/getenv variable &opt dflt)",
|
||||
"Get the string value of an environment variable.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
@ -1074,7 +1138,9 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_setenv,
|
||||
"(os/setenv variable value)",
|
||||
"Set an environment variable.") {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define SETENV(K,V) _putenv_s(K, V)
|
||||
#define UNSETENV(K) _putenv_s(K, "")
|
||||
@ -1095,14 +1161,20 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_time(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_time,
|
||||
"(os/time)",
|
||||
"Get the current time expressed as the number of whole seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
double dtime = (double)(time(NULL));
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_clock,
|
||||
"(os/clock)",
|
||||
"Return the number of whole + fractional seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreasing in real time.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
@ -1111,7 +1183,10 @@ static Janet os_clock(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_sleep,
|
||||
"(os/sleep n)",
|
||||
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
|
||||
"nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
double delay = janet_getnumber(argv, 0);
|
||||
if (delay < 0) janet_panic("invalid argument to sleep");
|
||||
@ -1129,7 +1204,9 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_cwd,
|
||||
"(os/cwd)",
|
||||
"Returns the current working directory.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
char buf[FILENAME_MAX];
|
||||
@ -1143,7 +1220,9 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
return janet_cstringv(ptr);
|
||||
}
|
||||
|
||||
static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_cryptorand,
|
||||
"(os/cryptorand n &opt buf)",
|
||||
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") {
|
||||
JanetBuffer *buffer;
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t offset;
|
||||
@ -1165,7 +1244,21 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet os_date(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_date,
|
||||
"(os/date &opt time local)",
|
||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"* :seconds - number of seconds [0-61]\n\n"
|
||||
"* :minutes - number of minutes [0-59]\n\n"
|
||||
"* :hours - number of hours [0-23]\n\n"
|
||||
"* :month-day - day of month [0-30]\n\n"
|
||||
"* :month - month of year [0, 11]\n\n"
|
||||
"* :year - years since year 0 (e.g. 2019)\n\n"
|
||||
"* :week-day - day of the week [0-6]\n\n"
|
||||
"* :year-day - day of the year [0-365]\n\n"
|
||||
"* :dst - if Day Light Savings is in effect") {
|
||||
janet_arity(argc, 0, 2);
|
||||
(void) argv;
|
||||
time_t t;
|
||||
@ -1263,7 +1356,14 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
|
||||
return (timeint_t)janet_unwrap_number(i);
|
||||
}
|
||||
|
||||
static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_mktime,
|
||||
"(os/mktime date-struct &opt local)",
|
||||
"Get the broken down date-struct time expressed as the number "
|
||||
" of seconds since January 1, 1970, the Unix epoch. "
|
||||
"Returns a real number. "
|
||||
"Date is given in UTC unless local is truthy, in which case the "
|
||||
"date is computed for the local timezone.\n\n"
|
||||
"Inverse function to os/date.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
time_t t;
|
||||
struct tm t_info;
|
||||
@ -1309,7 +1409,12 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
#define j_symlink symlink
|
||||
#endif
|
||||
|
||||
static Janet os_link(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_link,
|
||||
"(os/link oldpath newpath &opt symlink)",
|
||||
"Create a link at newpath that points to oldpath and returns nil. "
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@ -1325,7 +1430,9 @@ static Janet os_link(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_symlink(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_symlink,
|
||||
"(os/symlink oldpath newpath)",
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") {
|
||||
janet_fixarity(argc, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@ -1343,7 +1450,11 @@ static Janet os_symlink(int32_t argc, Janet *argv) {
|
||||
|
||||
#undef j_symlink
|
||||
|
||||
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_mkdir,
|
||||
"(os/mkdir path)",
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
|
||||
"errors otherwise.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -1356,7 +1467,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
janet_panicf("%s: %s", strerror(errno), path);
|
||||
}
|
||||
|
||||
static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_rmdir,
|
||||
"(os/rmdir path)",
|
||||
"Delete a directory. The directory must be empty to succeed.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -1368,7 +1481,9 @@ static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_cd(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_cd,
|
||||
"(os/cd path)",
|
||||
"Change current directory to path. Returns nil on success, errors on failure.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -1380,7 +1495,10 @@ static Janet os_cd(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_touch(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_touch,
|
||||
"(os/touch path &opt actime modtime)",
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
struct utimbuf timebuf, *bufp;
|
||||
@ -1400,7 +1518,9 @@ static Janet os_touch(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_remove,
|
||||
"(os/rm path)",
|
||||
"Delete a file. Returns nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
int status = remove(path);
|
||||
@ -1409,7 +1529,9 @@ static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
static Janet os_readlink(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_readlink,
|
||||
"(os/readlink path)",
|
||||
"Read the contents of a symbolic link. Does not work on Windows.\n") {
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@ -1674,15 +1796,39 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_stat,
|
||||
"(os/stat path &opt tab|key)",
|
||||
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"* :dev - the device that the file is on\n\n"
|
||||
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
|
||||
"* :int-permissions - A Unix permission integer like 8r744\n\n"
|
||||
"* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
|
||||
"* :uid - File uid\n\n"
|
||||
"* :gid - File gid\n\n"
|
||||
"* :nlink - number of links to file\n\n"
|
||||
"* :rdev - Real device of file. 0 on windows.\n\n"
|
||||
"* :size - size of file in bytes\n\n"
|
||||
"* :blocks - number of blocks in file. 0 on windows\n\n"
|
||||
"* :blocksize - size of blocks in file. 0 on windows\n\n"
|
||||
"* :accessed - timestamp when file last accessed\n\n"
|
||||
"* :changed - timestamp when file last changed (permissions changed)\n\n"
|
||||
"* :modified - timestamp when file last modified (content changed)\n") {
|
||||
return os_stat_or_lstat(0, argc, argv);
|
||||
}
|
||||
|
||||
static Janet os_lstat(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_lstat,
|
||||
"(os/lstat path &opt tab|key)",
|
||||
"Like os/stat, but don't follow symlinks.\n") {
|
||||
return os_stat_or_lstat(1, argc, argv);
|
||||
}
|
||||
|
||||
static Janet os_chmod(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_chmod,
|
||||
"(os/chmod path mode)",
|
||||
"Change file permissions, where mode is a permission string as returned by "
|
||||
"os/perm-string, or an integer as returned by os/perm-int. "
|
||||
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -1695,7 +1841,9 @@ static Janet os_chmod(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
#ifndef JANET_NO_UMASK
|
||||
static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_umask,
|
||||
"(os/umask mask)",
|
||||
"Set a new umask, returns the old umask.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -1707,7 +1855,10 @@ static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_dir,
|
||||
"(os/dir dir &opt array)",
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the file name or directory name and no prefix.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||
@ -1742,7 +1893,9 @@ static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(paths);
|
||||
}
|
||||
|
||||
static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_rename,
|
||||
"(os/rename oldname newname)",
|
||||
"Rename a file on disk to a new path. Returns nil.") {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
const char *dest = janet_getcstring(argv, 1);
|
||||
@ -1753,7 +1906,10 @@ static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_realpath,
|
||||
"(os/realpath path)",
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
@ -1771,12 +1927,19 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_permission_string(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_permission_string,
|
||||
"(os/perm-string int)",
|
||||
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
|
||||
"to a human readable string, that follows the formatting "
|
||||
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
|
||||
"include the file/directory/symlink character as rendered by `ls`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return os_make_permstring(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
|
||||
static Janet os_permission_int(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_permission_int,
|
||||
"(os/perm-int bytes)",
|
||||
"Parse a 9 character permission string and return an integer that can be used by chmod.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_integer(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
@ -1792,7 +1955,31 @@ static jmode_t os_optmode(int32_t argc, const Janet *argv, int32_t n, int32_t df
|
||||
return janet_perm_from_unix(dflt);
|
||||
}
|
||||
|
||||
static Janet os_open(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_open,
|
||||
"(os/open path &opt flags mode)",
|
||||
"Create a stream from a file, like the POSIX open system call. Returns a new stream. "
|
||||
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
|
||||
"The default mode is 8r666. "
|
||||
"Allowed flags are as follows:\n\n"
|
||||
" * :r - open this file for reading\n"
|
||||
" * :w - open this file for writing\n"
|
||||
" * :c - create a new file (O_CREATE)\n"
|
||||
" * :e - fail if the file exists (O_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
"Posix only flags:\n\n"
|
||||
" * :a - append to a file (O_APPEND)\n"
|
||||
" * :x - O_SYNC\n"
|
||||
" * :C - O_NOCTTY\n\n"
|
||||
"Windows only flags:\n\n"
|
||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
" * :b - FILE_FLAG_NO_BUFFERING\n") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||
@ -1934,7 +2121,11 @@ static Janet os_open(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
|
||||
}
|
||||
|
||||
static Janet os_pipe(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_pipe,
|
||||
"(os/pipe)",
|
||||
"Create a readable stream and a writable stream that are connected. Returns a two element "
|
||||
"tuple where the first element is a readable stream and the second element is the writable "
|
||||
"stream.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetHandle fds[2];
|
||||
@ -1949,330 +2140,75 @@ static Janet os_pipe(int32_t argc, Janet *argv) {
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit &opt x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.")
|
||||
},
|
||||
{
|
||||
"os/which", os_which,
|
||||
JDOC("(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :macos\n\n"
|
||||
"* :web - Web assembly (emscripten)\n\n"
|
||||
"* :linux\n\n"
|
||||
"* :freebsd\n\n"
|
||||
"* :openbsd\n\n"
|
||||
"* :netbsd\n\n"
|
||||
"* :posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.")
|
||||
},
|
||||
{
|
||||
"os/arch", os_arch,
|
||||
JDOC("(os/arch)\n\n"
|
||||
"Check the ISA that janet was compiled for. Returns one of:\n\n"
|
||||
"* :x86\n\n"
|
||||
"* :x86-64\n\n"
|
||||
"* :arm\n\n"
|
||||
"* :aarch64\n\n"
|
||||
"* :sparc\n\n"
|
||||
"* :wasm\n\n"
|
||||
"* :unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the file name or directory name and no prefix.")
|
||||
},
|
||||
{
|
||||
"os/stat", os_stat,
|
||||
JDOC("(os/stat path &opt tab|key)\n\n"
|
||||
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"* :dev - the device that the file is on\n\n"
|
||||
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
|
||||
"* :int-permissions - A Unix permission integer like 8r744\n\n"
|
||||
"* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
|
||||
"* :uid - File uid\n\n"
|
||||
"* :gid - File gid\n\n"
|
||||
"* :nlink - number of links to file\n\n"
|
||||
"* :rdev - Real device of file. 0 on windows.\n\n"
|
||||
"* :size - size of file in bytes\n\n"
|
||||
"* :blocks - number of blocks in file. 0 on windows\n\n"
|
||||
"* :blocksize - size of blocks in file. 0 on windows\n\n"
|
||||
"* :accessed - timestamp when file last accessed\n\n"
|
||||
"* :changed - timestamp when file last changed (permissions changed)\n\n"
|
||||
"* :modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
"os/lstat", os_lstat,
|
||||
JDOC("(os/lstat path &opt tab|key)\n\n"
|
||||
"Like os/stat, but don't follow symlinks.\n")
|
||||
},
|
||||
{
|
||||
"os/chmod", os_chmod,
|
||||
JDOC("(os/chmod path mode)\n\n"
|
||||
"Change file permissions, where mode is a permission string as returned by "
|
||||
"os/perm-string, or an integer as returned by os/perm-int. "
|
||||
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
JDOC("(os/touch path &opt actime modtime)\n\n"
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.")
|
||||
},
|
||||
{
|
||||
"os/cd", os_cd,
|
||||
JDOC("(os/cd path)\n\n"
|
||||
"Change current directory to path. Returns nil on success, errors on failure.")
|
||||
},
|
||||
#ifndef JANET_NO_UMASK
|
||||
{
|
||||
"os/umask", os_umask,
|
||||
JDOC("(os/umask mask)\n\n"
|
||||
"Set a new umask, returns the old umask.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/mkdir", os_mkdir,
|
||||
JDOC("(os/mkdir path)\n\n"
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
|
||||
"errors otherwise.")
|
||||
},
|
||||
{
|
||||
"os/rmdir", os_rmdir,
|
||||
JDOC("(os/rmdir path)\n\n"
|
||||
"Delete a directory. The directory must be empty to succeed.")
|
||||
},
|
||||
{
|
||||
"os/rm", os_remove,
|
||||
JDOC("(os/rm path)\n\n"
|
||||
"Delete a file. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/link", os_link,
|
||||
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
|
||||
"Create a link at newpath that points to oldpath and returns nil. "
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.")
|
||||
},
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
{
|
||||
"os/symlink", os_symlink,
|
||||
JDOC("(os/symlink oldpath newpath)\n\n"
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
|
||||
},
|
||||
{
|
||||
"os/readlink", os_readlink,
|
||||
JDOC("(os/readlink path)\n\n"
|
||||
"Read the contents of a symbolic link. Does not work on Windows.\n")
|
||||
},
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute args &opt flags env)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. `flags` "
|
||||
"is a keyword that modifies how the program will execute.\n\n"
|
||||
"* :e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n\n"
|
||||
"* :p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n\n"
|
||||
"* :x - raise error if exit code is non-zero.\n\n"
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"One can also pass in the :pipe keyword "
|
||||
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
|
||||
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
|
||||
"the same parameters as `os/execute`, but will return an object that contains references to these "
|
||||
"files via (return-value :in), (return-value :out), and (return-value :err). "
|
||||
"Returns the exit status of the program.")
|
||||
},
|
||||
{
|
||||
"os/spawn", os_spawn,
|
||||
JDOC("(os/spawn args &opt flags env)\n\n"
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, the "
|
||||
"same arguments as os/execute. Does not wait for the process.")
|
||||
},
|
||||
{
|
||||
"os/shell", os_shell,
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
{
|
||||
"os/proc-wait", os_proc_wait,
|
||||
JDOC("(os/proc-wait proc)\n\n"
|
||||
"Block until the subprocess completes. Returns the subprocess return code.")
|
||||
},
|
||||
{
|
||||
"os/proc-kill", os_proc_kill,
|
||||
JDOC("(os/proc-kill proc &opt wait)\n\n"
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If wait is truthy, will wait for the process to finsih and "
|
||||
"returns the exit code. Otherwise, returns proc.")
|
||||
},
|
||||
{
|
||||
"os/proc-close", os_proc_close,
|
||||
JDOC("(os/proc-close proc)\n\n"
|
||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
||||
"if they have not been closed. Returns nil.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
"Set an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/time", os_time,
|
||||
JDOC("(os/time)\n\n"
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||
},
|
||||
{
|
||||
"os/mktime", os_mktime,
|
||||
JDOC("(os/mktime date-struct &opt local)\n\n"
|
||||
"Get the broken down date-struct time expressed as the number "
|
||||
" of seconds since January 1, 1970, the Unix epoch. "
|
||||
"Returns a real number. "
|
||||
"Date is given in UTC unless local is truthy, in which case the "
|
||||
"date is computed for the local timezone.\n\n"
|
||||
"Inverse function to os/date.")
|
||||
},
|
||||
{
|
||||
"os/clock", os_clock,
|
||||
JDOC("(os/clock)\n\n"
|
||||
"Return the number of seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreasing in real time.")
|
||||
},
|
||||
{
|
||||
"os/sleep", os_sleep,
|
||||
JDOC("(os/sleep n)\n\n"
|
||||
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
|
||||
"nil.")
|
||||
},
|
||||
{
|
||||
"os/cwd", os_cwd,
|
||||
JDOC("(os/cwd)\n\n"
|
||||
"Returns the current working directory.")
|
||||
},
|
||||
{
|
||||
"os/cryptorand", os_cryptorand,
|
||||
JDOC("(os/cryptorand n &opt buf)\n\n"
|
||||
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.")
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time local)\n\n"
|
||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"* :seconds - number of seconds [0-61]\n\n"
|
||||
"* :minutes - number of minutes [0-59]\n\n"
|
||||
"* :hours - number of hours [0-23]\n\n"
|
||||
"* :month-day - day of month [0-30]\n\n"
|
||||
"* :month - month of year [0, 11]\n\n"
|
||||
"* :year - years since year 0 (e.g. 2019)\n\n"
|
||||
"* :week-day - day of the week [0-6]\n\n"
|
||||
"* :year-day - day of the year [0-365]\n\n"
|
||||
"* :dst - if Day Light Savings is in effect")
|
||||
},
|
||||
{
|
||||
"os/rename", os_rename,
|
||||
JDOC("(os/rename oldname newname)\n\n"
|
||||
"Rename a file on disk to a new path. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/realpath", os_realpath,
|
||||
JDOC("(os/realpath path)\n\n"
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.")
|
||||
},
|
||||
{
|
||||
"os/perm-string", os_permission_string,
|
||||
JDOC("(os/perm-string int)\n\n"
|
||||
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
|
||||
"to a human readable string, that follows the formatting "
|
||||
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
|
||||
"include the file/directory/symlink character as rendered by `ls`.")
|
||||
},
|
||||
{
|
||||
"os/perm-int", os_permission_int,
|
||||
JDOC("(os/perm-int bytes)\n\n"
|
||||
"Parse a 9 character permission string and return an integer that can be used by chmod.")
|
||||
},
|
||||
#ifdef JANET_EV
|
||||
{
|
||||
"os/open", os_open,
|
||||
JDOC("(os/open path &opt flags mode)\n\n"
|
||||
"Create a stream from a file, like the POSIX open system call. Returns a new stream. "
|
||||
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
|
||||
"The default mode is 8r666. "
|
||||
"Allowed flags are as follows:\n\n"
|
||||
" * :r - open this file for reading\n"
|
||||
" * :w - open this file for writing\n"
|
||||
" * :c - create a new file (O_CREATE)\n"
|
||||
" * :e - fail if the file exists (O_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
"Posix only flags:\n\n"
|
||||
" * :a - append to a file (O_APPEND)\n"
|
||||
" * :x - O_SYNC\n"
|
||||
" * :C - O_NOCTTY\n\n"
|
||||
"Windows only flags:\n\n"
|
||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
" * :b - FILE_FLAG_NO_BUFFERING\n")
|
||||
},
|
||||
{
|
||||
"os/pipe", os_pipe,
|
||||
JDOC("(os/pipe)\n\n"
|
||||
"Create a readable stream and a writable stream that are connected. Returns a two element "
|
||||
"tuple where the first element is a readable stream and the second element is the writable "
|
||||
"stream.")
|
||||
},
|
||||
#endif
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_os(JanetTable *env) {
|
||||
#if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
|
||||
/* During start up, the top-most abstract machine (thread)
|
||||
* in the thread tree sets up the critical section. */
|
||||
if (!env_lock_initialized) {
|
||||
static volatile long env_lock_initializing = 0;
|
||||
static volatile long env_lock_initialized = 0;
|
||||
if (!InterlockedExchange(&env_lock_initializing, 1)) {
|
||||
InitializeCriticalSection(&env_lock);
|
||||
env_lock_initialized = 1;
|
||||
InterlockedOr(&env_lock_initialized, 1);
|
||||
} else {
|
||||
while (!InterlockedOr(&env_lock_initialized, 0)) {
|
||||
Sleep(0);
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
#endif
|
||||
janet_core_cfuns(env, NULL, os_cfuns);
|
||||
JanetRegExt os_cfuns[] = {
|
||||
JANET_CORE_REG("os/exit", os_exit),
|
||||
JANET_CORE_REG("os/which", os_which),
|
||||
JANET_CORE_REG("os/arch", os_arch),
|
||||
#ifndef JANET_REDUCED_OS
|
||||
JANET_CORE_REG("os/environ", os_environ),
|
||||
JANET_CORE_REG("os/getenv", os_getenv),
|
||||
JANET_CORE_REG("os/dir", os_dir),
|
||||
JANET_CORE_REG("os/stat", os_stat),
|
||||
JANET_CORE_REG("os/lstat", os_lstat),
|
||||
JANET_CORE_REG("os/chmod", os_chmod),
|
||||
JANET_CORE_REG("os/touch", os_touch),
|
||||
JANET_CORE_REG("os/cd", os_cd),
|
||||
#ifndef JANET_NO_UMASK
|
||||
JANET_CORE_REG("os/umask", os_umask),
|
||||
#endif
|
||||
JANET_CORE_REG("os/mkdir", os_mkdir),
|
||||
JANET_CORE_REG("os/rmdir", os_rmdir),
|
||||
JANET_CORE_REG("os/rm", os_remove),
|
||||
JANET_CORE_REG("os/link", os_link),
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
JANET_CORE_REG("os/symlink", os_symlink),
|
||||
JANET_CORE_REG("os/readlink", os_readlink),
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_REG("os/execute", os_execute),
|
||||
JANET_CORE_REG("os/spawn", os_spawn),
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
JANET_CORE_REG("os/proc-kill", os_proc_kill),
|
||||
JANET_CORE_REG("os/proc-close", os_proc_close),
|
||||
#endif
|
||||
JANET_CORE_REG("os/setenv", os_setenv),
|
||||
JANET_CORE_REG("os/time", os_time),
|
||||
JANET_CORE_REG("os/mktime", os_mktime),
|
||||
JANET_CORE_REG("os/clock", os_clock),
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
JANET_CORE_REG("os/cwd", os_cwd),
|
||||
JANET_CORE_REG("os/cryptorand", os_cryptorand),
|
||||
JANET_CORE_REG("os/date", os_date),
|
||||
JANET_CORE_REG("os/rename", os_rename),
|
||||
JANET_CORE_REG("os/realpath", os_realpath),
|
||||
JANET_CORE_REG("os/perm-string", os_permission_string),
|
||||
JANET_CORE_REG("os/perm-int", os_permission_int),
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open),
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
#endif
|
||||
#endif
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, os_cfuns);
|
||||
}
|
||||
|
211
src/core/parse.c
211
src/core/parse.c
@ -51,15 +51,15 @@ static const uint32_t symchars[8] = {
|
||||
};
|
||||
|
||||
/* Check if a character is a valid symbol character
|
||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||
static int is_symbol_char(uint8_t c) {
|
||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_| */
|
||||
int janet_is_symbol_char(uint8_t c) {
|
||||
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Validate some utf8. Useful for identifiers. Only validates
|
||||
* the encoding, does not check for valid code points (they
|
||||
* are less well defined than the encoding). */
|
||||
static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len) {
|
||||
int32_t i = 0;
|
||||
int32_t j;
|
||||
while (i < len) {
|
||||
@ -411,7 +411,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
Janet ret;
|
||||
double numval;
|
||||
int32_t blen;
|
||||
if (is_symbol_char(c)) {
|
||||
if (janet_is_symbol_char(c)) {
|
||||
push_buf(p, (uint8_t) c);
|
||||
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
||||
return 1;
|
||||
@ -422,7 +422,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||
if (p->buf[0] == ':') {
|
||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||
int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1);
|
||||
int valid = (!state->argn) || janet_valid_utf8(p->buf + 1, blen - 1);
|
||||
if (!valid) {
|
||||
p->error = "invalid utf-8 in keyword";
|
||||
return 0;
|
||||
@ -442,7 +442,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
return 0;
|
||||
} else {
|
||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
||||
int valid = (!state->argn) || janet_valid_utf8(p->buf, blen);
|
||||
if (!valid) {
|
||||
p->error = "invalid utf-8 in symbol";
|
||||
return 0;
|
||||
@ -582,7 +582,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
switch (c) {
|
||||
default:
|
||||
if (is_whitespace(c)) return 1;
|
||||
if (!is_symbol_char(c)) {
|
||||
if (!janet_is_symbol_char(c)) {
|
||||
p->error = "unexpected character";
|
||||
return 1;
|
||||
}
|
||||
@ -878,7 +878,10 @@ const JanetAbstractType janet_parser_type = {
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_parser,
|
||||
"(parser/new)",
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of values.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
@ -886,7 +889,11 @@ static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_consume,
|
||||
"(parser/consume parser bytes &opt index)",
|
||||
"Input bytes into the parser and parse them. Will not throw errors "
|
||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||
"the number of bytes read.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
@ -911,14 +918,20 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_eof,
|
||||
"(parser/eof parser)",
|
||||
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_eof(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_insert,
|
||||
"(parser/insert parser value)",
|
||||
"Insert a value into the parser. This means that the parser state can be manipulated "
|
||||
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
||||
"and tuples, for example. Returns the parser.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParseState *s = p->states + p->statecount - 1;
|
||||
@ -957,13 +970,17 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_has_more,
|
||||
"(parser/has-more parser)",
|
||||
"Check if the parser has more values in the value queue.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_byte,
|
||||
"(parser/byte parser b)",
|
||||
"Input a single byte into the parser byte stream. Returns the parser.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
@ -971,7 +988,13 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_status,
|
||||
"(parser/status parser)",
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *stat = NULL;
|
||||
@ -992,7 +1015,12 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv(stat);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_error,
|
||||
"(parser/error parser)",
|
||||
"If the parser is in the error state, returns the message associated with "
|
||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||
"queue, so be sure to handle everything in the queue before calling "
|
||||
"parser/error.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
@ -1004,7 +1032,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_produce,
|
||||
"(parser/produce parser &opt wrap)",
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc == 2 && janet_truthy(argv[1])) {
|
||||
@ -1014,14 +1048,22 @@ static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_flush,
|
||||
"(parser/flush parser)",
|
||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||
"if an error was encountered. Does not reset the line and column counter, so "
|
||||
"to begin parsing in a new context, create a new parser.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_flush(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_where,
|
||||
"(parser/where parser &opt line col)",
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc > 1) {
|
||||
@ -1162,7 +1204,16 @@ static const struct ParserStateGetter parser_state_getters[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_state,
|
||||
"(parser/state parser &opt key)",
|
||||
"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, "
|
||||
"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 "
|
||||
"contain information about the start of the expression being parsed as well as the "
|
||||
"type of that expression and some type-specific information.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *key = NULL;
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
@ -1190,7 +1241,11 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_parse_clone,
|
||||
"(parser/clone p)",
|
||||
"Creates a deep clone of a parser that is identical to the input parser. "
|
||||
"This cloned parser can be used to continue parsing from a good checkpoint "
|
||||
"if parsing later fails. Returns a new parser.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
@ -1225,105 +1280,23 @@ static Janet parsernext(void *p, Janet key) {
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"parser/clone", cfun_parse_clone,
|
||||
JDOC("(parser/clone p)\n\n"
|
||||
"Creates a deep clone of a parser that is identical to the input parser. "
|
||||
"This cloned parser can be used to continue parsing from a good checkpoint "
|
||||
"if parsing later fails. Returns a new parser.")
|
||||
},
|
||||
{
|
||||
"parser/has-more", cfun_parse_has_more,
|
||||
JDOC("(parser/has-more parser)\n\n"
|
||||
"Check if the parser has more values in the value queue.")
|
||||
},
|
||||
{
|
||||
"parser/produce", cfun_parse_produce,
|
||||
JDOC("(parser/produce parser &opt wrap)\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.")
|
||||
},
|
||||
{
|
||||
"parser/consume", cfun_parse_consume,
|
||||
JDOC("(parser/consume parser bytes &opt index)\n\n"
|
||||
"Input bytes into the parser and parse them. Will not throw errors "
|
||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||
"the number of bytes read.")
|
||||
},
|
||||
{
|
||||
"parser/byte", cfun_parse_byte,
|
||||
JDOC("(parser/byte parser b)\n\n"
|
||||
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||
},
|
||||
{
|
||||
"parser/error", cfun_parse_error,
|
||||
JDOC("(parser/error parser)\n\n"
|
||||
"If the parser is in the error state, returns the message associated with "
|
||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||
"queue, so be sure to handle everything in the queue before calling "
|
||||
"parser/error.")
|
||||
},
|
||||
{
|
||||
"parser/status", cfun_parse_status,
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"parser/flush", cfun_parse_flush,
|
||||
JDOC("(parser/flush parser)\n\n"
|
||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||
"if an error was encountered. Does not reset the line and column counter, so "
|
||||
"to begin parsing in a new context, create a new parser.")
|
||||
},
|
||||
{
|
||||
"parser/state", cfun_parse_state,
|
||||
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, "
|
||||
"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 "
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"parser/eof", cfun_parse_eof,
|
||||
JDOC("(parser/eof parser)\n\n"
|
||||
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||
},
|
||||
{
|
||||
"parser/insert", cfun_parse_insert,
|
||||
JDOC("(parser/insert parser value)\n\n"
|
||||
"Insert a value into the parser. This means that the parser state can be manipulated "
|
||||
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
||||
"and tuples, for example. Returns the parser.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
void janet_lib_parse(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||
JanetRegExt parse_cfuns[] = {
|
||||
JANET_CORE_REG("parser/new", cfun_parse_parser),
|
||||
JANET_CORE_REG("parser/clone", cfun_parse_clone),
|
||||
JANET_CORE_REG("parser/has-more", cfun_parse_has_more),
|
||||
JANET_CORE_REG("parser/produce", cfun_parse_produce),
|
||||
JANET_CORE_REG("parser/consume", cfun_parse_consume),
|
||||
JANET_CORE_REG("parser/byte", cfun_parse_byte),
|
||||
JANET_CORE_REG("parser/error", cfun_parse_error),
|
||||
JANET_CORE_REG("parser/status", cfun_parse_status),
|
||||
JANET_CORE_REG("parser/flush", cfun_parse_flush),
|
||||
JANET_CORE_REG("parser/state", cfun_parse_state),
|
||||
JANET_CORE_REG("parser/where", cfun_parse_where),
|
||||
JANET_CORE_REG("parser/eof", cfun_parse_eof),
|
||||
JANET_CORE_REG("parser/insert", cfun_parse_insert),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, parse_cfuns);
|
||||
}
|
||||
|
136
src/core/peg.c
136
src/core/peg.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -387,6 +387,25 @@ tail:
|
||||
return result;
|
||||
}
|
||||
|
||||
case RULE_CAPTURE_NUM: {
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (!result) return NULL;
|
||||
/* check number parsing */
|
||||
double x = 0.0;
|
||||
int32_t base = (int32_t) rule[2];
|
||||
if (janet_scan_number_base(text, (int32_t)(result - text), base, &x)) return NULL;
|
||||
/* Specialized pushcap - avoid intermediate string creation */
|
||||
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
|
||||
} else {
|
||||
uint32_t tag = rule[3];
|
||||
pushcap(s, janet_wrap_number(x), tag);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
case RULE_ACCUMULATE: {
|
||||
uint32_t tag = rule[2];
|
||||
int oldmode = s->mode;
|
||||
@ -975,6 +994,25 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_cap1(b, argc, argv, RULE_UNREF);
|
||||
}
|
||||
|
||||
static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_arity(b, argc, 1, 3);
|
||||
Reserve r = reserve(b, 4);
|
||||
uint32_t base = 0;
|
||||
if (argc >= 2) {
|
||||
if (!janet_checktype(argv[1], JANET_NIL)) {
|
||||
if (!janet_checkint(argv[1])) goto error;
|
||||
base = (uint32_t) janet_unwrap_integer(argv[1]);
|
||||
if (base < 2 || base > 36) goto error;
|
||||
}
|
||||
}
|
||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
||||
uint32_t rule = peg_compile1(b, argv[0]);
|
||||
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
|
||||
return;
|
||||
error:
|
||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
|
||||
}
|
||||
|
||||
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_arity(b, argc, 1, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
@ -1118,6 +1156,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"line", spec_line},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
{"number", spec_capture_number},
|
||||
{"opt", spec_opt},
|
||||
{"position", spec_position},
|
||||
{"quote", spec_capture},
|
||||
@ -1214,6 +1253,18 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
emit_bytes(b, RULE_LITERAL, len, str);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
/* Build grammar table */
|
||||
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
|
||||
new_grammar->proto = grammar;
|
||||
b->grammar = grammar = new_grammar;
|
||||
/* Run the main rule */
|
||||
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
|
||||
if (janet_checktype(main_rule, JANET_NIL))
|
||||
peg_panic(b, "grammar requires :main rule");
|
||||
rule = peg_compile1(b, main_rule);
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
/* Build grammar table */
|
||||
const JanetKV *st = janet_unwrap_struct(peg);
|
||||
@ -1419,6 +1470,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
if (rule[1] >= clen) goto bad;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_CAPTURE_NUM:
|
||||
/* [rule, base, tag] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_ACCUMULATE:
|
||||
case RULE_GROUP:
|
||||
case RULE_CAPTURE:
|
||||
@ -1541,7 +1598,11 @@ static JanetPeg *compile_peg(Janet x) {
|
||||
* C Functions
|
||||
*/
|
||||
|
||||
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_peg_compile,
|
||||
"(peg/compile peg)",
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
return janet_wrap_abstract(peg);
|
||||
@ -1604,13 +1665,18 @@ static void peg_call_reset(PegCall *c) {
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_peg_match,
|
||||
"(peg/match peg text &opt start & args)",
|
||||
"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.") {
|
||||
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) {
|
||||
JANET_CORE_FN(cfun_peg_find,
|
||||
"(peg/find peg text &opt start & args)",
|
||||
"Find first index where the peg matches in text. Returns an integer, or nil if not found.") {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
@ -1620,7 +1686,9 @@ static Janet cfun_peg_find(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_peg_find_all,
|
||||
"(peg/find-all peg text &opt start & args)",
|
||||
"Find all indexes where the peg matches in text. Returns an array of integers.") {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
JanetArray *ret = janet_array(0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
@ -1659,11 +1727,16 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
return janet_wrap_buffer(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_peg_replace_all,
|
||||
"(peg/replace-all peg repl text &opt start & args)",
|
||||
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 0);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_peg_replace,
|
||||
"(peg/replace peg repl text &opt start & args)",
|
||||
"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.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 1);
|
||||
}
|
||||
|
||||
@ -1688,47 +1761,18 @@ static Janet peg_next(void *p, Janet key) {
|
||||
return janet_nextmethod(peg_methods, key);
|
||||
}
|
||||
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the peg module */
|
||||
void janet_lib_peg(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||
JanetRegExt cfuns[] = {
|
||||
JANET_CORE_REG("peg/compile", cfun_peg_compile),
|
||||
JANET_CORE_REG("peg/match", cfun_peg_match),
|
||||
JANET_CORE_REG("peg/find", cfun_peg_find),
|
||||
JANET_CORE_REG("peg/find-all", cfun_peg_find_all),
|
||||
JANET_CORE_REG("peg/replace", cfun_peg_replace),
|
||||
JANET_CORE_REG("peg/replace-all", cfun_peg_replace_all),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
janet_register_abstract_type(&janet_peg_type);
|
||||
}
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -227,12 +227,14 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
}
|
||||
return;
|
||||
case JANET_CFUNCTION: {
|
||||
Janet check = janet_table_get(janet_vm_registry, x);
|
||||
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||
JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x));
|
||||
if (NULL != reg) {
|
||||
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||
janet_buffer_push_bytes(buffer,
|
||||
janet_unwrap_symbol(check),
|
||||
janet_string_length(janet_unwrap_symbol(check)));
|
||||
if (NULL != reg->name_prefix) {
|
||||
janet_buffer_push_cstring(buffer, reg->name_prefix);
|
||||
janet_buffer_push_u8(buffer, '/');
|
||||
}
|
||||
janet_buffer_push_cstring(buffer, reg->name);
|
||||
janet_buffer_push_u8(buffer, '>');
|
||||
break;
|
||||
}
|
||||
@ -259,21 +261,13 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
|
||||
/* See parse.c for full table */
|
||||
|
||||
static const uint32_t pp_symchars[8] = {
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0x00000000, 0x00000000, 0x00000000, 0x00000000
|
||||
};
|
||||
|
||||
static int pp_is_symbol_char(uint8_t c) {
|
||||
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Check if a symbol or keyword contains no symbol characters */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||
if (!janet_valid_utf8(sym, len)) return 1;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||
if (!janet_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@ -898,7 +892,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panicf("format buffer overflow", form);
|
||||
janet_panic("format buffer overflow");
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
@ -1050,7 +1044,7 @@ void janet_buffer_format(
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panicf("format buffer overflow", form);
|
||||
janet_panic("format buffer overflow");
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -79,7 +79,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
|
||||
int32_t line = parser.line;
|
||||
int32_t col = parser.column;
|
||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||
done = 1;
|
||||
break;
|
||||
}
|
||||
@ -108,3 +110,19 @@ int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Jan
|
||||
return janet_dobytes(env, (const uint8_t *)str, len, sourcePath, out);
|
||||
}
|
||||
|
||||
/* Run a fiber to completion (use event loop if enabled). Return the status. */
|
||||
int janet_loop_fiber(JanetFiber *fiber) {
|
||||
int status;
|
||||
#ifdef JANET_EV
|
||||
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) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
#endif
|
||||
return status;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -410,7 +410,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
right = janetc_value(bodyopts, truebody);
|
||||
if (!drop && !tail) janetc_copy(c, target, right);
|
||||
janetc_popscope(c);
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
if (!janet_checktype(falsebody, JANET_NIL)) {
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
}
|
||||
janetc_popscope(c);
|
||||
return target;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
* Copyright (c) 2021 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
|
||||
@ -20,21 +20,42 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
static Janet cfun_get_five(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(5.0);
|
||||
JANET_THREAD_LOCAL JanetVM janet_vm;
|
||||
|
||||
JanetVM *janet_local_vm(void) {
|
||||
return &janet_vm;
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get5", cfun_get_five, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
JanetVM *janet_vm_alloc(void) {
|
||||
JanetVM *mem = janet_malloc(sizeof(JanetVM));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_vm_free(JanetVM *vm) {
|
||||
janet_free(vm);
|
||||
}
|
||||
|
||||
void janet_vm_save(JanetVM *into) {
|
||||
*into = janet_vm;
|
||||
}
|
||||
|
||||
void janet_vm_load(JanetVM *from) {
|
||||
janet_vm = *from;
|
||||
}
|
||||
|
||||
/* Trigger suspension of the Janet vm by trying to
|
||||
* exit the interpeter loop when convenient. You can optionally
|
||||
* use NULL to interrupt the current VM when convenient */
|
||||
void janet_interpreter_interrupt(JanetVM *vm) {
|
||||
vm = vm ? vm : &janet_vm;
|
||||
vm->auto_suspend = 1;
|
||||
}
|
202
src/core/state.h
202
src/core/state.h
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -25,81 +25,151 @@
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
/* The VM state. Rather than a struct that is passed
|
||||
* around, the vm state is global for simplicity. If
|
||||
* at some point a global state object, or context,
|
||||
* is required to be passed around, this is what would
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
typedef int64_t JanetTimestamp;
|
||||
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
typedef struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
} 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;
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
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. */
|
||||
extern JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf;
|
||||
extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
|
||||
/* Immutable value cache */
|
||||
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_count;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
||||
|
||||
/* Garbage collection */
|
||||
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 */
|
||||
extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
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);
|
||||
typedef struct {
|
||||
int32_t capacity;
|
||||
int32_t head;
|
||||
int32_t tail;
|
||||
void *data;
|
||||
} JanetQueue;
|
||||
|
||||
typedef struct {
|
||||
JanetTimestamp when;
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *curr_fiber;
|
||||
uint32_t sched_id;
|
||||
int is_error;
|
||||
} JanetTimeout;
|
||||
|
||||
/* Registry table for C functions - containts metadata that can
|
||||
* be looked up by cfunction pointer. All strings here are pointing to
|
||||
* static memory not managed by Janet. */
|
||||
typedef struct {
|
||||
JanetCFunction cfun;
|
||||
const char *name;
|
||||
const char *name_prefix;
|
||||
const char *source_file;
|
||||
int32_t source_line;
|
||||
/* int32_t min_arity; */
|
||||
/* int32_t max_arity; */
|
||||
} JanetCFunRegistry;
|
||||
|
||||
struct JanetVM {
|
||||
/* Place for user data */
|
||||
void *user;
|
||||
|
||||
/* Top level dynamic bindings */
|
||||
JanetTable *top_dyns;
|
||||
|
||||
/* Cache the core environment */
|
||||
JanetTable *core_env;
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
int stackn;
|
||||
|
||||
/* If this flag is true, suspend on function calls and backwards jumps.
|
||||
* When this occurs, this flag will be reset to 0. */
|
||||
int auto_suspend;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *root_fiber;
|
||||
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
jmp_buf *signal_buf;
|
||||
Janet *return_reg;
|
||||
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
JanetCFunRegistry *registry;
|
||||
size_t registry_cap;
|
||||
size_t registry_count;
|
||||
int registry_dirty;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
JanetTable *abstract_registry;
|
||||
|
||||
/* Immutable value cache */
|
||||
const uint8_t **cache;
|
||||
uint32_t cache_capacity;
|
||||
uint32_t cache_count;
|
||||
uint32_t cache_deleted;
|
||||
uint8_t gensym_counter[8];
|
||||
|
||||
/* Garbage collection */
|
||||
void *blocks;
|
||||
size_t gc_interval;
|
||||
size_t next_collection;
|
||||
size_t block_count;
|
||||
int gc_suspend;
|
||||
|
||||
/* GC roots */
|
||||
Janet *roots;
|
||||
size_t root_count;
|
||||
size_t root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
JanetScratch **scratch_mem;
|
||||
size_t scratch_cap;
|
||||
size_t scratch_len;
|
||||
|
||||
/* Random number generator */
|
||||
JanetRNG rng;
|
||||
|
||||
/* Traversal pointers */
|
||||
JanetTraversalNode *traversal;
|
||||
JanetTraversalNode *traversal_top;
|
||||
JanetTraversalNode *traversal_base;
|
||||
|
||||
/* Event loop and scheduler globals */
|
||||
#ifdef JANET_EV
|
||||
size_t tq_count;
|
||||
size_t tq_capacity;
|
||||
JanetQueue spawn;
|
||||
JanetTimeout *tq;
|
||||
JanetRNG ev_rng;
|
||||
JanetListenerState **listeners;
|
||||
size_t listener_count;
|
||||
size_t listener_cap;
|
||||
size_t extra_listeners;
|
||||
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
JanetHandle selfpipe[2];
|
||||
int epoll;
|
||||
int timerfd;
|
||||
int timer_enabled;
|
||||
#elif defined(JANET_EV_KQUEUE)
|
||||
JanetHandle selfpipe[2];
|
||||
int kq;
|
||||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
};
|
||||
|
||||
extern JANET_THREAD_LOCAL JanetVM janet_vm;
|
||||
|
||||
#ifdef JANET_NET
|
||||
void janet_net_init(void);
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -170,25 +170,37 @@ static int32_t kmp_next(struct kmp_state *state) {
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_slice,
|
||||
"(string/slice bytes &opt start end)",
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_symbol_slice,
|
||||
"(symbol/slice bytes &opt start end)",
|
||||
"Same a string/slice, but returns a symbol.") {
|
||||
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) {
|
||||
JANET_CORE_FN(cfun_keyword_slice,
|
||||
"(keyword/slice bytes &opt start end)",
|
||||
"Same a string/slice, but returns a keyword.") {
|
||||
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_CORE_FN(cfun_string_repeat,
|
||||
"(string/repeat bytes n)",
|
||||
"Returns a string that is n copies of bytes concatenated.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
int32_t rep = janet_getinteger(argv, 1);
|
||||
@ -204,7 +216,9 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(newbuf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_bytes,
|
||||
"(string/bytes str)",
|
||||
"Returns a tuple of integers that are the byte values of the string.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
Janet *tup = janet_tuple_begin(view.len);
|
||||
@ -215,7 +229,10 @@ static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
}
|
||||
|
||||
static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_frombytes,
|
||||
"(string/from-bytes & byte-vals)",
|
||||
"Creates a string from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.") {
|
||||
int32_t i;
|
||||
uint8_t *buf = janet_string_begin(argc);
|
||||
for (i = 0; i < argc; i++) {
|
||||
@ -225,7 +242,11 @@ static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_asciilower,
|
||||
"(string/ascii-lower str)",
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"lowercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@ -240,7 +261,11 @@ static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_asciiupper,
|
||||
"(string/ascii-upper str)",
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"uppercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@ -255,7 +280,9 @@ static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_reverse(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_reverse,
|
||||
"(string/reverse str)",
|
||||
"Returns a string that is the reversed version of str.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@ -279,7 +306,11 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
|
||||
s->i = start;
|
||||
}
|
||||
|
||||
static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_find,
|
||||
"(string/find patt str &opt start-index)",
|
||||
"Searches for the first instance of pattern patt in string "
|
||||
"str. Returns the index of the first character in patt if found, "
|
||||
"otherwise returns nil.") {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
findsetup(argc, argv, &state, 0);
|
||||
@ -290,7 +321,9 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_integer(result);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_hasprefix,
|
||||
"(string/has-prefix? pfx str)",
|
||||
"Tests whether str starts with pfx.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@ -299,7 +332,9 @@ static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_hassuffix,
|
||||
"(string/has-suffix? sfx str)",
|
||||
"Tests whether str ends with sfx.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@ -310,7 +345,12 @@ static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||
suffix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_findall,
|
||||
"(string/find-all patt str &opt start-index)",
|
||||
"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.") {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
findsetup(argc, argv, &state, 0);
|
||||
@ -344,7 +384,10 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
|
||||
s->substlen = subst.len;
|
||||
}
|
||||
|
||||
static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_replace,
|
||||
"(string/replace patt subst str)",
|
||||
"Replace the first occurrence of patt with subst in the string str. "
|
||||
"Will return the new string if patt is found, otherwise returns str.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
uint8_t *buf;
|
||||
@ -364,7 +407,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_replaceall,
|
||||
"(string/replace-all patt subst str)",
|
||||
"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. "
|
||||
"Will return the new string if patt is found, otherwise returns str.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
JanetBuffer b;
|
||||
@ -384,7 +431,13 @@ static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_split,
|
||||
"(string/split delim str &opt start limit)",
|
||||
"Splits a string str with delimiter delim and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for delim at the index start (if provided), and return up to a maximum "
|
||||
"of limit results (if provided).") {
|
||||
int32_t result;
|
||||
JanetArray *array;
|
||||
struct kmp_state state;
|
||||
@ -406,7 +459,11 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_checkset,
|
||||
"(string/check-set set str)",
|
||||
"Checks that the string str only contains bytes that appear in the string set. "
|
||||
"Returns true if all bytes in str appear in set, false if some bytes in str do "
|
||||
"not appear in set.") {
|
||||
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView set = janet_getbytes(argv, 0);
|
||||
@ -428,7 +485,10 @@ static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_true();
|
||||
}
|
||||
|
||||
static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_join,
|
||||
"(string/join parts &opt sep)",
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string sep.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetView parts = janet_getindexed(argv, 0);
|
||||
JanetByteView joiner;
|
||||
@ -468,7 +528,10 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
static Janet cfun_string_format(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_format,
|
||||
"(string/format format & values)",
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"a new string.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 0);
|
||||
@ -508,7 +571,10 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_trim,
|
||||
"(string/trim str &opt set)",
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
@ -518,163 +584,52 @@ static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_triml,
|
||||
"(string/triml str &opt set)",
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_string_trimr,
|
||||
"(string/trimr str &opt set)",
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
return janet_stringv(str.bytes, right_edge);
|
||||
}
|
||||
|
||||
static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/slice", cfun_string_slice,
|
||||
JDOC("(string/slice bytes &opt start end)\n\n"
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
"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"
|
||||
"Returns a string that is n copies of bytes concatenated.")
|
||||
},
|
||||
{
|
||||
"string/bytes", cfun_string_bytes,
|
||||
JDOC("(string/bytes str)\n\n"
|
||||
"Returns an array of integers that are the byte values of the string.")
|
||||
},
|
||||
{
|
||||
"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 "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
"string/ascii-lower", cfun_string_asciilower,
|
||||
JDOC("(string/ascii-lower str)\n\n"
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"lowercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.")
|
||||
},
|
||||
{
|
||||
"string/ascii-upper", cfun_string_asciiupper,
|
||||
JDOC("(string/ascii-upper str)\n\n"
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"uppercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.")
|
||||
},
|
||||
{
|
||||
"string/reverse", cfun_string_reverse,
|
||||
JDOC("(string/reverse str)\n\n"
|
||||
"Returns a string that is the reversed version of str.")
|
||||
},
|
||||
{
|
||||
"string/find", cfun_string_find,
|
||||
JDOC("(string/find patt str &opt start-index)\n\n"
|
||||
"Searches for the first instance of pattern patt in string "
|
||||
"str. Returns the index of the first character in patt if found, "
|
||||
"otherwise returns nil.")
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find-all patt str &opt start-index)\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.")
|
||||
},
|
||||
{
|
||||
"string/has-prefix?", cfun_string_hasprefix,
|
||||
JDOC("(string/has-prefix? pfx str)\n\n"
|
||||
"Tests whether str starts with pfx.")
|
||||
},
|
||||
{
|
||||
"string/has-suffix?", cfun_string_hassuffix,
|
||||
JDOC("(string/has-suffix? sfx str)\n\n"
|
||||
"Tests whether str ends with sfx.")
|
||||
},
|
||||
{
|
||||
"string/replace", cfun_string_replace,
|
||||
JDOC("(string/replace patt subst str)\n\n"
|
||||
"Replace the first occurrence of patt with subst in the string str. "
|
||||
"Will return the new string if patt is found, otherwise returns str.")
|
||||
},
|
||||
{
|
||||
"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. "
|
||||
"Will return the new string if patt is found, otherwise returns str.")
|
||||
},
|
||||
{
|
||||
"string/split", cfun_string_split,
|
||||
JDOC("(string/split delim str &opt start limit)\n\n"
|
||||
"Splits a string str with delimiter delim and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for delim at the index start (if provided), and return up to a maximum "
|
||||
"of limit results (if provided).")
|
||||
},
|
||||
{
|
||||
"string/check-set", cfun_string_checkset,
|
||||
JDOC("(string/check-set set str)\n\n"
|
||||
"Checks that the string str only contains bytes that appear in the string set. "
|
||||
"Returns true if all bytes in str appear in set, false if some bytes in str do "
|
||||
"not appear in set.")
|
||||
},
|
||||
{
|
||||
"string/join", cfun_string_join,
|
||||
JDOC("(string/join parts &opt sep)\n\n"
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string sep.")
|
||||
},
|
||||
{
|
||||
"string/format", cfun_string_format,
|
||||
JDOC("(string/format format & values)\n\n"
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
"string/trim", cfun_string_trim,
|
||||
JDOC("(string/trim str &opt set)\n\n"
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/triml", cfun_string_triml,
|
||||
JDOC("(string/triml str &opt set)\n\n"
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/trimr", cfun_string_trimr,
|
||||
JDOC("(string/trimr str &opt set)\n\n"
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_string(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, string_cfuns);
|
||||
JanetRegExt string_cfuns[] = {
|
||||
JANET_CORE_REG("string/slice", cfun_string_slice),
|
||||
JANET_CORE_REG("keyword/slice", cfun_keyword_slice),
|
||||
JANET_CORE_REG("symbol/slice", cfun_symbol_slice),
|
||||
JANET_CORE_REG("string/repeat", cfun_string_repeat),
|
||||
JANET_CORE_REG("string/bytes", cfun_string_bytes),
|
||||
JANET_CORE_REG("string/from-bytes", cfun_string_frombytes),
|
||||
JANET_CORE_REG("string/ascii-lower", cfun_string_asciilower),
|
||||
JANET_CORE_REG("string/ascii-upper", cfun_string_asciiupper),
|
||||
JANET_CORE_REG("string/reverse", cfun_string_reverse),
|
||||
JANET_CORE_REG("string/find", cfun_string_find),
|
||||
JANET_CORE_REG("string/find-all", cfun_string_findall),
|
||||
JANET_CORE_REG("string/has-prefix?", cfun_string_hasprefix),
|
||||
JANET_CORE_REG("string/has-suffix?", cfun_string_hassuffix),
|
||||
JANET_CORE_REG("string/replace", cfun_string_replace),
|
||||
JANET_CORE_REG("string/replace-all", cfun_string_replaceall),
|
||||
JANET_CORE_REG("string/split", cfun_string_split),
|
||||
JANET_CORE_REG("string/check-set", cfun_string_checkset),
|
||||
JANET_CORE_REG("string/join", cfun_string_join),
|
||||
JANET_CORE_REG("string/format", cfun_string_format),
|
||||
JANET_CORE_REG("string/trim", cfun_string_trim),
|
||||
JANET_CORE_REG("string/triml", cfun_string_triml),
|
||||
JANET_CORE_REG("string/trimr", cfun_string_trimr),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, string_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -246,15 +246,15 @@ static double convert(
|
||||
}
|
||||
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int janet_scan_number(
|
||||
* and integer, return 0. */
|
||||
int janet_scan_number_base(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int32_t base,
|
||||
double *out) {
|
||||
const uint8_t *end = str + len;
|
||||
int seenadigit = 0;
|
||||
int ex = 0;
|
||||
int base = 10;
|
||||
int seenpoint = 0;
|
||||
int foundexp = 0;
|
||||
int neg = 0;
|
||||
@ -278,21 +278,28 @@ int janet_scan_number(
|
||||
}
|
||||
|
||||
/* Check for leading 0x or digit digit r */
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
if (base == 0) {
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
}
|
||||
}
|
||||
|
||||
/* If still base is 0, set to default (10) */
|
||||
if (base == 0) {
|
||||
base = 10;
|
||||
}
|
||||
|
||||
/* Skip leading zeros */
|
||||
@ -376,6 +383,13 @@ error:
|
||||
return 1;
|
||||
}
|
||||
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
double *out) {
|
||||
return janet_scan_number_base(str, len, 0, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
static int scan_uint64(
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -167,17 +167,12 @@ Janet janet_struct_rawget(const JanetKV *st, Janet key) {
|
||||
|
||||
/* Get an item from a struct */
|
||||
Janet janet_struct_get(const JanetKV *st, Janet key) {
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
if (NULL != kv)
|
||||
return kv->value;
|
||||
/* Check prototypes */
|
||||
{
|
||||
int i = JANET_MAX_PROTO_DEPTH;
|
||||
for (st = janet_struct_proto(st); st && i; st = janet_struct_proto(st), --i) {
|
||||
kv = janet_struct_find(st, key);
|
||||
if (NULL != kv)
|
||||
return kv->value;
|
||||
}
|
||||
int i = JANET_MAX_PROTO_DEPTH;
|
||||
for (; st && i; --i) {
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
if (NULL != kv)
|
||||
return kv->value;
|
||||
st = janet_struct_proto(st);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@ -216,20 +211,25 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_struct_with_proto(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_struct_with_proto,
|
||||
"(struct/with-proto proto & kvs)",
|
||||
"Create a structure, as with the usual struct constructor but set the "
|
||||
"struct prototype as well.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetStruct proto = janet_optstruct(argv, argc, 0, NULL);
|
||||
if (!(argc & 1))
|
||||
janet_panic("expected odd number of arguments");
|
||||
JanetKV *st = janet_struct_begin(argc / 2);
|
||||
janet_struct_proto(st) = proto;
|
||||
for (int32_t i = 1; i < argc; i += 2) {
|
||||
janet_struct_put(st, argv[i], argv[i + 1]);
|
||||
}
|
||||
janet_struct_proto(st) = proto;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet cfun_struct_getproto(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_struct_getproto,
|
||||
"(struct/getproto st)",
|
||||
"Return the prototype of a struct, or nil if it doesn't have one.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
return janet_struct_proto(st)
|
||||
@ -237,7 +237,10 @@ static Janet cfun_struct_getproto(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_struct_flatten(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_struct_flatten,
|
||||
"(struct/proto-flatten st)",
|
||||
"Convert a struct with prototypes to a struct with no prototypes by merging "
|
||||
"all key value pairs from recursive prototypes into one new struct.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
|
||||
@ -267,7 +270,10 @@ static Janet cfun_struct_flatten(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_struct(janet_struct_end(accum));
|
||||
}
|
||||
|
||||
static Janet cfun_struct_to_table(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_struct_to_table,
|
||||
"(struct/to-table st &opt recursive)",
|
||||
"Convert a struct to a table. If recursive is true, also convert the "
|
||||
"table's prototypes into the new struct's prototypes as well.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
int recursive = argc > 1 && janet_truthy(argv[1]);
|
||||
@ -295,34 +301,14 @@ static Janet cfun_struct_to_table(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(tab);
|
||||
}
|
||||
|
||||
static const JanetReg struct_cfuns[] = {
|
||||
{
|
||||
"struct/with-proto", cfun_struct_with_proto,
|
||||
JDOC("(struct/with-proto proto & kvs)\n\n"
|
||||
"Create a structure, as with the usual struct constructor but set the "
|
||||
"struct prototype as well.")
|
||||
},
|
||||
{
|
||||
"struct/getproto", cfun_struct_getproto,
|
||||
JDOC("(struct/getproto st)\n\n"
|
||||
"Get the prototype of a struct, or nil if it doesn't have one.")
|
||||
},
|
||||
{
|
||||
"struct/proto-flatten", cfun_struct_flatten,
|
||||
JDOC("(struct/proto-flatten st)\n\n"
|
||||
"Convert a struct with prototypes to a struct with no prototypes by merging "
|
||||
"all key value pairs from recursive prototypes into one new struct.")
|
||||
},
|
||||
{
|
||||
"struct/to-table", cfun_struct_to_table,
|
||||
JDOC("(struct/to-table st &opt recursive)\n\n"
|
||||
"Convert a struct to a table. If recursive is true, also convert the "
|
||||
"table's prototypes into the new struct's prototypes as well.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the struct module */
|
||||
void janet_lib_struct(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, struct_cfuns);
|
||||
JanetRegExt struct_cfuns[] = {
|
||||
JANET_CORE_REG("struct/with-proto", cfun_struct_with_proto),
|
||||
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
|
||||
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
|
||||
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, struct_cfuns);
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -36,30 +36,26 @@
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Cache state */
|
||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_count = 0;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
||||
|
||||
/* Initialize the cache (allocate cache memory) */
|
||||
void janet_symcache_init() {
|
||||
janet_vm_cache_capacity = 1024;
|
||||
janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm_cache) {
|
||||
janet_vm.cache_capacity = 1024;
|
||||
janet_vm.cache = janet_calloc(1, (size_t) janet_vm.cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm.cache) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_cache_count = 0;
|
||||
janet_vm_cache_deleted = 0;
|
||||
memset(&janet_vm.gensym_counter, '0', sizeof(janet_vm.gensym_counter));
|
||||
janet_vm.gensym_counter[0] = '_';
|
||||
janet_vm.cache_count = 0;
|
||||
janet_vm.cache_deleted = 0;
|
||||
}
|
||||
|
||||
/* Deinitialize the cache (free the cache memory) */
|
||||
void janet_symcache_deinit() {
|
||||
janet_free((void *)janet_vm_cache);
|
||||
janet_vm_cache = NULL;
|
||||
janet_vm_cache_capacity = 0;
|
||||
janet_vm_cache_count = 0;
|
||||
janet_vm_cache_deleted = 0;
|
||||
janet_free((void *)janet_vm.cache);
|
||||
janet_vm.cache = NULL;
|
||||
janet_vm.cache_capacity = 0;
|
||||
janet_vm.cache_count = 0;
|
||||
janet_vm.cache_deleted = 0;
|
||||
}
|
||||
|
||||
/* Mark an entry in the table as deleted. */
|
||||
@ -79,24 +75,24 @@ static const uint8_t **janet_symcache_findmem(
|
||||
|
||||
/* We will search two ranges - index to the end,
|
||||
* and 0 to the index. */
|
||||
index = (uint32_t)hash & (janet_vm_cache_capacity - 1);
|
||||
index = (uint32_t)hash & (janet_vm.cache_capacity - 1);
|
||||
bounds[0] = index;
|
||||
bounds[1] = janet_vm_cache_capacity;
|
||||
bounds[1] = janet_vm.cache_capacity;
|
||||
bounds[2] = 0;
|
||||
bounds[3] = index;
|
||||
for (j = 0; j < 4; j += 2)
|
||||
for (i = bounds[j]; i < bounds[j + 1]; ++i) {
|
||||
const uint8_t *test = janet_vm_cache[i];
|
||||
const uint8_t *test = janet_vm.cache[i];
|
||||
/* Check empty spots */
|
||||
if (NULL == test) {
|
||||
if (NULL == firstEmpty)
|
||||
firstEmpty = janet_vm_cache + i;
|
||||
firstEmpty = janet_vm.cache + i;
|
||||
goto notfound;
|
||||
}
|
||||
/* Check for marked deleted */
|
||||
if (JANET_SYMCACHE_DELETED == test) {
|
||||
if (firstEmpty == NULL)
|
||||
firstEmpty = janet_vm_cache + i;
|
||||
firstEmpty = janet_vm.cache + i;
|
||||
continue;
|
||||
}
|
||||
if (janet_string_equalconst(test, str, len, hash)) {
|
||||
@ -104,10 +100,10 @@ static const uint8_t **janet_symcache_findmem(
|
||||
*success = 1;
|
||||
if (firstEmpty != NULL) {
|
||||
*firstEmpty = test;
|
||||
janet_vm_cache[i] = JANET_SYMCACHE_DELETED;
|
||||
janet_vm.cache[i] = JANET_SYMCACHE_DELETED;
|
||||
return firstEmpty;
|
||||
}
|
||||
return janet_vm_cache + i;
|
||||
return janet_vm.cache + i;
|
||||
}
|
||||
}
|
||||
notfound:
|
||||
@ -121,15 +117,15 @@ notfound:
|
||||
/* Resize the cache. */
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm_cache;
|
||||
const uint8_t **oldCache = janet_vm.cache;
|
||||
const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
oldCapacity = janet_vm_cache_capacity;
|
||||
janet_vm_cache = newCache;
|
||||
janet_vm_cache_capacity = newCapacity;
|
||||
janet_vm_cache_deleted = 0;
|
||||
oldCapacity = janet_vm.cache_capacity;
|
||||
janet_vm.cache = newCache;
|
||||
janet_vm.cache_capacity = newCapacity;
|
||||
janet_vm.cache_deleted = 0;
|
||||
/* Add all of the old cache entries back */
|
||||
for (i = 0; i < oldCapacity; ++i) {
|
||||
int status;
|
||||
@ -150,13 +146,13 @@ static void janet_cache_resize(uint32_t newCapacity) {
|
||||
|
||||
/* Add an item to the cache */
|
||||
static void janet_symcache_put(const uint8_t *x, const uint8_t **bucket) {
|
||||
if ((janet_vm_cache_count + janet_vm_cache_deleted) * 2 > janet_vm_cache_capacity) {
|
||||
if ((janet_vm.cache_count + janet_vm.cache_deleted) * 2 > janet_vm.cache_capacity) {
|
||||
int status;
|
||||
janet_cache_resize(janet_tablen((2 * janet_vm_cache_count + 1)));
|
||||
janet_cache_resize(janet_tablen((2 * janet_vm.cache_count + 1)));
|
||||
bucket = janet_symcache_find(x, &status);
|
||||
}
|
||||
/* Add x to the cache */
|
||||
janet_vm_cache_count++;
|
||||
janet_vm.cache_count++;
|
||||
*bucket = x;
|
||||
}
|
||||
|
||||
@ -165,8 +161,8 @@ void janet_symbol_deinit(const uint8_t *sym) {
|
||||
int status = 0;
|
||||
const uint8_t **bucket = janet_symcache_find(sym, &status);
|
||||
if (status) {
|
||||
janet_vm_cache_count--;
|
||||
janet_vm_cache_deleted++;
|
||||
janet_vm.cache_count--;
|
||||
janet_vm.cache_deleted++;
|
||||
*bucket = JANET_SYMCACHE_DELETED;
|
||||
}
|
||||
}
|
||||
@ -194,22 +190,19 @@ const uint8_t *janet_csymbol(const char *cstr) {
|
||||
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||
}
|
||||
|
||||
/* Store counter for genysm to avoid quadratic behavior */
|
||||
JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
|
||||
|
||||
/* Increment the gensym buffer */
|
||||
static void inc_gensym(void) {
|
||||
for (int i = sizeof(gensym_counter) - 2; i; i--) {
|
||||
if (gensym_counter[i] == '9') {
|
||||
gensym_counter[i] = 'a';
|
||||
for (int i = sizeof(janet_vm.gensym_counter) - 2; i; i--) {
|
||||
if (janet_vm.gensym_counter[i] == '9') {
|
||||
janet_vm.gensym_counter[i] = 'a';
|
||||
break;
|
||||
} else if (gensym_counter[i] == 'z') {
|
||||
gensym_counter[i] = 'A';
|
||||
} else if (janet_vm.gensym_counter[i] == 'z') {
|
||||
janet_vm.gensym_counter[i] = 'A';
|
||||
break;
|
||||
} else if (gensym_counter[i] == 'Z') {
|
||||
gensym_counter[i] = '0';
|
||||
} else if (janet_vm.gensym_counter[i] == 'Z') {
|
||||
janet_vm.gensym_counter[i] = '0';
|
||||
} else {
|
||||
gensym_counter[i]++;
|
||||
janet_vm.gensym_counter[i]++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@ -227,19 +220,19 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
* is enough for resolving collisions. */
|
||||
do {
|
||||
hash = janet_string_calchash(
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1);
|
||||
janet_vm.gensym_counter,
|
||||
sizeof(janet_vm.gensym_counter) - 1);
|
||||
bucket = janet_symcache_findmem(
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1,
|
||||
janet_vm.gensym_counter,
|
||||
sizeof(janet_vm.gensym_counter) - 1,
|
||||
hash,
|
||||
&status);
|
||||
} while (status && (inc_gensym(), 1));
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||
head->length = sizeof(gensym_counter) - 1;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(janet_vm.gensym_counter));
|
||||
head->length = sizeof(janet_vm.gensym_counter) - 1;
|
||||
head->hash = hash;
|
||||
sym = (uint8_t *)(head->data);
|
||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||
return (const uint8_t *)sym;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
120
src/core/table.c
120
src/core/table.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -67,14 +67,23 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Initialize a table */
|
||||
/* Initialize a table (for use withs scratch memory) */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 1);
|
||||
}
|
||||
|
||||
/* Initialize a table without using scratch memory */
|
||||
JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
/* Deinitialize a table */
|
||||
void janet_table_deinit(JanetTable *table) {
|
||||
janet_sfree(table->data);
|
||||
if (table->gc.flags & JANET_TABLE_FLAG_STACK) {
|
||||
janet_sfree(table->data);
|
||||
} else {
|
||||
janet_free(table->data);
|
||||
}
|
||||
}
|
||||
|
||||
/* Create a new table */
|
||||
@ -300,13 +309,21 @@ JanetTable *janet_table_proto_flatten(JanetTable *t) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_table_new(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_new,
|
||||
"(table/new capacity)",
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
|
||||
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_getproto,
|
||||
"(table/getproto tab)",
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return t->proto
|
||||
@ -314,7 +331,9 @@ static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_setproto,
|
||||
"(table/setproto tab proto)",
|
||||
"Set the prototype of a table. Returns the original table tab.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
JanetTable *proto = NULL;
|
||||
@ -325,78 +344,63 @@ static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_tostruct,
|
||||
"(table/to-struct tab)",
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
}
|
||||
|
||||
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_rawget,
|
||||
"(table/rawget tab key)",
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_table_rawget(table, argv[1]);
|
||||
}
|
||||
|
||||
static Janet cfun_table_clone(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_clone,
|
||||
"(table/clone tab)",
|
||||
"Create a copy of a table. Updates to the new table will not change the old table, "
|
||||
"and vice versa.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_table_clone(table));
|
||||
}
|
||||
|
||||
static Janet cfun_table_proto_flatten(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_table_clear,
|
||||
"(table/clear tab)",
|
||||
"Remove all key-value pairs in a table and return the modified table `tab`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
janet_table_clear(table);
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_proto_flatten,
|
||||
"(table/proto-flatten tab)",
|
||||
"Create a new table that is the result of merging all prototypes into a new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_table_proto_flatten(table));
|
||||
}
|
||||
|
||||
static const JanetReg table_cfuns[] = {
|
||||
{
|
||||
"table/new", cfun_table_new,
|
||||
JDOC("(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.")
|
||||
},
|
||||
{
|
||||
"table/to-struct", cfun_table_tostruct,
|
||||
JDOC("(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.")
|
||||
},
|
||||
{
|
||||
"table/getproto", cfun_table_getproto,
|
||||
JDOC("(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype.")
|
||||
},
|
||||
{
|
||||
"table/setproto", cfun_table_setproto,
|
||||
JDOC("(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab.")
|
||||
},
|
||||
{
|
||||
"table/rawget", cfun_table_rawget,
|
||||
JDOC("(table/rawget tab key)\n\n"
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.")
|
||||
},
|
||||
{
|
||||
"table/clone", cfun_table_clone,
|
||||
JDOC("(table/clone tab)\n\n"
|
||||
"Create a copy of a table. Updates to the new table will not change the old table, "
|
||||
"and vice versa.")
|
||||
},
|
||||
{
|
||||
"table/proto-flatten", cfun_table_proto_flatten,
|
||||
JDOC("(table/proto-flatten tab)\n\n"
|
||||
"Create a new table that is the result of merging all prototypes into a new table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the table module */
|
||||
void janet_lib_table(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, table_cfuns);
|
||||
JanetRegExt table_cfuns[] = {
|
||||
JANET_CORE_REG("table/new", cfun_table_new),
|
||||
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
|
||||
JANET_CORE_REG("table/getproto", cfun_table_getproto),
|
||||
JANET_CORE_REG("table/setproto", cfun_table_setproto),
|
||||
JANET_CORE_REG("table/rawget", cfun_table_rawget),
|
||||
JANET_CORE_REG("table/clone", cfun_table_clone),
|
||||
JANET_CORE_REG("table/clear", cfun_table_clear),
|
||||
JANET_CORE_REG("table/proto-flatten", cfun_table_proto_flatten),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, table_cfuns);
|
||||
}
|
||||
|
@ -1,781 +0,0 @@
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <setjmp.h>
|
||||
#include <time.h>
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
|
||||
/* typedefed in janet.h */
|
||||
struct JanetMailbox {
|
||||
|
||||
/* Synchronization */
|
||||
#ifdef JANET_WINDOWS
|
||||
CRITICAL_SECTION lock;
|
||||
CONDITION_VARIABLE cond;
|
||||
#else
|
||||
pthread_mutex_t lock;
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Memory management - reference counting */
|
||||
int refCount;
|
||||
int closed;
|
||||
|
||||
/* Store messages */
|
||||
uint16_t messageCapacity;
|
||||
uint16_t messageCount;
|
||||
uint16_t messageFirst;
|
||||
uint16_t messageNext;
|
||||
|
||||
/* Buffers to store messages. These buffers are manually allocated, so
|
||||
* are not owned by any thread's GC. */
|
||||
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;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
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;
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
InitializeCriticalSection(&mailbox->lock);
|
||||
InitializeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_mutex_init(&mailbox->lock, NULL);
|
||||
pthread_cond_init(&mailbox->cond, NULL);
|
||||
#endif
|
||||
mailbox->refCount = refCount;
|
||||
mailbox->closed = 0;
|
||||
mailbox->messageCount = 0;
|
||||
mailbox->messageCapacity = capacity;
|
||||
mailbox->messageFirst = 0;
|
||||
mailbox->messageNext = 0;
|
||||
for (uint16_t i = 0; i < capacity; i++) {
|
||||
janet_buffer_init(mailbox->messages + i, 0);
|
||||
}
|
||||
return mailbox;
|
||||
}
|
||||
|
||||
static void janet_mailbox_destroy(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
DeleteCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_destroy(&mailbox->lock);
|
||||
pthread_cond_destroy(&mailbox->cond);
|
||||
#endif
|
||||
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
|
||||
janet_buffer_deinit(mailbox->messages + i);
|
||||
}
|
||||
janet_free(mailbox);
|
||||
}
|
||||
|
||||
static void janet_mailbox_lock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
EnterCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_lock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_unlock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
LeaveCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_unlock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Assumes you have the mailbox lock already */
|
||||
static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
|
||||
mailbox->refCount += delta;
|
||||
if (mailbox->refCount <= 0) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_destroy(mailbox);
|
||||
} else {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
|
||||
janet_mailbox_lock(mailbox);
|
||||
janet_mailbox_ref_with_lock(mailbox, delta);
|
||||
}
|
||||
|
||||
static void janet_close_thread(JanetThread *thread) {
|
||||
if (thread->mailbox) {
|
||||
janet_mailbox_ref(thread->mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
static int thread_gc(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
janet_close_thread(thread);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int thread_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
if (thread->encode) {
|
||||
janet_mark(janet_wrap_table(thread->encode));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
pair->flags = flags;
|
||||
return pair;
|
||||
}
|
||||
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
janet_free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
typedef struct {
|
||||
int timedwait;
|
||||
int nowait;
|
||||
#ifdef JANET_WINDOWS
|
||||
DWORD interval;
|
||||
DWORD ticksLeft;
|
||||
#else
|
||||
struct timespec ts;
|
||||
#endif
|
||||
} JanetWaiter;
|
||||
|
||||
static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
waiter->timedwait = 0;
|
||||
waiter->nowait = 0;
|
||||
|
||||
if (sec <= 0.0 || isnan(sec)) {
|
||||
waiter->nowait = 1;
|
||||
return;
|
||||
}
|
||||
waiter->timedwait = sec > 0.0 && !isinf(sec);
|
||||
|
||||
/* Set maximum wait time to 30 days */
|
||||
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
|
||||
sec = 60.0 * 60.0 * 24.0 * 30.0;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
if (waiter->timedwait) {
|
||||
waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
|
||||
}
|
||||
#else
|
||||
if (waiter->timedwait) {
|
||||
/* N seconds -> timespec of (now + sec) */
|
||||
struct timespec now;
|
||||
janet_gettime(&now);
|
||||
time_t tvsec = (time_t) floor(sec);
|
||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||
tvsec += now.tv_sec;
|
||||
tvnsec += now.tv_nsec;
|
||||
if (tvnsec >= 1000000000L) {
|
||||
tvnsec -= 1000000000L;
|
||||
tvsec += 1;
|
||||
}
|
||||
waiter->ts.tv_sec = tvsec;
|
||||
waiter->ts.tv_nsec = tvnsec;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
|
||||
if (wait->nowait) return 1;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (wait->timedwait) {
|
||||
if (wait->ticksLeft == 0) return 1;
|
||||
DWORD startTime = GetTickCount();
|
||||
int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
|
||||
DWORD dTick = GetTickCount() - startTime;
|
||||
/* Be careful about underflow */
|
||||
wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
|
||||
return status;
|
||||
} else {
|
||||
SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
if (wait->timedwait) {
|
||||
return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
|
||||
} else {
|
||||
pthread_cond_wait(&mailbox->cond, &mailbox->lock);
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WakeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_cond_signal(&mailbox->cond);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int mailbox_at_capacity(JanetMailbox *mailbox) {
|
||||
return mailbox->messageCount >= mailbox->messageCapacity;
|
||||
}
|
||||
|
||||
/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
|
||||
* 0 otherwise. Will not panic. */
|
||||
int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
|
||||
/* Ensure mailbox is not closed. */
|
||||
JanetMailbox *mailbox = thread->mailbox;
|
||||
if (NULL == mailbox) return 2;
|
||||
janet_mailbox_lock(mailbox);
|
||||
if (mailbox->closed) {
|
||||
janet_mailbox_ref_with_lock(mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/* Back pressure */
|
||||
if (mailbox_at_capacity(mailbox)) {
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Retry loop, as there can be multiple writers */
|
||||
while (mailbox_at_capacity(mailbox)) {
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
int32_t oldmcount = mailbox->messageCount;
|
||||
|
||||
int ret = 0;
|
||||
if (setjmp(buf)) {
|
||||
ret = 1;
|
||||
mailbox->messageCount = oldmcount;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext;
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
mailbox->messageCount++;
|
||||
}
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up a blocked thread */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Returns 0 on successful message. Returns 1 if timedout */
|
||||
int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
JanetMailbox *mailbox = janet_vm_mailbox;
|
||||
janet_mailbox_lock(mailbox);
|
||||
|
||||
/* For timeouts */
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* Check for messages waiting for us */
|
||||
if (mailbox->messageCount > 0) {
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
|
||||
/* Handle errors */
|
||||
if (setjmp(buf)) {
|
||||
/* Cleanup jmp_buf, return error.
|
||||
* Do not ignore bad messages as before. */
|
||||
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--;
|
||||
mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity;
|
||||
|
||||
/* Read from beginning of channel */
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up pending threads */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Wait for next message */
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
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
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
|
||||
janet_mailbox_ref(mailbox, 1);
|
||||
thread->mailbox = mailbox;
|
||||
thread->encode = encode;
|
||||
return thread;
|
||||
}
|
||||
|
||||
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailboxPair *pair) {
|
||||
JanetFiber *fiber = NULL;
|
||||
Janet out;
|
||||
|
||||
/* Use the mailbox we were given */
|
||||
janet_vm_mailbox = pair->newbox;
|
||||
janet_mailbox_ref(pair->newbox, 1);
|
||||
|
||||
/* Init VM */
|
||||
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));
|
||||
}
|
||||
|
||||
/* 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(®, 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(®, 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);
|
||||
|
||||
/* Arity check */
|
||||
if (func->def->min_arity > 1 || func->def->max_arity < 1) {
|
||||
goto error;
|
||||
}
|
||||
|
||||
/* 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) {
|
||||
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();
|
||||
return 0;
|
||||
|
||||
/* Fail to set something up */
|
||||
error:
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_eprintf("\nthread failed to start\n");
|
||||
janet_deinit();
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
|
||||
int ret = NULL == handle;
|
||||
/* Does not kill thread, simply detatches */
|
||||
if (!ret) CloseHandle(handle);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
static void *janet_pthread_wrapper(void *param) {
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
pthread_t handle;
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
|
||||
if (error) {
|
||||
return 1;
|
||||
} else {
|
||||
pthread_detach(handle);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Setup/Teardown
|
||||
*/
|
||||
|
||||
void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(1, 10);
|
||||
}
|
||||
janet_vm_thread_decode = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
}
|
||||
|
||||
void janet_threads_deinit(void) {
|
||||
janet_mailbox_lock(janet_vm_mailbox);
|
||||
janet_vm_mailbox->closed = 1;
|
||||
janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
|
||||
janet_vm_mailbox = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
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
|
||||
*/
|
||||
|
||||
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_abstract(janet_thread_current());
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
/* 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;
|
||||
}
|
||||
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
|
||||
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]);
|
||||
}
|
||||
|
||||
return janet_wrap_abstract(thread);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_send(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("failed to send message %v", argv[1]);
|
||||
case 2:
|
||||
janet_panic("thread mailbox is closed");
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
double wait = janet_optnumber(argv, argc, 0, 1.0);
|
||||
Janet out;
|
||||
int status = janet_thread_receive(&out, wait);
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("timeout after %f seconds", wait);
|
||||
case 2:
|
||||
janet_panicf("failed to receive message: %v", out);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
static Janet cfun_thread_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
janet_close_thread(thread);
|
||||
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},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
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,
|
||||
JDOC("(thread/current)\n\n"
|
||||
"Get the current running thread.")
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity flags)\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. "
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"thread/close", cfun_thread_close,
|
||||
JDOC("(thread/close thread)\n\n"
|
||||
"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}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_thread(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, threadlib_cfuns);
|
||||
janet_register_abstract_type(&janet_thread_type);
|
||||
}
|
||||
|
||||
#endif
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -55,19 +55,35 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_tuple_brackets,
|
||||
"(tuple/brackets & xs)",
|
||||
"Creates a new bracketed tuple containing the elements xs.") {
|
||||
const Janet *tup = janet_tuple_n(argv, argc);
|
||||
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
return janet_wrap_tuple(tup);
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_tuple_slice,
|
||||
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively. "
|
||||
"'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index '(length arrtup)' to allow a full negative slice range. "
|
||||
"Returns the new tuple.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_tuple_type,
|
||||
"(tuple/type tup)",
|
||||
"Checks how the tuple was constructed. Will return the keyword "
|
||||
":brackets if the tuple was parsed with brackets, and :parens "
|
||||
"otherwise. The two types of tuples will behave the same most of "
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
|
||||
@ -77,7 +93,10 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_tuple_sourcemap,
|
||||
"(tuple/sourcemap tup)",
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
" which is another tuple (line, column).") {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
Janet contents[2];
|
||||
@ -86,7 +105,10 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(cfun_tuple_setmap,
|
||||
"(tuple/setmap tup line column)",
|
||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
||||
"should be integers.") {
|
||||
janet_fixarity(argc, 3);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
|
||||
@ -94,48 +116,15 @@ static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/brackets", cfun_tuple_brackets,
|
||||
JDOC("(tuple/brackets & xs)\n\n"
|
||||
"Creates a new bracketed tuple containing the elements xs.")
|
||||
},
|
||||
{
|
||||
"tuple/slice", cfun_tuple_slice,
|
||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively. "
|
||||
"'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index '(length arrtup)' to allow a full negative slice range. "
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
"tuple/type", cfun_tuple_type,
|
||||
JDOC("(tuple/type tup)\n\n"
|
||||
"Checks how the tuple was constructed. Will return the keyword "
|
||||
":brackets if the tuple was parsed with brackets, and :parens "
|
||||
"otherwise. The two types of tuples will behave the same most of "
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.")
|
||||
},
|
||||
{
|
||||
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||
JDOC("(tuple/sourcemap tup)\n\n"
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
" which is another tuple (line, column).")
|
||||
},
|
||||
{
|
||||
"tuple/setmap", cfun_tuple_setmap,
|
||||
JDOC("(tuple/setmap tup line column)\n\n"
|
||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
||||
"should be integers.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the tuple module */
|
||||
void janet_lib_tuple(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, tuple_cfuns);
|
||||
JanetRegExt tuple_cfuns[] = {
|
||||
JANET_CORE_REG("tuple/brackets", cfun_tuple_brackets),
|
||||
JANET_CORE_REG("tuple/slice", cfun_tuple_slice),
|
||||
JANET_CORE_REG("tuple/type", cfun_tuple_type),
|
||||
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
|
||||
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, tuple_cfuns);
|
||||
}
|
||||
|
301
src/core/util.c
301
src/core/util.c
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -362,105 +362,208 @@ const void *janet_strbinsearch(
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Register a value in the global registry */
|
||||
void janet_register(const char *name, JanetCFunction cfun) {
|
||||
Janet key = janet_wrap_cfunction(cfun);
|
||||
Janet value = janet_csymbolv(name);
|
||||
janet_table_put(janet_vm_registry, key, value);
|
||||
/* Add sourcemapping and documentation to a binding table */
|
||||
static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) {
|
||||
if (doc) {
|
||||
janet_table_put(table, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
}
|
||||
if (source_file && source_line) {
|
||||
Janet triple[3];
|
||||
triple[0] = janet_cstringv(source_file);
|
||||
triple[1] = janet_wrap_integer(source_line);
|
||||
triple[2] = janet_wrap_integer(1);
|
||||
Janet value = janet_wrap_tuple(janet_tuple_n(triple, 3));
|
||||
janet_table_put(table, janet_ckeywordv("source-map"), value);
|
||||
}
|
||||
}
|
||||
|
||||
/* Add a def to an environment */
|
||||
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), val);
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_add_meta(subt, doc, source_file, source_line);
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
void janet_def(JanetTable *env, const char *name, Janet value, const char *doc) {
|
||||
janet_def_sm(env, name, value, doc, NULL, 0);
|
||||
}
|
||||
|
||||
/* Add a var to the environment */
|
||||
void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
|
||||
JanetArray *array = janet_array(1);
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_array_push(array, val);
|
||||
janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_add_meta(subt, doc, source_file, source_line);
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
|
||||
/* Load many cfunctions at once */
|
||||
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
if (NULL != regprefix) {
|
||||
prefixlen = strlen(regprefix);
|
||||
bufsize = prefixlen + 256;
|
||||
longname_buffer = janet_malloc(bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
safe_memcpy(longname_buffer, regprefix, prefixlen);
|
||||
longname_buffer[prefixlen] = '/';
|
||||
prefixlen++;
|
||||
}
|
||||
while (cfuns->name) {
|
||||
Janet name;
|
||||
if (NULL != regprefix) {
|
||||
int32_t nmlen = 0;
|
||||
while (cfuns->name[nmlen]) nmlen++;
|
||||
int32_t totallen = (int32_t) prefixlen + nmlen;
|
||||
if ((size_t) totallen > bufsize) {
|
||||
bufsize = (size_t)(totallen) + 128;
|
||||
longname_buffer = janet_realloc(longname_buffer, bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
|
||||
} else {
|
||||
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_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
janet_free(longname_buffer);
|
||||
void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
janet_var_sm(env, name, val, doc, NULL, 0);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
|
||||
/* Registry functions */
|
||||
|
||||
/* Put the registry in sorted order. */
|
||||
static void janet_registry_sort(void) {
|
||||
for (size_t i = 1; i < janet_vm.registry_count; i++) {
|
||||
JanetCFunRegistry reg = janet_vm.registry[i];
|
||||
size_t j;
|
||||
for (j = i; j > 0; j--) {
|
||||
if ((void *)(janet_vm.registry[j - 1].cfun) < (void *)(reg.cfun)) break;
|
||||
janet_vm.registry[j] = janet_vm.registry[j - 1];
|
||||
}
|
||||
janet_vm.registry[j] = reg;
|
||||
}
|
||||
janet_vm.registry_dirty = 0;
|
||||
}
|
||||
|
||||
void janet_registry_put(
|
||||
JanetCFunction key,
|
||||
const char *name,
|
||||
const char *name_prefix,
|
||||
const char *source_file,
|
||||
int32_t source_line) {
|
||||
if (janet_vm.registry_count == janet_vm.registry_cap) {
|
||||
size_t newcap = (janet_vm.registry_count + 1) * 2;
|
||||
/* Size it nicely with core by default */
|
||||
if (newcap < 512) {
|
||||
newcap = 512;
|
||||
}
|
||||
void *newmem = janet_realloc(janet_vm.registry, newcap * sizeof(JanetCFunRegistry));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.registry = newmem;
|
||||
janet_vm.registry_cap = newcap;
|
||||
}
|
||||
JanetCFunRegistry value = {
|
||||
key,
|
||||
name,
|
||||
name_prefix,
|
||||
source_file,
|
||||
source_line
|
||||
};
|
||||
janet_vm.registry[janet_vm.registry_count++] = value;
|
||||
janet_vm.registry_dirty = 1;
|
||||
}
|
||||
|
||||
JanetCFunRegistry *janet_registry_get(JanetCFunction key) {
|
||||
if (janet_vm.registry_dirty) {
|
||||
janet_registry_sort();
|
||||
}
|
||||
for (size_t i = 0; i < janet_vm.registry_count; i++) {
|
||||
if (janet_vm.registry[i].cfun == key) {
|
||||
return janet_vm.registry + i;
|
||||
}
|
||||
}
|
||||
JanetCFunRegistry *lo = janet_vm.registry;
|
||||
JanetCFunRegistry *hi = lo + janet_vm.registry_count;
|
||||
while (lo < hi) {
|
||||
JanetCFunRegistry *mid = lo + (hi - lo) / 2;
|
||||
if (mid->cfun == key) {
|
||||
return mid;
|
||||
}
|
||||
if ((void *)(mid->cfun) > (void *)(key)) {
|
||||
hi = mid;
|
||||
} else {
|
||||
lo = mid + 1;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
char *buf;
|
||||
size_t plen;
|
||||
} NameBuf;
|
||||
|
||||
static void namebuf_init(NameBuf *namebuf, const char *prefix) {
|
||||
size_t plen = strlen(prefix);
|
||||
namebuf->plen = plen;
|
||||
namebuf->buf = janet_malloc(namebuf->plen + 256);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(namebuf->buf, prefix, plen);
|
||||
namebuf->buf[plen] = '/';
|
||||
}
|
||||
|
||||
static void namebuf_deinit(NameBuf *namebuf) {
|
||||
janet_free(namebuf->buf);
|
||||
}
|
||||
|
||||
static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
|
||||
size_t slen = strlen(suffix);
|
||||
namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(namebuf->buf + namebuf->plen + 1, suffix, slen);
|
||||
namebuf->buf[namebuf->plen + 1 + slen] = '\0';
|
||||
return (char *)(namebuf->buf);
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
cfuns++;
|
||||
}
|
||||
if (env) namebuf_deinit(&nb);
|
||||
}
|
||||
|
||||
void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
cfuns++;
|
||||
}
|
||||
if (env) namebuf_deinit(&nb);
|
||||
}
|
||||
|
||||
/* Register a value in the global registry */
|
||||
void janet_register(const char *name, JanetCFunction cfun) {
|
||||
janet_registry_put(cfun, name, NULL, NULL, 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);
|
||||
Janet check = janet_table_get(janet_vm.abstract_registry, sym);
|
||||
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
|
||||
janet_panicf("cannot register abstract type %s, "
|
||||
"a type with the same name exists", at->name);
|
||||
}
|
||||
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
janet_table_put(janet_vm.abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
}
|
||||
|
||||
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
|
||||
Janet wrapped = janet_table_get(janet_vm.abstract_registry, key);
|
||||
if (janet_checktype(wrapped, JANET_NIL)) {
|
||||
return NULL;
|
||||
}
|
||||
@ -468,46 +571,82 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
}
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
|
||||
(void) sf;
|
||||
(void) sl;
|
||||
(void) p;
|
||||
Janet key = janet_csymbolv(name);
|
||||
janet_table_put(env, key, x);
|
||||
if (janet_checktype(x, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, x, key);
|
||||
janet_registry_put(janet_unwrap_cfunction(x), name, NULL, NULL, 0);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Resolve a symbol in the environment */
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
|
||||
Janet ref;
|
||||
JanetTable *entry_table;
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
JanetBinding binding = {
|
||||
JANET_BINDING_NONE,
|
||||
janet_wrap_nil(),
|
||||
JANET_BINDING_DEP_NONE
|
||||
};
|
||||
|
||||
/* Check environment for entry */
|
||||
if (!janet_checktype(entry, JANET_TABLE))
|
||||
return JANET_BINDING_NONE;
|
||||
return binding;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
|
||||
/* deprecation check */
|
||||
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
|
||||
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
||||
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
||||
if (!janet_cstrcmp(depkw, "relaxed")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_RELAXED;
|
||||
} else if (!janet_cstrcmp(depkw, "normal")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
} else if (!janet_cstrcmp(depkw, "strict")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_STRICT;
|
||||
}
|
||||
} else if (!janet_checktype(deprecate, JANET_NIL)) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
}
|
||||
|
||||
if (!janet_checktype(
|
||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||
JANET_NIL)) {
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_MACRO;
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_MACRO;
|
||||
return binding;
|
||||
}
|
||||
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
binding.value = ref;
|
||||
binding.type = JANET_BINDING_VAR;
|
||||
return binding;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_DEF;
|
||||
return binding;
|
||||
}
|
||||
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding binding = janet_resolve_ext(env, sym);
|
||||
*out = binding.value;
|
||||
return binding.type;
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the core environment. */
|
||||
@ -728,7 +867,7 @@ void *(janet_malloc)(size_t size) {
|
||||
}
|
||||
|
||||
void (janet_free)(void *ptr) {
|
||||
return janet_free(ptr);
|
||||
janet_free(ptr);
|
||||
}
|
||||
|
||||
void *(janet_calloc)(size_t nmemb, size_t size) {
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,6 +26,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
@ -48,20 +49,16 @@
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define JANET_MARSHAL_DECREF 0x40000
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
} while (0)
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
#define JANET_NO_BOOTSTRAP
|
||||
#else
|
||||
#define JDOC(x) x
|
||||
#endif
|
||||
|
||||
/* Utils */
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
||||
int janet_is_symbol_char(uint8_t c);
|
||||
extern const char janet_base64[65];
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
@ -87,14 +84,29 @@ void janet_buffer_format(
|
||||
Janet *argv);
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||
|
||||
/* Registry functions */
|
||||
void janet_registry_put(
|
||||
JanetCFunction key,
|
||||
const char *name,
|
||||
const char *name_prefix,
|
||||
const char *source_file,
|
||||
int32_t source_line);
|
||||
JanetCFunRegistry *janet_registry_get(JanetCFunction key);
|
||||
|
||||
/* Inside the janet core, defining globals is different
|
||||
* at bootstrap time and normal runtime */
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
#define janet_core_def janet_def
|
||||
#define janet_core_cfuns janet_cfuns
|
||||
#define JANET_CORE_REG JANET_REG
|
||||
#define JANET_CORE_FN JANET_FN
|
||||
#define JANET_CORE_DEF JANET_DEF
|
||||
#define janet_core_def_sm janet_def_sm
|
||||
#define janet_core_cfuns_ext janet_cfuns_ext
|
||||
#else
|
||||
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);
|
||||
#define JANET_CORE_REG JANET_REG_S
|
||||
#define JANET_CORE_FN JANET_FN_S
|
||||
#define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0)
|
||||
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl);
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
|
||||
#endif
|
||||
|
||||
/* Clock gettime */
|
||||
@ -136,9 +148,6 @@ void janet_lib_typed_array(JanetTable *env);
|
||||
#ifdef JANET_INT_TYPES
|
||||
void janet_lib_inttypes(JanetTable *env);
|
||||
#endif
|
||||
#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;
|
||||
|
@ -31,31 +31,28 @@
|
||||
|
||||
#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;
|
||||
int is_new = janet_vm.traversal_base == NULL;
|
||||
if (is_new || (janet_vm.traversal + 1 >= janet_vm.traversal_top)) {
|
||||
size_t oldsize = is_new ? 0 : (janet_vm.traversal - janet_vm.traversal_base);
|
||||
size_t newsize = 2 * oldsize + 1;
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
JanetTraversalNode *tn = janet_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_base = tn;
|
||||
janet_vm.traversal_top = janet_vm.traversal_base + newsize;
|
||||
janet_vm.traversal = janet_vm.traversal_base + oldsize;
|
||||
}
|
||||
*(++janet_vm_traversal) = node;
|
||||
*(++janet_vm.traversal) = node;
|
||||
}
|
||||
|
||||
/*
|
||||
@ -67,8 +64,8 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
* 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) {
|
||||
JanetTraversalNode *t = janet_vm.traversal;
|
||||
while (t && t > janet_vm.traversal_base) {
|
||||
JanetGCObject *self = t->self;
|
||||
JanetTupleHead *tself = (JanetTupleHead *)self;
|
||||
JanetStructHead *sself = (JanetStructHead *)self;
|
||||
@ -81,7 +78,7 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
int32_t index = t->index++;
|
||||
*x = tself->data[index];
|
||||
*y = tother->data[index];
|
||||
janet_vm_traversal = t;
|
||||
janet_vm.traversal = t;
|
||||
return 0;
|
||||
}
|
||||
if (t->index2 && tself->length != tother->length) {
|
||||
@ -94,14 +91,14 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
int32_t index = t->index++;
|
||||
*x = sself->data[index].value;
|
||||
*y = sother->data[index].value;
|
||||
janet_vm_traversal = t;
|
||||
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;
|
||||
janet_vm.traversal = t;
|
||||
return 0;
|
||||
}
|
||||
/* Traverse prototype */
|
||||
@ -112,13 +109,13 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
if (oproto && sproto) {
|
||||
*x = janet_wrap_struct(sproto);
|
||||
*y = janet_wrap_struct(oproto);
|
||||
janet_vm_traversal = t - 1;
|
||||
janet_vm.traversal = t - 1;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
t--;
|
||||
}
|
||||
janet_vm_traversal = t;
|
||||
janet_vm.traversal = t;
|
||||
return 2;
|
||||
}
|
||||
|
||||
@ -207,17 +204,17 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
status == JANET_STATUS_USER4) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
janet_vm_fiber->child = child;
|
||||
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_vm.fiber->child = NULL;
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
}
|
||||
janet_vm_fiber->child = NULL;
|
||||
janet_vm.fiber->child = NULL;
|
||||
if (sig == JANET_SIGNAL_OK ||
|
||||
sig == JANET_SIGNAL_ERROR ||
|
||||
sig == JANET_SIGNAL_USER0 ||
|
||||
@ -250,7 +247,7 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
}
|
||||
|
||||
int janet_equals(Janet x, Janet y) {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
janet_vm.traversal = janet_vm.traversal_base;
|
||||
do {
|
||||
if (janet_type(x) != janet_type(y)) return 0;
|
||||
switch (janet_type(x)) {
|
||||
@ -360,7 +357,7 @@ 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;
|
||||
janet_vm.traversal = janet_vm.traversal_base;
|
||||
int status;
|
||||
do {
|
||||
JanetType tx = janet_type(x);
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
197
src/core/vm.c
197
src/core/vm.c
@ -32,17 +32,6 @@
|
||||
|
||||
#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;
|
||||
|
||||
/* Virtual registers
|
||||
*
|
||||
* One instruction word
|
||||
@ -91,18 +80,18 @@ 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); \
|
||||
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); \
|
||||
janet_vm.return_reg[0] = (val); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
|
||||
/* Next instruction variations */
|
||||
#define maybe_collect() do {\
|
||||
if (janet_vm_next_collection >= janet_vm_gc_interval) janet_collect(); } while (0)
|
||||
if (janet_vm.next_collection >= janet_vm.gc_interval) janet_collect(); } while (0)
|
||||
#define vm_checkgc_next() maybe_collect(); vm_next()
|
||||
#define vm_pcnext() pc++; vm_next()
|
||||
#define vm_checkgc_pcnext() maybe_collect(); vm_pcnext()
|
||||
@ -122,6 +111,17 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
janet_panicf("expected %T, got %v", (TS), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
#ifdef JANET_NO_INTERPRETER_INTERRUPT
|
||||
#define vm_maybe_auto_suspend(COND)
|
||||
#else
|
||||
#define vm_maybe_auto_suspend(COND) do { \
|
||||
if ((COND) && janet_vm.auto_suspend) { \
|
||||
janet_vm.auto_suspend = 0; \
|
||||
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
|
||||
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
|
||||
} \
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
/* Templates for certain patterns in opcodes */
|
||||
#define vm_binop_immediate(op)\
|
||||
@ -591,7 +591,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
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;
|
||||
janet_vm.return_reg[0] = in;
|
||||
return sig;
|
||||
}
|
||||
|
||||
@ -757,11 +757,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_JUMP)
|
||||
pc += DS;
|
||||
vm_maybe_auto_suspend(DS < 0);
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF)
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@ -772,12 +774,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@ -788,6 +792,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
@ -961,6 +966,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_checkgc_pcnext();
|
||||
|
||||
VM_OP(JOP_CALL) {
|
||||
vm_maybe_auto_suspend(1);
|
||||
Janet callee = stack[E];
|
||||
if (fiber->stacktop > fiber->maxstack) {
|
||||
vm_throw("stack overflow");
|
||||
@ -1000,6 +1006,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
|
||||
VM_OP(JOP_TAILCALL) {
|
||||
vm_maybe_auto_suspend(1);
|
||||
Janet callee = stack[D];
|
||||
if (fiber->stacktop > fiber->maxstack) {
|
||||
vm_throw("stack overflow");
|
||||
@ -1046,6 +1053,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_RESUME) {
|
||||
Janet retreg;
|
||||
vm_maybe_auto_suspend(1);
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
@ -1279,9 +1287,9 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
|
||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Check entry conditions */
|
||||
if (!janet_vm_fiber)
|
||||
if (!janet_vm.fiber)
|
||||
janet_panic("janet_call failed because there is no current fiber");
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
|
||||
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Tracing */
|
||||
@ -1290,8 +1298,8 @@ 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)) {
|
||||
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);
|
||||
@ -1301,31 +1309,31 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
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_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_frame(janet_vm.fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
|
||||
/* Set up */
|
||||
int32_t oldn = janet_vm_stackn++;
|
||||
int32_t oldn = janet_vm.stackn++;
|
||||
int handle = janet_gclock();
|
||||
|
||||
/* Run vm */
|
||||
janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
|
||||
janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
|
||||
|
||||
/* Teardown */
|
||||
janet_vm_stackn = oldn;
|
||||
janet_vm.stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm_return_reg);
|
||||
janet_panicv(*janet_vm.return_reg);
|
||||
}
|
||||
|
||||
return *janet_vm_return_reg;
|
||||
return *janet_vm.return_reg;
|
||||
}
|
||||
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
||||
if (janet_vm.stackn >= JANET_RECURSION_GUARD) {
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||
*out = janet_cstringv("C stack recursed too deeply");
|
||||
return JANET_SIGNAL_ERROR;
|
||||
@ -1343,21 +1351,21 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
}
|
||||
|
||||
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);
|
||||
state->stackn = janet_vm.stackn++;
|
||||
state->gc_handle = janet_vm.gc_suspend;
|
||||
state->vm_fiber = janet_vm.fiber;
|
||||
state->vm_jmp_buf = janet_vm.signal_buf;
|
||||
state->vm_return_reg = janet_vm.return_reg;
|
||||
janet_vm.return_reg = &(state->payload);
|
||||
janet_vm.signal_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;
|
||||
janet_vm.stackn = state->stackn;
|
||||
janet_vm.gc_suspend = state->gc_handle;
|
||||
janet_vm.fiber = state->vm_fiber;
|
||||
janet_vm.signal_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) {
|
||||
@ -1373,13 +1381,13 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
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++;
|
||||
janet_vm.stackn++;
|
||||
JanetSignal sig = janet_continue(child, in, &in);
|
||||
janet_vm_stackn--;
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
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);
|
||||
@ -1425,14 +1433,14 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
JanetSignal sig = janet_try(&tstate);
|
||||
if (!sig) {
|
||||
/* Normal setup */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
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);
|
||||
}
|
||||
|
||||
/* Restore */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
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;
|
||||
@ -1485,7 +1493,9 @@ JanetSignal janet_pcall(
|
||||
|
||||
Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
if (argc < 1) {
|
||||
janet_panicf("method :%s expected at least 1 argument", name);
|
||||
}
|
||||
/* Find method */
|
||||
Janet method = janet_method_lookup(argv[0], name);
|
||||
if (janet_checktype(method, JANET_NIL)) {
|
||||
@ -1497,42 +1507,58 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
|
||||
/* Setup VM */
|
||||
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;
|
||||
janet_vm.blocks = NULL;
|
||||
janet_vm.next_collection = 0;
|
||||
janet_vm.gc_interval = 0x400000;
|
||||
janet_vm.block_count = 0;
|
||||
|
||||
janet_symcache_init();
|
||||
|
||||
/* Initialize gc roots */
|
||||
janet_vm_roots = NULL;
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
janet_vm.roots = NULL;
|
||||
janet_vm.root_count = 0;
|
||||
janet_vm.root_capacity = 0;
|
||||
|
||||
/* Scratch memory */
|
||||
janet_scratch_mem = NULL;
|
||||
janet_scratch_len = 0;
|
||||
janet_scratch_cap = 0;
|
||||
janet_vm.user = NULL;
|
||||
janet_vm.scratch_mem = NULL;
|
||||
janet_vm.scratch_len = 0;
|
||||
janet_vm.scratch_cap = 0;
|
||||
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_vm_abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
janet_vm.registry = NULL;
|
||||
janet_vm.registry_cap = 0;
|
||||
janet_vm.registry_count = 0;
|
||||
janet_vm.registry_dirty = 0;
|
||||
|
||||
/* Intialize abstract registry */
|
||||
janet_vm.abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
|
||||
|
||||
/* Traversal */
|
||||
janet_vm_traversal = NULL;
|
||||
janet_vm_traversal_base = NULL;
|
||||
janet_vm_traversal_top = NULL;
|
||||
janet_vm.traversal = NULL;
|
||||
janet_vm.traversal_base = NULL;
|
||||
janet_vm.traversal_top = NULL;
|
||||
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm.core_env = NULL;
|
||||
|
||||
/* Auto suspension */
|
||||
janet_vm.auto_suspend = 0;
|
||||
|
||||
/* Dynamic bindings */
|
||||
janet_vm_top_dyns = NULL;
|
||||
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;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
#endif
|
||||
janet_vm.fiber = NULL;
|
||||
janet_vm.root_fiber = NULL;
|
||||
janet_vm.stackn = 0;
|
||||
|
||||
#ifdef JANET_EV
|
||||
janet_ev_init();
|
||||
#endif
|
||||
@ -1546,20 +1572,19 @@ int janet_init(void) {
|
||||
void janet_deinit(void) {
|
||||
janet_clear_memory();
|
||||
janet_symcache_deinit();
|
||||
janet_free(janet_vm_roots);
|
||||
janet_vm_roots = NULL;
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm_top_dyns = NULL;
|
||||
janet_free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
janet_free(janet_vm.roots);
|
||||
janet_vm.roots = NULL;
|
||||
janet_vm.root_count = 0;
|
||||
janet_vm.root_capacity = 0;
|
||||
janet_vm.abstract_registry = NULL;
|
||||
janet_vm.core_env = NULL;
|
||||
janet_vm.top_dyns = NULL;
|
||||
janet_vm.user = NULL;
|
||||
janet_free(janet_vm.traversal_base);
|
||||
janet_vm.fiber = NULL;
|
||||
janet_vm.root_fiber = NULL;
|
||||
janet_free(janet_vm.registry);
|
||||
janet_vm.registry = NULL;
|
||||
#ifdef JANET_EV
|
||||
janet_ev_deinit();
|
||||
#endif
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -163,7 +163,7 @@ Janet(janet_wrap_number)(double x) {
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
|
||||
janet_vm.next_collection += (size_t) count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -145,16 +145,17 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Define how global janet state is declared */
|
||||
/* Also enable the thread library only if not single-threaded */
|
||||
#ifdef JANET_SINGLE_THREADED
|
||||
#define JANET_THREAD_LOCAL
|
||||
#undef JANET_THREADS
|
||||
#elif defined(__GNUC__)
|
||||
#define JANET_THREAD_LOCAL __thread
|
||||
#define JANET_THREADS
|
||||
#elif defined(_MSC_BUILD)
|
||||
#define JANET_THREAD_LOCAL __declspec(thread)
|
||||
#define JANET_THREADS
|
||||
#else
|
||||
#define JANET_THREAD_LOCAL
|
||||
#undef JANET_THREADS
|
||||
#endif
|
||||
|
||||
/* Enable or disable dynamic module loading. Enabled by default. */
|
||||
@ -172,11 +173,6 @@ extern "C" {
|
||||
#define JANET_PEG
|
||||
#endif
|
||||
|
||||
/* Enable or disable the typedarray module */
|
||||
#ifndef JANET_NO_TYPED_ARRAY
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable event loop */
|
||||
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_EV
|
||||
@ -192,6 +188,21 @@ extern "C" {
|
||||
#define JANET_INT_TYPES
|
||||
#endif
|
||||
|
||||
/* Enable or disable epoll on Linux */
|
||||
#if defined(JANET_LINUX) && !defined(JANET_EV_NO_EPOLL)
|
||||
#define JANET_EV_EPOLL
|
||||
#endif
|
||||
|
||||
/* Enable or disable kqueue on BSD */
|
||||
#if defined(JANET_BSD) && !defined(JANET_EV_NO_KQUEUE)
|
||||
#define JANET_EV_KQUEUE
|
||||
#endif
|
||||
|
||||
/* Enable or disable kqueue on Apple */
|
||||
#if defined(JANET_APPLE) && !defined(JANET_EV_NO_KQUEUE)
|
||||
#define JANET_EV_KQUEUE
|
||||
#endif
|
||||
|
||||
/* How to export symbols */
|
||||
#ifndef JANET_API
|
||||
#ifdef JANET_WINDOWS
|
||||
@ -299,9 +310,10 @@ typedef struct {
|
||||
/***** START SECTION TYPES *****/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
// Must be defined before including stdlib.h
|
||||
/* Must be defined before including stdlib.h */
|
||||
#define _CRT_RAND_S
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
@ -310,6 +322,25 @@ typedef struct {
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* Some extra includes if EV is enabled */
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef struct JanetDudCriticalSection {
|
||||
/* Avoid including windows.h here - instead, create a structure of the same size */
|
||||
/* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
|
||||
void *debug_info;
|
||||
long lock_count;
|
||||
long recursion_count;
|
||||
void *owning_thread;
|
||||
void *lock_semaphore;
|
||||
unsigned long spin_count;
|
||||
} JanetOSMutex;
|
||||
#else
|
||||
#include <pthread.h>
|
||||
typedef pthread_mutex_t JanetOSMutex;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_BSD
|
||||
int _setjmp(jmp_buf);
|
||||
JANET_NO_RETURN void _longjmp(jmp_buf, int);
|
||||
@ -348,6 +379,7 @@ typedef enum {
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
@ -369,6 +401,9 @@ typedef enum {
|
||||
JANET_STATUS_ALIVE
|
||||
} JanetFiberStatus;
|
||||
|
||||
/* For encapsulating all thread-local Janet state (except natives) */
|
||||
typedef struct JanetVM JanetVM;
|
||||
|
||||
/* Use type punning for GC objects */
|
||||
typedef struct JanetGCObject JanetGCObject;
|
||||
|
||||
@ -392,6 +427,7 @@ typedef struct JanetKV JanetKV;
|
||||
typedef struct JanetStackFrame JanetStackFrame;
|
||||
typedef struct JanetAbstractType JanetAbstractType;
|
||||
typedef struct JanetReg JanetReg;
|
||||
typedef struct JanetRegExt JanetRegExt;
|
||||
typedef struct JanetMethod JanetMethod;
|
||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||
typedef struct JanetView JanetView;
|
||||
@ -827,7 +863,10 @@ JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at
|
||||
* list of blocks, which is naive but works. */
|
||||
struct JanetGCObject {
|
||||
int32_t flags;
|
||||
JanetGCObject *next;
|
||||
union {
|
||||
JanetGCObject *next;
|
||||
int32_t refcount; /* For threaded abstract types */
|
||||
} data;
|
||||
};
|
||||
|
||||
/* A lightweight green thread in janet. Does not correspond to
|
||||
@ -1083,6 +1122,14 @@ struct JanetReg {
|
||||
const char *documentation;
|
||||
};
|
||||
|
||||
struct JanetRegExt {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
const char *documentation;
|
||||
const char *source_file;
|
||||
int32_t source_line;
|
||||
};
|
||||
|
||||
struct JanetMethod {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
@ -1268,10 +1315,36 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
#ifdef JANET_EV
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_stream_type;
|
||||
extern JANET_API const JanetAbstractType janet_channel_type;
|
||||
|
||||
/* Run the event loop */
|
||||
JANET_API void janet_loop(void);
|
||||
|
||||
/* Run the event loop, but allow for user scheduled interrupts triggered
|
||||
* by janet_loop1_interrupt being called in library code, a signal handler, or
|
||||
* another thread.
|
||||
*
|
||||
* Example:
|
||||
*
|
||||
* while (!janet_loop_done()) {
|
||||
* // One turn of the event loop
|
||||
* JanetFiber *interrupted_fiber = janet_loop1();
|
||||
* // interrupted_fiber may be NULL
|
||||
* // do some work here periodically...
|
||||
* if (NULL != interrupted_fiber) {
|
||||
* if (cancel_interrupted_fiber) {
|
||||
* janet_cancel(interrupted_fiber, janet_cstringv("fiber was interrupted for [reason]"));
|
||||
* } else {
|
||||
* janet_schedule(interrupted_fiber, janet_wrap_nil());
|
||||
* }
|
||||
* }
|
||||
* }
|
||||
*
|
||||
*/
|
||||
JANET_API int janet_loop_done(void);
|
||||
JANET_API JanetFiber *janet_loop1(void);
|
||||
JANET_API void janet_loop1_interrupt(JanetVM *vm);
|
||||
|
||||
/* Wrapper around streams */
|
||||
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
|
||||
JANET_API void janet_stream_close(JanetStream *stream);
|
||||
@ -1299,7 +1372,20 @@ 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 */
|
||||
/* Thread aware abstract types and helpers */
|
||||
JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
|
||||
JANET_API void *janet_abstract_end_threaded(void *x);
|
||||
JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
|
||||
JANET_API int32_t janet_abstract_incref(void *abst);
|
||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||
|
||||
/* Expose some OS sync primitives to make portable abstract types easier to implement */
|
||||
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex);
|
||||
|
||||
/* Get last error from 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
|
||||
@ -1313,6 +1399,7 @@ typedef struct {
|
||||
int tag;
|
||||
int argi;
|
||||
void *argp;
|
||||
Janet argj;
|
||||
JanetFiber *fiber;
|
||||
} JanetEVGenericMessage;
|
||||
|
||||
@ -1335,13 +1422,20 @@ typedef struct {
|
||||
/* 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 */
|
||||
/* Handler for events posted to the event loop */
|
||||
typedef void (*JanetCallback)(JanetEVGenericMessage return_value);
|
||||
|
||||
/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine (same as JanetCallback) */
|
||||
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);
|
||||
|
||||
/* Post callback + userdata to an event loop. Takes the vm parameter to allow posting from other
|
||||
* threads or signal handlers. Use NULL to post to the current thread. */
|
||||
JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage msg);
|
||||
|
||||
/* Callback used by janet_ev_threaded_await */
|
||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
|
||||
@ -1410,16 +1504,26 @@ struct JanetCompileResult {
|
||||
enum JanetCompileStatus status;
|
||||
};
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
|
||||
JANET_API JanetCompileResult janet_compile_lint(
|
||||
Janet source,
|
||||
JanetTable *env,
|
||||
JanetString where,
|
||||
JanetArray *lints);
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
/* Execute strings */
|
||||
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);
|
||||
|
||||
/* Run the entrypoint of a wrapped program */
|
||||
JANET_API int janet_loop_fiber(JanetFiber *fiber);
|
||||
|
||||
/* Number scanning */
|
||||
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
||||
JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
|
||||
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
|
||||
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
@ -1436,6 +1540,7 @@ JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
|
||||
JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
|
||||
JANET_API double janet_rng_double(JanetRNG *rng);
|
||||
|
||||
/* Array functions */
|
||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||
@ -1529,6 +1634,7 @@ JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
/* Table functions */
|
||||
JANET_API JanetTable *janet_table(int32_t capacity);
|
||||
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
|
||||
JANET_API JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity);
|
||||
JANET_API void janet_table_deinit(JanetTable *table);
|
||||
JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
|
||||
@ -1644,6 +1750,12 @@ JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *i
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
JANET_API void janet_deinit(void);
|
||||
JANET_API JanetVM *janet_vm_alloc(void);
|
||||
JANET_API JanetVM *janet_local_vm(void);
|
||||
JANET_API void janet_vm_free(JanetVM *vm);
|
||||
JANET_API void janet_vm_save(JanetVM *into);
|
||||
JANET_API void janet_vm_load(JanetVM *from);
|
||||
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
||||
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);
|
||||
@ -1668,12 +1780,24 @@ typedef enum {
|
||||
JANET_BINDING_VAR,
|
||||
JANET_BINDING_MACRO
|
||||
} JanetBindingType;
|
||||
|
||||
typedef struct {
|
||||
JanetBindingType type;
|
||||
Janet value;
|
||||
enum {
|
||||
JANET_BINDING_DEP_NONE,
|
||||
JANET_BINDING_DEP_RELAXED,
|
||||
JANET_BINDING_DEP_NORMAL,
|
||||
JANET_BINDING_DEP_STRICT,
|
||||
} deprecation;
|
||||
} JanetBinding;
|
||||
|
||||
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);
|
||||
JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
|
||||
|
||||
/* Get values from the core environment. */
|
||||
JANET_API Janet janet_resolve_core(const char *name);
|
||||
@ -1683,6 +1807,70 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
/* Shorthand for janet C function declarations */
|
||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||
|
||||
/* Declare a C function with documentation and source mapping */
|
||||
#define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
|
||||
|
||||
/* no docstrings or sourcemaps */
|
||||
#define JANET_REG_(JNAME, CNAME) {JNAME, CNAME, NULL, NULL, 0}
|
||||
#define JANET_FN_(CNAME, USAGE, DOCSTRING) \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_(ENV, JNAME, VAL, DOC) \
|
||||
janet_def(ENV, JNAME, VAL, NULL)
|
||||
|
||||
/* sourcemaps only */
|
||||
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
|
||||
static int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
|
||||
|
||||
/* docstring only */
|
||||
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
|
||||
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
|
||||
janet_def(ENV, JNAME, VAL, DOC)
|
||||
|
||||
/* sourcemaps and docstrings */
|
||||
#define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
|
||||
static int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
|
||||
|
||||
|
||||
/* Choose defaults for source mapping and docstring based on config defs */
|
||||
#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
|
||||
#define JANET_REG JANET_REG_
|
||||
#define JANET_FN JANET_FN_
|
||||
#define JANET_DEF JANET_DEF_
|
||||
#elif defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS)
|
||||
#define JANET_REG JANET_REG_D
|
||||
#define JANET_FN JANET_FN_D
|
||||
#define JANET_DEF JANET_DEF_D
|
||||
#elif !defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
|
||||
#define JANET_REG JANET_REG_S
|
||||
#define JANET_FN JANET_FN_S
|
||||
#define JANET_DEF JANET_DEF_S
|
||||
#elif !defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS)
|
||||
#define JANET_REG JANET_REG_SD
|
||||
#define JANET_FN JANET_FN_SD
|
||||
#define JANET_DEF JANET_DEF_SD
|
||||
#endif
|
||||
|
||||
/* Define things with source mapping information */
|
||||
JANET_API void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
|
||||
JANET_API void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
|
||||
JANET_API void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line);
|
||||
JANET_API void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line);
|
||||
|
||||
/* Legacy definition of C functions */
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
#ifdef __cplusplus
|
||||
#define JANET_MODULE_PREFIX extern "C"
|
||||
@ -1812,6 +2000,7 @@ JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
|
||||
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
@ -1852,7 +2041,8 @@ typedef enum {
|
||||
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
|
||||
RULE_LINE, /* [tag] */
|
||||
RULE_COLUMN, /* [tag] */
|
||||
RULE_UNREF /* [rule, tag] */
|
||||
RULE_UNREF, /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM /* [rule, tag] */
|
||||
} JanetPegOpcod;
|
||||
|
||||
typedef struct {
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@ -1021,7 +1021,6 @@ int main(int argc, char **argv) {
|
||||
janet_init_hash_key(hash_key);
|
||||
#endif
|
||||
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
@ -1048,18 +1047,8 @@ int main(int argc, char **argv) {
|
||||
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) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
#endif
|
||||
/* Run the fiber in an event loop */
|
||||
status = janet_loop_fiber(fiber);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
10
test/install/.gitignore
vendored
10
test/install/.gitignore
vendored
@ -1,10 +0,0 @@
|
||||
/build
|
||||
/modpath
|
||||
.cache
|
||||
.manifests
|
||||
json.*
|
||||
jhydro.*
|
||||
circlet.*
|
||||
argparse.*
|
||||
sqlite3.*
|
||||
path.*
|
@ -1,26 +0,0 @@
|
||||
(declare-project
|
||||
:name "testmod")
|
||||
|
||||
(declare-native
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
|
||||
(declare-native
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod5"
|
||||
:source @["testmod5.cc"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
:entry "testexec.janet")
|
@ -1,3 +0,0 @@
|
||||
(import /build/testmod :as testmod)
|
||||
|
||||
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
@ -1,9 +0,0 @@
|
||||
(use /build/testmod)
|
||||
(use /build/testmod2)
|
||||
(use /build/testmod3)
|
||||
(use /build/test-mod-4)
|
||||
(use /build/testmod5)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (+ (get5) (get6) (get7) (get8) (get9))))
|
@ -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_six(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(6.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get6", cfun_get_six, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
@ -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);
|
||||
}
|
@ -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);
|
||||
}
|
@ -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_nine(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
std::cout << "Hello!" << std::endl;
|
||||
return janet_wrap_number(9.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get9", cfun_get_nine, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
@ -202,6 +202,7 @@
|
||||
|
||||
#🐙🐙🐙🐙
|
||||
|
||||
(defn foo [Θa Θb Θc] 0)
|
||||
(def 🦊 :fox)
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
|
@ -1,4 +1,4 @@
|
||||
#' Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# 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
|
||||
@ -51,7 +51,10 @@
|
||||
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
|
||||
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
|
||||
(assert (deep= (take -1 [:a :b :c]) []) "take 5")
|
||||
(assert-error :invalid-type (take 3 {}) "take 6")
|
||||
(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3]) "take from fiber")
|
||||
# NB: repeatedly resuming a fiber created with `generate` includes a `nil` as
|
||||
# the final element. Thus a generate of 2 elements will create an array of 3.
|
||||
(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2) "take from short fiber")
|
||||
|
||||
# take-until
|
||||
|
||||
@ -61,6 +64,8 @@
|
||||
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
|
||||
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
|
||||
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
|
||||
(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
|
||||
@[98 111 111 107]) "take-until from fiber")
|
||||
|
||||
# take-while
|
||||
|
||||
@ -69,6 +74,8 @@
|
||||
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
|
||||
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
|
||||
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
|
||||
(assert (deep= (take-while neg? (generate [x :in @[-1 1 -2]] x))
|
||||
@[-1]) "take-while from fiber")
|
||||
|
||||
# drop
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# 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
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# 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
|
||||
@ -311,4 +311,6 @@
|
||||
(tracev (def my-unique-var-name true))
|
||||
(assert my-unique-var-name "tracev upscopes")
|
||||
|
||||
(assert (pos? (length (gensym))) "gensym not empty, regression #753")
|
||||
|
||||
(end-suite)
|
||||
|
@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# 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
|
||||
@ -344,4 +344,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(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")
|
||||
|
||||
# number pattern
|
||||
(assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1")
|
||||
(assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2")
|
||||
|
||||
(end-suite)
|
||||
|
@ -47,6 +47,11 @@
|
||||
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
|
||||
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
||||
# Parallel subprocesses
|
||||
|
||||
(defn calc-1
|
||||
@ -100,6 +105,17 @@
|
||||
(file/close outfile)
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# Ensure that the stream created by os/open works
|
||||
|
||||
(assert-no-error "File writing 4.1"
|
||||
(def outstream (os/open "unique.txt" :wct))
|
||||
(defer (:close outstream)
|
||||
(:write outstream "123\n")
|
||||
(:write outstream "456\n"))
|
||||
# Cast to string to enable comparison
|
||||
(assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# ev/gather
|
||||
|
||||
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
|
||||
@ -135,6 +151,38 @@
|
||||
|
||||
(:close s))
|
||||
|
||||
# Test localname and peername
|
||||
(repeat 20
|
||||
|
||||
(defn check-matching-names [stream]
|
||||
(def [my-ip my-port] (net/localname stream))
|
||||
(def [remote-ip remote-port] (net/peername stream))
|
||||
(def msg (string my-ip " " my-port " " remote-ip " " remote-port))
|
||||
(def buf @"")
|
||||
(ev/gather
|
||||
(net/write stream msg)
|
||||
(net/read stream 1024 buf))
|
||||
(def comparison (string/split " " buf))
|
||||
(assert (and (= my-ip (get comparison 2))
|
||||
(= (string my-port) (get comparison 3))
|
||||
(= remote-ip (get comparison 0))
|
||||
(= (string remote-port) (get comparison 1)))
|
||||
"localname should match peername"))
|
||||
|
||||
# Test on both server and client
|
||||
(defn names-handler
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(check-matching-names stream)))
|
||||
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
||||
(defn test-names []
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(check-matching-names conn)))
|
||||
(test-names)
|
||||
(test-names))
|
||||
|
||||
(gccollect))
|
||||
|
||||
# Create pipe
|
||||
|
||||
(var pipe-counter 0)
|
||||
@ -163,4 +211,46 @@
|
||||
|
||||
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
|
||||
# Test some channel
|
||||
|
||||
(def c1 (ev/chan))
|
||||
(def c2 (ev/chan))
|
||||
(def arr @[])
|
||||
(ev/spawn
|
||||
(while (def x (ev/take c1))
|
||||
(array/push arr x))
|
||||
(ev/chan-close c2))
|
||||
(for i 0 1000
|
||||
(ev/give c1 i))
|
||||
(ev/chan-close c1)
|
||||
(ev/take c2)
|
||||
(assert (= (slice arr) (slice (range 1000))) "ev/chan-close 1")
|
||||
|
||||
(def c1 (ev/chan))
|
||||
(def c2 (ev/chan))
|
||||
(def arr @[])
|
||||
(ev/spawn
|
||||
(while (def x (ev/take c1))
|
||||
(array/push arr x))
|
||||
(ev/sleep 0.1)
|
||||
(ev/chan-close c2))
|
||||
(for i 0 100
|
||||
(ev/give c1 i))
|
||||
(ev/chan-close c1)
|
||||
(ev/select c2)
|
||||
(assert (= (slice arr) (slice (range 100))) "ev/chan-close 2")
|
||||
|
||||
(def c1 (ev/chan))
|
||||
(def c2 (ev/chan))
|
||||
(def arr @[])
|
||||
(ev/spawn
|
||||
(while (def x (ev/take c1))
|
||||
(array/push arr x))
|
||||
(ev/chan-close c2))
|
||||
(for i 0 100
|
||||
(ev/give c1 i))
|
||||
(ev/chan-close c1)
|
||||
(ev/rselect c2)
|
||||
(assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
|
||||
|
||||
(end-suite)
|
||||
|
@ -1,4 +1,4 @@
|
||||
#- Copyright (c) 2020 Calvin Rose & contributors
|
||||
# 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
|
||||
@ -161,10 +161,14 @@
|
||||
([err] :caught))))
|
||||
"regression #638"))
|
||||
|
||||
|
||||
# Struct prototypes
|
||||
(def x (struct/with-proto {1 2 3 4} 5 6))
|
||||
(def y (-> x marshal unmarshal))
|
||||
(def z {1 2 3 4})
|
||||
(assert (= 2 (get x 1)) "struct get proto value 1")
|
||||
(assert (= 4 (get x 3)) "struct get proto value 2")
|
||||
(assert (= 6 (get x 5)) "struct get proto value 3")
|
||||
(assert (= x y) "struct proto marshal equality 1")
|
||||
(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
|
||||
(assert (= 0 (cmp x y)) "struct proto comparison 1")
|
||||
@ -179,4 +183,13 @@
|
||||
(assert (deep-not= x z) "struct proto deep= 2")
|
||||
(assert (deep-not= y z) "struct proto deep= 3")
|
||||
|
||||
# Issue #751
|
||||
(def t {:side false})
|
||||
(assert (nil? (get-in t [:side :note])) "get-in with false value")
|
||||
(assert (= (get-in t [:side :note] "dflt") "dflt")
|
||||
"get-in with false value and default")
|
||||
|
||||
(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
|
||||
(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
|
||||
|
||||
(end-suite)
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user