1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-07 19:13:02 +00:00

Compare commits

..

126 Commits

Author SHA1 Message Date
Calvin Rose
358f5a03bf Version bump to 1.28.0 2023-05-13 09:59:55 -05:00
Calvin Rose
fba1fdabe4 Update short-fn to fix #1123
Symbols are renamed on expansion to avoid the issue.
2023-05-13 09:44:30 -05:00
Calvin Rose
d42afd21e5 Merge branch 'master' of github.com:janet-lang/janet 2023-05-12 19:08:35 -05:00
Calvin Rose
20ada86761 Fix NAN typo. 2023-05-12 19:08:26 -05:00
Calvin Rose
3b353f1855 Merge pull request #1133 from zevv/cross
Updated Makefile for better cross-compilation support.
2023-05-12 08:41:54 -05:00
Calvin Rose
1467ab4f93 Copy paste error. 2023-05-11 20:56:12 -05:00
Calvin Rose
7e65c2bdad Fix #1130 - mod flipped for signed integers. 2023-05-11 18:15:37 -05:00
Calvin Rose
84a4e3e98a Update CHANGELOG.
and format.
2023-05-11 18:03:38 -05:00
Calvin Rose
bcbeedb001 Merge pull request #1128 from zevv/master
Added os.strftime()
2023-05-11 18:01:39 -05:00
Calvin Rose
e04b103b5d Merge pull request #1134 from CosmicToast/const_sourceline
Make JANET_FN_S* sourceline const
2023-05-11 17:59:27 -05:00
Chloe Kudryavtsev
ac75b94679 Make JANET_FN_S* sourceline const
Otherwise attempts to use it on some platforms cause the following error
`error: initializer element is not a compile-time constant`
when attempting to use the corresponding `JANET_REG`.
2023-05-11 16:07:34 -04:00
Ico Doornekamp
d3bb06cfd6 Updated Makefile for better cross-compilation support.
Building janet requires janet_boot to be run on the host at build time;

- $(UNAME) can now be overridden from the make cmdline
- Added $(RUN) variable to allow a emulator to be specified
- Added ".exe" extension to binaries when using MINGW

Examples:

Cross compiling for win32 and running under wine:

```
make test \
       CC=i686-w64-mingw32-gcc \
       LD=i686-w64-mingw32-gcc \
       UNAME=MINGW \
       RUN=wine

Janet 1.27.0-ad7c3bed mingw/x86/gcc - '(doc)' for help
```

Cross compiling for aarch64 and running under qemu:

```
make repl \
        CC=aarch64-none-linux-gnu-gcc \
        LD=aarch64-none-linux-gnu-gcc \
        RUN="qemu-aarch64 -L /tmp/aarch64/"

Janet 1.27.0-ad7c3bed linux/aarch64/gcc - '(doc)' for help
```
2023-05-11 07:46:36 +02:00
Ico Doornekamp
5cd729c4c1 Added os.strftime() 2023-05-11 06:08:19 +02:00
Calvin Rose
c9fd2bdf39 Merge branch 'master' of github.com:janet-lang/janet 2023-05-10 18:46:42 -05:00
Calvin Rose
e4be5992b3 Address issue with #1131 2023-05-10 18:43:33 -05:00
Calvin Rose
2ac4988f1b Merge pull request #1124 from sogaiu/tweak-ev-select-docstring
Tweak ev/select docstring
2023-05-08 04:17:25 -05:00
Calvin Rose
19f14adb9e Update changelog. 2023-05-07 21:07:22 -05:00
Calvin Rose
86de039492 Merge branch 'master' of github.com:janet-lang/janet 2023-05-07 11:54:20 -05:00
Calvin Rose
2360164e4f Address #1125 - fix ev/select to only take and release locks once.
By take and releasing locks twice per channel in the case where nothing
is reading, there was an opportunity for ev/select to hang in the
multithreaded case. Also silence valgrind/helgrind errors.
2023-05-07 11:54:06 -05:00
Calvin Rose
c93ddceadb Merge pull request #1122 from CosmicToast/getcbytes
Add get/opt cbytes
2023-05-07 10:33:09 -05:00
sogaiu
cd19dec44a Tweak ev/select docstring 2023-05-07 22:22:33 +09:00
Chloe Kudryavtsev
53ba9c800a Add get/opt cbytes
Like getcstring, but operates on a byteview.
When writing bindings (i.e what capi.c is primarily used for), it's
common to want to accept a buffer *or* a string rather than just
a string.
For this, a byteview is perfect (and why not accept keywords while
you're at it?).
However, there's no built-in function for getting a cstring out of
a byteview, this adds one.
This also reformulates getcstring to be an edge-case of getcbytes
(simply adding an explicit check for stringness).
2023-05-06 22:13:53 -04:00
Calvin Rose
cabbaded68 Add support for the NO_COLOR environment variable. 2023-05-06 16:33:45 -05:00
Calvin Rose
9bb589f827 update readme 2023-05-06 15:56:27 -05:00
Calvin Rose
c3a06686c2 Merge branch 'shell-win-feature-check' 2023-05-06 15:53:02 -05:00
Calvin Rose
7d57f87007 Address #1121 - disallow extra splices.
This turns splices that are ignored into compiler errors. Other
alternatives here should also be considered, for example making this
a compiler warning rather than an error. For example, the latest
spork as of a3ee63c137ee3234987dbbca71b566994ff8ae8c has an error of this
kind, but the resulting program does work correctly.

Also disallow splice propagation - code of the
form (+ 1 (do ;[2 3 4]) 5).
2023-05-06 13:12:31 -05:00
Calvin Rose
4cc4a9d38b (and ... <truthy-value> true) will return true as per docs. 2023-05-06 10:16:05 -05:00
Calvin Rose
02c7cd0194 Merge pull request #1116 from sogaiu/tweak-long-string-peg
Tweak long-string|bytes peg in test suite files
2023-04-30 16:21:12 -05:00
Calvin Rose
696efcb9e2 Add header file. 2023-04-30 12:19:55 -05:00
Calvin Rose
6e9cde8ac1 Add feature check for windows version shell.c
Tried to get console working on windows 7 and below
2023-04-30 10:36:42 -05:00
sogaiu
a9fae49671 Tweak long-string|bytes peg in test suite files 2023-04-30 21:55:43 +09:00
Calvin Rose
440af9fd64 Remove extra allocation in drop. 2023-04-24 09:41:33 -05:00
Calvin Rose
347721ae40 Fix macos behavior - Closes #1097, Fixes #1015 2023-04-24 09:37:49 -05:00
Calvin Rose
daea91044c Give different names to the user9 and user8 fiber statuses.
These now have semantic menaings that are pretty difficult to
work around. Code that tries to maniuplate user8 and user9 signals
right now may be affected
2023-04-24 09:19:15 -05:00
Calvin Rose
4ed3f2c662 Merge pull request #1114 from ianthehenry/drop-from-end
drop with a negative count now drops from the end
2023-04-24 09:16:10 -05:00
Calvin Rose
3641c8f60a Merge pull request #1108 from wackbyte/read
README grammar and formatting changes
2023-04-24 09:15:07 -05:00
Calvin Rose
e4b68cd940 Merge pull request #1109 from wackbyte/remove-double-space
Remove double space in help message
2023-04-24 09:11:45 -05:00
Calvin Rose
b8c936e2fe Merge pull request #1113 from ianthehenry/catseq
add catseq
2023-04-24 09:07:38 -05:00
Calvin Rose
83cd519702 Merge pull request #1112 from ianthehenry/dynamic-replace
string and peg replacement functions can now take functions
2023-04-24 09:07:03 -05:00
Ian Henry
54b54f85f3 drop with a negative count now drops from the end 2023-04-23 21:39:14 -07:00
Ian Henry
ccd874fe4e add catseq 2023-04-23 21:20:01 -07:00
Ian Henry
9dc7e8ed3a peg replacement functions have access to captures
When peg/replace or peg/replace-all are given a function to serve as the text
replacement, any captures produced by the PEG are passed as additional
arguments to that function.
2023-04-23 09:15:46 -07:00
Ian Henry
485099fd6e string and peg replacement functions can now take functions
Functions will be invoked with the matched text, and their result will be
coerced to a string and used as the new replacement text.

This also allows passing non-function, non-byteviewable values, which will be
converted into strings during replacement (only once, and only if at least
one match is found).
2023-04-23 08:36:17 -07:00
wackbyte
d359c6b43e Remove double space in help message 2023-04-22 21:46:24 -04:00
Calvin Rose
d9ed7a77f8 Merge pull request #1106 from CosmicToast/1105
handle null-byte case in scanformat (fixes #1105)
2023-04-22 15:25:48 -05:00
wackbyte
4238a4ca6a README grammar and formatting changes 2023-04-20 21:06:33 -04:00
Chloe Kudryavtsev
0902a5a981 improve null format handling
there was a request to improve the error message, but the whole function
has non-informative errors. (both functions, actually, since the code is
duplicated)
as such, instead of catching it directly, address the assumption that
led to the SIGSEGV and let it be caught by the functions themselves,
thus reusing existing error messages (which can then be improved
separately).
2023-04-20 11:51:11 -04:00
Chloe Kudryavtsev
f3192303ab check for NULL in get_fmt_mapping (fixes #1105)
When there is no format to be found after a %, get_fmt_mapping returns
NULL. It then gets called against strlen, which is a typical SEGV.
Check for NULL aginst mapping, which signals a null format being
specified.
2023-04-19 12:55:25 -04:00
Calvin Rose
bef5bd72c2 Merge pull request #1095 from ml-2/ml
Add `keep-syntax` and `keep-syntax!` functions
2023-04-08 10:46:47 -05:00
ML
b6175e4296 Add keep-syntax and keep-syntax! functions
These functions are designed to make it easier to properly preserve the
sourcemap and tuple type in macros. This commit also modifies the threading
macros to make use of these functions.
2023-04-07 21:09:52 -04:00
Calvin Rose
3858b2e177 Add ev/all-tasks to get running and pending root fibers. 2023-04-01 18:57:13 -05:00
Calvin Rose
9a76e77981 Update for undefined behavior sanitizer. 2023-03-24 18:49:21 -05:00
Calvin Rose
8182d640cd Merge branch 'master' of github.com:janet-lang/janet 2023-03-12 10:33:06 -05:00
Calvin Rose
1c6fda1a5c Address #1076 - unexpected shadowing behavior
While the old behavior was reasonable, it is not spelled out anywhere
in the documentation and was incidental rather than intentional.
Parameters of the same name of the function should probably take
precedence on name collision, following the principle of least surprise.
2023-03-12 10:30:59 -05:00
Calvin Rose
c51db1cf2f Merge pull request #1081 from ianthehenry/log-gamma-docstring
remove quotes in math/log-gamma docstring
2023-03-12 10:17:51 -05:00
Ian Henry
4e7930fc4c remove quotes around log-gamma 2023-03-11 12:26:45 -08:00
Calvin Rose
3563f8ccdb Merge pull request #1079 from dressupgeekout/charlotte_dragonfly
Some basic fixes for DragonFly
2023-03-08 15:05:51 -06:00
Charlotte Koch
575af763f6 os/which can return :dragonfly
While here, document that :bsd is another possible return value.
2023-03-07 06:45:31 -08:00
Charlotte Koch
8b16b9b246 Need to enable __BSD_VISIBLE on DragonFly in conjunction with -std=c99 2023-03-07 06:40:58 -08:00
Calvin Rose
01aab66667 Prepare for 1.27.0 release. 2023-03-05 09:48:25 -06:00
Calvin Rose
aa5c987a94 Change semantics of bracketed tuple equality.
Comparison between different bracket and normal tuples
will now take into account the delimiter type. This solves strange
non-locality issues in the compiler due to this false equality, and is
more consistent with Janet's otherwise strong equality philosophy.
2023-03-03 18:24:02 -06:00
Calvin Rose
75229332c8 Merge pull request #1075 from sogaiu/math-rng-int-docs
Tweak math/rng-int docs
2023-03-03 18:09:11 -06:00
sogaiu
9d5b1ba838 Tweak math/rng-int docs 2023-02-24 19:55:47 +09:00
Calvin Rose
f27b225b34 Merge pull request #1072 from sogaiu/ftell
Add file/tell
2023-02-21 07:13:00 -06:00
sogaiu
3c523d66e9 Add file/tell 2023-02-21 20:19:17 +09:00
Calvin Rose
1144c27c54 Merge pull request #1071 from ianthehenry/number-pegfault
fix a segfault in the (number) special
2023-02-20 21:01:33 -06:00
Ian Henry
b442b21d3f fix a segfault in the (number) special
This was an error about the base argument that referenced the tag argument,
which might not exist.
2023-02-20 17:07:42 -08:00
Calvin Rose
746ff5307d Update for more minimal builds. 2023-02-12 12:14:11 -06:00
Calvin Rose
ef85b24d8f Add optional offset to ffi/write. 2023-02-12 12:08:28 -06:00
Calvin Rose
c55d93512b Add buffer/push-at for easier manipulation of buffers
buffer/blit is difficult to use, and while buffer/push is the easiet
buffer manipulation function to use it only appends to the buffer.
buffer/push-at lets users manipulate buffers at any index - useful
for buffers used as an in-memory databases, for example.
2023-02-12 11:26:00 -06:00
Calvin Rose
2e38f9ba61 Allow passing pointer-buffers to other threads. 2023-02-12 11:07:45 -06:00
Calvin Rose
1cadff8e58 Add ffi/pointer-buffer for easier memory manipulation in FFI.
Added underlying buffer support for buffer instances that cannot
reallocated underlying memory - useful for (small) memory mapped
files and other FFI utilties.
2023-02-12 09:20:05 -06:00
Calvin Rose
d1eba60ba8 Add separate sandbox flag for file/temp
Doesn't really impart (much) file systtem information when used, and
can be used for a lot of things where file functions are used to process
in a stream.
2023-02-09 08:57:53 -06:00
Calvin Rose
057dccad8f Turn on nanboxing by default for risc-v 64. 2023-02-09 03:09:53 -06:00
Calvin Rose
4285200b4b Add a sandbox option to disable native modules.
Also sort the sandbox docstring list.
2023-02-09 00:19:56 -06:00
Calvin Rose
73c2fbbc2a Check sandbox capabilities instead of ignoring unknown ones. 2023-02-06 17:38:00 -06:00
Calvin Rose
37b7e170fa Update changelist. 2023-02-06 12:31:49 -06:00
Calvin Rose
b032d94877 Add sandboxing API.
The sandboxing API is meant to make janet a bit more attractive
for certain application embedding use cases. The sandboxing API
puts limits on what system resources the interpreter can access.
2023-02-06 09:05:57 -06:00
Calvin Rose
9476016741 Update asm.c 2023-02-05 23:49:18 -06:00
Calvin Rose
7a1c9c7798 Add support for debugging upvalues.
Upvalues are stored in the symbol slots structure as well, but
since they are always live, we repurpose the death_pc field to
refer to the environment index that we want to look at at runtime.
2023-02-05 15:30:01 -06:00
Calvin Rose
c7fb7b4451 Merge branch 'master' into localbindings 2023-02-05 11:36:57 -06:00
Calvin Rose
67c474fc7a More fixes to ev/gather (tested on httpf server). 2023-02-05 10:21:37 -06:00
Calvin Rose
4e8154cf8a Fix ev/gather to cancel children on cancellation.
Otherwise, we would be leaving zombie fibers around.
2023-02-05 09:43:16 -06:00
Calvin Rose
9582d3c623 Allow infinite wait to work without issues. 2023-02-05 09:29:39 -06:00
Calvin Rose
0079500713 Merge branch 'master' into localbindings 2023-02-04 13:39:24 -06:00
Calvin Rose
55af6ce834 Fix write after free with printing to files. 2023-02-04 13:36:30 -06:00
Calvin Rose
3e82fdc125 Update symbolmapping code with marshal/unmarshal. 2023-02-03 17:33:11 -06:00
Calvin Rose
7344a6cfc0 Fix null check. 2023-02-03 16:24:50 -06:00
Calvin Rose
0aded71343 Fix issue with environments in asm.c 2023-02-03 16:24:50 -06:00
Calvin Rose
7663b1e703 Fix null check. 2023-02-02 22:03:18 -06:00
Calvin Rose
282546c03f Fix issue with environments in asm.c 2023-02-02 21:12:17 -06:00
Calvin Rose
f4bc89d1c0 Progress. 2023-02-02 21:08:48 -06:00
Jona Ekenberg
fa277c3797 added future test for upvalues and symbolslots 2023-02-01 21:26:29 +01:00
Jona Ekenberg
c0c8ab25e6 added symbolslots to asm 2023-02-01 21:12:42 +01:00
Jona Ekenberg
b685bf3026 updated symbolslots-test 2023-02-01 11:46:36 +01:00
Jona Ekenberg
ce31db09e4 symbolslots should be gc'd, local_symbols always pushed in case *debug* is set in middle of function 2023-02-01 11:45:13 +01:00
Jona Ekenberg
624a6cf619 symbolslots nil when there are no symbols, changed debugger to not have special case 2023-02-01 11:25:52 +01:00
Jona Ekenberg
587aa87d28 symbolslots now use janet_v vectors, flat structure 2023-02-01 11:06:33 +01:00
Jona Ekenberg
88813c4f87 initial slotsyms implementation 2023-02-01 09:39:24 +01:00
Calvin Rose
dacbe29771 Allow round-tripping more functions with disasm and asm.
Nested functions that captured with environments didn't
work well with asm.
2023-01-30 09:04:42 -06:00
Calvin Rose
244833cfa1 Merge pull request #1040 from lgtm-migrator/codeql
Add CodeQL workflow for GitHub code scanning
2023-01-29 09:04:18 -06:00
Calvin Rose
05e7f974e3 Add os/compiler to the core.
Allows querying what compiler was used to compile Janet.
2023-01-28 14:00:02 -06:00
Calvin Rose
0dbef65a73 Merge pull request #1065 from sogaiu/comment-tweaks
Misc comment tweaks
2023-01-27 11:26:05 -06:00
Calvin Rose
9106228787 Add :riscv32 and :riscv32 values for os/arch. 2023-01-27 11:23:57 -06:00
Calvin Rose
6ae3bdb25c Add RISC-V 64 bit detection in janet.h 2023-01-26 22:40:05 -06:00
sogaiu
310bcec260 Misc comment tweaks 2023-01-25 18:45:19 +09:00
Calvin Rose
8c4cc4e671 Merge pull request #1064 from sogaiu/realpath-doc-tweak
Update os/realpath docstring
2023-01-24 09:50:44 -06:00
Calvin Rose
c6eaaa83ed Buffer initialized with janet_buffer_init will not be gced.
Set an internal flag that disables garbage collection on such
buffers. For all currently correct usage, this should have no effect,
and will fix use cases where buffers are initialized this way and then
passed to the interpreter.
2023-01-23 20:57:30 -06:00
sogaiu
8f598d6f96 Update os/realpath docstring 2023-01-23 12:55:04 +09:00
Calvin Rose
20bc323d17 Use gcc explicitly in mingw build. 2023-01-22 11:21:28 -06:00
Calvin Rose
8b0bcf4db9 Add the mingw toolchain. 2023-01-22 11:10:04 -06:00
Calvin Rose
8955e6f536 Merge branch 'master' of github.com:janet-lang/janet 2023-01-22 11:05:39 -06:00
Calvin Rose
f8ddea6452 Add msys2 testing with github actions. 2023-01-22 11:05:27 -06:00
Calvin Rose
987e04086d Merge pull request #1063 from AlecTroemel/1062-io-flag-types
use int32_t type for file flags, just like header
2023-01-22 10:56:19 -06:00
Calvin Rose
85f2acbf52 Fix tools/format.sh file permissions. 2023-01-22 10:47:33 -06:00
alectroemel
1acf4c3ab7 add int32_t type for file flags, just like header
Signed-off-by: alectroemel <alectroemel@hotmail.com>
Signed-off-by: alectroemel <alec@mirusresearch.com>
2023-01-22 10:24:46 -06:00
Calvin Rose
07a3158fba Merge pull request #1060 from ianthehenry/doc-typos
Fix some docstring typos
2023-01-21 16:21:57 -06:00
bakpakin
2f8bed9d82 Build and install an import library on mingw 2023-01-21 14:31:48 -06:00
bakpakin
a490937cd9 Add :mingw value when getting the OS setting when compiled with mingw. 2023-01-21 11:50:03 -06:00
bakpakin
8ee5942481 Fix windows build with JANET_NO_NET - #1055 2023-01-21 10:56:20 -06:00
bakpakin
93b469885a Initial Mingw support with Makefile.
Also add a macro JANET_MSVC to distinguish between
a windows build (JANET_WINDOWS) and a build with msvc.
2023-01-21 10:37:34 -06:00
Calvin Rose
d8d1de2dcb Don't compile library loading code on windows if it is disabled. 2023-01-21 09:36:03 -06:00
Ian Henry
ab224514f0 Fix some docstring typos. 2023-01-18 19:41:56 -08:00
Calvin Rose
75179de8da Merge pull request #1056 from fd00/use-dev-urandom-on-cygwin
Use `/dev/urandom` for `janet_cryptorand` on cygwin
2023-01-08 09:29:52 -06:00
Daisuke Fujimura (fd0)
3254c2c477 Use /dev/urandom for janet_cryptorand on cygwin 2023-01-07 08:58:35 +09:00
LGTM Migrator
4067f883a2 Add CodeQL workflow for GitHub code scanning 2022-11-05 10:22:49 +00:00
52 changed files with 1611 additions and 412 deletions

41
.github/workflows/codeql.yml vendored Normal file
View File

@@ -0,0 +1,41 @@
name: "CodeQL"
on:
push:
branches: [ "master" ]
pull_request:
branches: [ "master" ]
schedule:
- cron: "2 7 * * 4"
jobs:
analyze:
name: Analyze
runs-on: ubuntu-latest
permissions:
actions: read
contents: read
security-events: write
strategy:
fail-fast: false
matrix:
language: [ cpp ]
steps:
- name: Checkout
uses: actions/checkout@v3
- name: Initialize CodeQL
uses: github/codeql-action/init@v2
with:
languages: ${{ matrix.language }}
queries: +security-and-quality
- name: Autobuild
uses: github/codeql-action/autobuild@v2
- name: Perform CodeQL Analysis
uses: github/codeql-action/analyze@v2
with:
category: "/language:${{ matrix.language }}"

View File

@@ -35,3 +35,25 @@ jobs:
- name: Test the project
shell: cmd
run: build_win test
test-mingw:
name: Build on Windows with Mingw (no test yet)
runs-on: windows-latest
defaults:
run:
shell: msys2 {0}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup Mingw
uses: msys2/setup-msys2@v2
with:
msystem: UCRT64
update: true
install: >-
base-devel
git
gcc
- name: Build the project
shell: cmd
run: make -j CC=gcc

View File

@@ -1,6 +1,36 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.28.0 - 2023-05-13
- Various bug fixes
- Make nested short-fn's behave a bit more predictably (it is still not recommended to nest short-fns).
- Add `os/strftime` for date formatting.
- Fix `ev/select` on threaded channels sometimes live-locking.
- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts).
See http://no-color.org/
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
Instead, raise a compiler error.
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
- Add `ev/all-tasks` to see all currently suspended fibers.
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
## 1.27.0 - 2023-03-05
- Change semantics around bracket tuples to no longer be equal to regular tuples.
- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
- Add `buffer/push-at`
- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
cancel the child fibers.
- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
- Add `(.locals)` function to debugger to see currently bound local symbols.
- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
in `debug/stack` and `disasm`.
- Add `os/compiler` to detect what host compiler was used to compile the interpreter
- Add support for mingw and cygwin builds (mingw support also added in jpm).
## 1.26.0 - 2023-01-07
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.

View File

@@ -31,6 +31,8 @@ LIBDIR?=$(PREFIX)/lib
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_BOOT=build/janet_boot
JANET_IMPORT_LIB=build/janet.lib
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
@@ -46,6 +48,7 @@ HOSTCC?=$(CC)
HOSTAR?=$(AR)
CFLAGS?=-O2
LDFLAGS?=-rdynamic
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
@@ -55,7 +58,7 @@ BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
LDCONFIG:=ldconfig "$(LIBDIR)"
# Check OS
UNAME:=$(shell uname -s)
UNAME?=$(shell uname -s)
ifeq ($(UNAME), Darwin)
CLIBS:=$(CLIBS) -ldl
SONAME_SETTER:=-Wl,-install_name,
@@ -77,6 +80,14 @@ ifeq ($(shell uname -o), Android)
endif
endif
# Mingw
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
JANET_TARGET:=$(JANET_TARGET).exe
JANET_BOOT:=$(JANET_BOOT).exe
endif
$(shell mkdir -p build/core build/c build/boot)
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
@@ -156,12 +167,12 @@ $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(JANET_BOOT): $(JANET_BOOT_OBJECTS)
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
# Now the reason we bootstrap in the first place
build/c/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
$(RUN) $(JANET_BOOT) . JANET_PATH '$(JANET_PATH)' > $@
cksum $@
########################
@@ -169,16 +180,16 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.26.dylib
SONAME=libjanet.1.28.dylib
else
SONAME=libjanet.so.1.26
SONAME=libjanet.so.1.28
endif
build/c/shell.c: src/mainclient/shell.c
cp $< $@
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
$(RUN) ./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
build/janetconf.h: $(JANETCONF_HEADER)
cp $< $@
@@ -207,7 +218,7 @@ $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
TEST_SCRIPTS=$(wildcard test/suite*.janet)
repl: $(JANET_TARGET)
./$(JANET_TARGET)
$(RUN) ./$(JANET_TARGET)
debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET)
@@ -218,8 +229,8 @@ valgrind: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(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
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
@@ -258,7 +269,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
docs: build/doc.html
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
$(RUN) $(JANET_TARGET) tools/gendoc.janet > build/doc.html
########################
##### Installation #####
@@ -274,7 +285,7 @@ build/janet.pc: $(JANET_TARGET)
echo "Name: janet" >> $@
echo "Url: https://janet-lang.org" >> $@
echo "Description: Library for the Janet programming language." >> $@
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
$(RUN) $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
echo 'Cflags: -I$${includedir}' >> $@
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
@@ -301,6 +312,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
install-jpm-git: $(JANET_TARGET)
@@ -313,7 +325,7 @@ install-jpm-git: $(JANET_TARGET)
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
JANET_BINPATH='$(BINDIR)' \
JANET_LIBPATH='$(LIBDIR)' \
../../$(JANET_TARGET) ./bootstrap.janet
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
uninstall:
-rm '$(DESTDIR)$(BINDIR)/janet'
@@ -333,7 +345,7 @@ format:
grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(JANET_TARGET) $< > $@
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb

View File

@@ -7,14 +7,14 @@
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
lisp-like language, but lists are replaced
Lisp-like language, but lists are replaced
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
There is a REPL for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
Janet can be embedded in other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<https://janet-lang.org>.
If you'd like to financially support the ongoing development of Janet, consider
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
@@ -41,8 +41,8 @@ Lua, but smaller than GNU Guile or Python.
* 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
* Bytecode interpreter with an assembly interface, as well as bytecode verification
* Tail-call optimization
* Direct interop with C via abstract types and C functions
* Dynamically load C libraries
* Functional and imperative standard library
@@ -57,7 +57,7 @@ Lua, but smaller than GNU Guile or Python.
## Documentation
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html).
Documentation is also available locally in the REPL.
Use the `(doc symbol-name)` macro to get API
@@ -65,7 +65,7 @@ documentation for symbols in the core library. For example,
```
(doc apply)
```
Shows documentation for the `apply` function.
shows documentation for the `apply` function.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function. You
@@ -84,7 +84,7 @@ the SourceHut mirror is actively maintained.
The Makefile is non-portable and requires GNU-flavored make.
```
```sh
cd somewhere/my/projects/janet
make
make test
@@ -100,7 +100,7 @@ Find out more about the available make targets by running `make help`.
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
but you need to specify an alternative compiler, such as `gcc-x86`.
```
```sh
cd somewhere/my/projects/janet
make CC=gcc-x86
make test
@@ -112,10 +112,9 @@ make install-jpm-git
### FreeBSD
FreeBSD build instructions are the same as the UNIX-like build instructions,
but you need `gmake` to compile. Alternatively, install directly from
packages, using `pkg install lang/janet`.
but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`.
```
```sh
cd somewhere/my/projects/janet
gmake
gmake test
@@ -127,19 +126,19 @@ gmake install-jpm-git
### NetBSD
NetBSD build instructions are the same as the FreeBSD build instructions.
Alternatively, install directly from packages, using `pkgin install janet`.
Alternatively, install the package directly with `pkgin install janet`.
### Windows
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
3. Run `build_win` to compile janet.
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet.
3. Run `build_win` to compile Janet.
4. Run `build_win test` to make sure everything is working.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
6. run `build_win dist`
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
6. Run `build_win dist`.
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
@@ -175,9 +174,9 @@ ninja -C build install
Janet can be hacked on with pretty much any environment you like, but for IDE
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
best option, as it has excellent meson integration. It also offers code completion
best option, as it has excellent Meson integration. It also offers code completion
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
Emacs, and Atom will have syntax packages for the Janet language, though.
Emacs, and Atom each have syntax packages for the Janet language, though.
## Installation
@@ -186,8 +185,8 @@ to try out the language, you don't need to install anything. You can also move t
## Usage
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag
to display the usage information. Individual scripts can be run with `./janet myscript.janet`.
If you are looking to explore, you can print a list of all available macros, functions, and constants
by entering the command `(all-bindings)` into the REPL.
@@ -202,20 +201,26 @@ Hello, World!
nil
janet:3:> (os/exit)
$ janet -h
usage: build/janet [options] script args...
usage: janet [options] script args...
Options are:
-h : Show this help
-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
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide prompt, logo, and REPL output (quiet)
-q : Hide logo (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-i : Load the script argument as an image file instead of source code
-n : Disable ANSI color output in the REPL
-l path : Execute code in a file before running the main script
-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
```
@@ -226,8 +231,8 @@ If installed, you can also run `man janet` to get usage information.
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
project and compiled into the project. Janet should be compiled with `-std=c99`
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
project and compiled into it. Janet should be compiled with `-std=c99`
on most compilers, and will need to be linked to the math library, `-lm`, and
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
there is no need for dynamic modules, add the define
@@ -237,24 +242,24 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## Examples
See the examples directory for some example janet code.
See the examples directory for some example Janet code.
## Discussion
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and irc bridges as well.
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
## FAQ
### 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
It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense
of 5 others by making the language more complicated.
### Is there a language spec?
There is not currently a spec besides the documentation at https://janet-lang.org.
There is not currently a spec besides the documentation at <https://janet-lang.org>.
### Is this Scheme/Common Lisp? Where are the cons cells?
@@ -270,13 +275,13 @@ 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?
### 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.
methods are implemented with keywords.
```
```clj
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
(def my-car (table/setproto @{} Car))
(:honk my-car "Beep!")
@@ -287,9 +292,9 @@ methods are implemeted with keywords.
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, 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. Adding features
Janet does not run on the JVM and has a more primitive garbage collector.
- We want to keep the Janet core small. With Lisps, a feature can usually be added as a library
without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
to the core also makes it a bit more difficult to keep Janet maximally portable.
### Why is my terminal spitting out junk when I run the REPL?
@@ -297,7 +302,7 @@ Usually, one of a few reasons:
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
the `-n` flag, which disables color output. You can also try the `-s` flag if further issues
ensue.
## Why is it called "Janet"?

10
janet.1
View File

@@ -183,6 +183,10 @@ default repl.
.BR \-n
Disable ANSI colors in the repl. Has no effect if no repl is run.
.TP
.BR \-N
Enable ANSI colors in the repl. Has no effect if no repl is run.
.TP
.BR \-r
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
@@ -268,5 +272,11 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
cannot be defined for this variable to have an effect.
.RE
.B NO_COLOR
.RS
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.26.0')
version : '1.28.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

View File

@@ -129,20 +129,18 @@
# For macros, we define an imcomplete odd? function that will be overriden.
(defn odd? [x] (= 1 (mod x 2)))
(def idempotent?
```
(idempotent? x)
(def- non-atomic-types
{:array true
:tuple true
:table true
:buffer true
:symbol true
:struct true})
Check if x is a value that evaluates to itself when compiled.
```
(do
(def non-atomic-types
{:array true
:tuple true
:table true
:buffer true
:struct true})
(fn idempotent? [x] (not (in non-atomic-types (type x))))))
(defn idempotent?
"Check if x is a value that evaluates to itself when compiled."
[x]
(not (in non-atomic-types (type x))))
# C style macros and functions for imperative sugar. No bitwise though.
(defn inc "Returns x + 1." [x] (+ x 1))
@@ -282,7 +280,7 @@
(while (> i 0)
(-- i)
(def v (in forms i))
(set ret (if (= ret true)
(set ret (if (= i (- len 1))
v
(if (idempotent? v)
['if v ret v]
@@ -613,6 +611,13 @@
(def $accum (gensym))
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
(defmacro catseq
``Similar to `loop`, but concatenates each element from the loop body into an array and returns that.
See `loop` for details.``
[head & body]
(def $accum (gensym))
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
(defmacro tabseq
``Similar to `loop`, but accumulates key value pairs into a table.
See `loop` for details.``
@@ -1135,16 +1140,16 @@
(take-until (complement pred) ind))
(defn drop
``Drop the first n elements in an indexed or bytes type. Returns a new tuple or string
instance, respectively.``
``Drop the first `n elements in an indexed or bytes type. Returns a new tuple or string
instance, respectively. If `n` is negative, drops the last `n` elements instead.``
[n ind]
(def use-str (bytes? ind))
(def f (if use-str string/slice tuple/slice))
(def len (length ind))
# make sure start is in [0, len]
(def m (if (> n 0) n 0))
(def start (if (> m len) len m))
(f ind start -1))
(def negn (>= n 0))
(def start (if negn (min n len) 0))
(def end (if negn len (max 0 (+ len n))))
(f ind start end))
(defn drop-until
"Same as `(drop-while (complement pred) ind)`."
@@ -1234,6 +1239,29 @@
(,eprintf (,dyn :pretty-format "%q") ,s)
,s))
(defn keep-syntax
``Creates a tuple with the tuple type and sourcemap of `before` but the
elements of `after`. If either one of its argements is not a tuple, returns
`after` unmodified. Useful to preserve syntactic information when transforming
an ast in macros.``
[before after]
(if (and (= :tuple (type before))
(= :tuple (type after)))
(do
(def res (if (= :parens (tuple/type before))
(tuple/slice after)
(tuple/brackets ;after)))
(tuple/setmap res ;(tuple/sourcemap before)))
after))
(defn keep-syntax!
``Like `keep-syntax`, but if `after` is an array, it is coerced into a tuple.
Useful to preserve syntactic information when transforming an ast in macros.``
[before after]
(keep-syntax before (if (= :array (type after))
(tuple/slice after)
after)))
(defmacro ->
``Threading macro. Inserts x as the second value in the first form
in `forms`, and inserts the modified first form into the second form
@@ -1244,7 +1272,7 @@
(tuple (in n 0) (array/slice n 1))
(tuple n @[])))
(def parts (array/concat @[h last] t))
(tuple/slice parts 0))
(keep-syntax! n parts))
(reduce fop x forms))
(defmacro ->>
@@ -1257,7 +1285,7 @@
(tuple (in n 0) (array/slice n 1))
(tuple n @[])))
(def parts (array/concat @[h] t @[last]))
(tuple/slice parts 0))
(keep-syntax! n parts))
(reduce fop x forms))
(defmacro -?>
@@ -1273,7 +1301,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h sym] t))
~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defmacro -?>>
@@ -1289,7 +1317,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h] t @[sym]))
~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defn- walk-ind [f form]
@@ -1313,10 +1341,7 @@
:table (walk-dict f form)
:struct (table/to-struct (walk-dict f form))
:array (walk-ind f form)
:tuple (let [x (walk-ind f form)]
(if (= :parens (tuple/type form))
(tuple/slice x)
(tuple/brackets ;x)))
:tuple (keep-syntax! form (walk-ind f form))
form))
(defn postwalk
@@ -2184,6 +2209,7 @@
(defn saw-special-arg
[num]
(set max-param-seen (max max-param-seen num)))
(def prefix (gensym))
(defn on-binding
[x]
(if (string/has-prefix? '$ x)
@@ -2191,22 +2217,24 @@
(= '$ x)
(do
(saw-special-arg 0)
'$0)
(symbol prefix '$0))
(= '$& x)
(do
(set vararg true)
x)
(symbol prefix x))
:else
(do
(def num (scan-number (string/slice x 1)))
(if (nat? num)
(saw-special-arg num))
x))
(do
(saw-special-arg num)
(symbol prefix x))
x)))
x))
(def expanded (macex arg on-binding))
(def name-splice (if name [name] []))
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
###
###
@@ -2766,6 +2794,7 @@
(put nextenv :fiber fiber)
(put nextenv :debug-level level)
(put nextenv :signal (fiber/last-value fiber))
(merge-into nextenv debugger-env)
(defn debugger-chunks [buf p]
(def status (:state p :delimiters))
@@ -3374,11 +3403,16 @@
(print))
(defn .frame
"Show a stack frame."
"Show a stack frame"
[&opt n]
(def stack (debug/stack (.fiber)))
(in stack (or n 0)))
(defn .locals
"Show local bindings"
[&opt n]
(get (.frame n) :locals))
(defn .fn
"Get the current function."
[&opt n]
@@ -3583,13 +3617,18 @@
(,ev/deadline ,deadline nil ,f)
(,resume ,f))))
(defn- cancel-all [fibers reason] (each f fibers (ev/cancel f reason) (put fibers f nil)))
(defn- wait-for-fibers
[chan fibers]
(repeat (length fibers)
(def [sig fiber] (ev/take chan))
(unless (= sig :ok)
(each f fibers (ev/cancel f "sibling canceled"))
(propagate (fiber/last-value fiber) fiber))))
(defer (cancel-all fibers "parent canceled")
(repeat (length fibers)
(def [sig fiber] (ev/take chan))
(if (= sig :ok)
(put fibers fiber nil)
(do
(cancel-all fibers "sibling canceled")
(propagate (fiber/last-value fiber) fiber))))))
(defmacro ev/gather
``
@@ -3597,13 +3636,16 @@
Returns the gathered results in an array.
``
[& bodies]
(with-syms [chan res]
(with-syms [chan res fset ftemp]
~(do
(def ,fset @{})
(def ,chan (,ev/chan))
(def ,res @[])
(,wait-for-fibers ,chan
,(seq [[i body] :pairs bodies]
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
,;(seq [[i body] :pairs bodies]
~(do
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
(,put ,fset ,ftemp ,ftemp)))
(,wait-for-fibers ,chan ,fset)
,res))))
(compwhen (dyn 'net/listen)
@@ -3816,6 +3858,7 @@
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp))
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
(set colorize (not (getenv-alias "NO_COLOR")))
(defn- get-lint-level
[i]
@@ -3833,7 +3876,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
-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
@@ -3844,6 +3887,7 @@
-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
-N : Enable ANSI color output in the REPL
-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"
@@ -3859,6 +3903,7 @@
"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)
"N" (fn [&] (set colorize true) 1)
"m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2)
"c" (fn c-switch [i &]
(def path (in args (+ i 1)))
@@ -3933,7 +3978,7 @@
compile-only (flycheck stdin :source :stdin :exit exit-on-error)
(do
(if-not quiet
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
(flush)
(defn getprompt [p]
(def [line] (parser/where p))

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 26
#define JANET_VERSION_MINOR 28
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.26.0"
#define JANET_VERSION "1.28.0"
/* #define JANET_BUILD "local" */

View File

@@ -98,11 +98,11 @@ size_t janet_os_rwlock_size(void) {
}
static int32_t janet_incref(JanetAbstractHead *ab) {
return InterlockedIncrement(&ab->gc.data.refcount);
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return InterlockedDecrement(&ab->gc.data.refcount);
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {

View File

@@ -187,7 +187,11 @@ static void janet_asm_longjmp(JanetAssembler *a) {
/* Throw some kind of assembly error */
static void janet_asm_error(JanetAssembler *a, const char *message) {
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
if (a->errindex < 0) {
a->errmessage = janet_formatc("%s", message);
} else {
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
}
janet_asm_longjmp(a);
}
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
@@ -516,6 +520,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
#endif
if (NULL != a.parent) {
janet_asm_deinit(&a);
a.parent->errmessage = a.errmessage;
janet_asm_longjmp(a.parent);
}
result.funcdef = NULL;
@@ -601,6 +606,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
/* Parse sub funcdefs */
x = janet_get1(s, janet_ckeywordv("closures"));
if (janet_checktype(x, JANET_NIL)) {
x = janet_get1(s, janet_ckeywordv("defs"));
}
if (janet_indexed_view(x, &arr, &count)) {
int32_t i;
for (i = 0; i < count; i++) {
@@ -713,10 +721,63 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
}
/* Set symbolmap */
def->symbolmap = NULL;
def->symbolmap_length = 0;
x = janet_get1(s, janet_ckeywordv("symbolmap"));
if (janet_indexed_view(x, &arr, &count)) {
def->symbolmap_length = count;
def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
if (NULL == def->symbolmap) {
JANET_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];
JanetSymbolMap ss;
if (!janet_checktype(entry, JANET_TUPLE)) {
janet_asm_error(&a, "expected tuple");
}
tup = janet_unwrap_tuple(entry);
if (janet_keyeq(tup[0], "upvalue")) {
ss.birth_pc = UINT32_MAX;
} else if (!janet_checkint(tup[0])) {
janet_asm_error(&a, "expected integer");
} else {
ss.birth_pc = janet_unwrap_integer(tup[0]);
}
if (!janet_checkint(tup[1])) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checkint(tup[2])) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checktype(tup[3], JANET_SYMBOL)) {
janet_asm_error(&a, "expected symbol");
}
ss.death_pc = janet_unwrap_integer(tup[1]);
ss.slot_index = janet_unwrap_integer(tup[2]);
ss.symbol = janet_unwrap_symbol(tup[3]);
def->symbolmap[i] = ss;
}
}
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
/* Set environments */
def->environments =
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
if (NULL == def->environments) {
x = janet_get1(s, janet_ckeywordv("environments"));
if (janet_indexed_view(x, &arr, &count)) {
def->environments_length = count;
if (def->environments_length) {
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
}
for (int32_t i = 0; i < count; i++) {
if (!janet_checkint(arr[i])) {
janet_asm_error(&a, "expected integer");
}
def->environments[i] = janet_unwrap_integer(arr[i]);
}
}
if (def->environments_length && NULL == def->environments) {
JANET_OUT_OF_MEMORY;
}
@@ -865,6 +926,30 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
return janet_wrap_integer(def->slotcount);
}
static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
if (def->symbolmap == NULL) {
return janet_wrap_nil();
}
JanetArray *symbolslots = janet_array(def->symbolmap_length);
Janet upvaluekw = janet_ckeywordv("upvalue");
for (int32_t i = 0; i < def->symbolmap_length; i++) {
JanetSymbolMap ss = def->symbolmap[i];
Janet *t = janet_tuple_begin(4);
if (ss.birth_pc == UINT32_MAX) {
t[0] = upvaluekw;
} else {
t[0] = janet_wrap_integer(ss.birth_pc);
}
t[1] = janet_wrap_integer(ss.death_pc);
t[2] = janet_wrap_integer(ss.slot_index);
t[3] = janet_wrap_symbol(ss.symbol);
symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
symbolslots->count = def->symbolmap_length;
return janet_wrap_array(symbolslots);
}
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
JanetArray *bcode = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
@@ -944,6 +1029,7 @@ Janet janet_disasm(JanetFuncDef *def) {
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
@@ -961,7 +1047,7 @@ JANET_CORE_FN(cfun_asm,
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
if (res.status != JANET_ASSEMBLE_OK) {
janet_panics(res.error);
janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
}
return janet_wrap_function(janet_thunk(res.funcdef));
}
@@ -980,6 +1066,7 @@ JANET_CORE_FN(cfun_disasm,
"* :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"
"* :symbolmap - all symbols and their slots.\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"

View File

@@ -28,8 +28,15 @@
#include "state.h"
#endif
/* Allow for managed buffers that cannot realloc/free their backing memory */
static void janet_buffer_can_realloc(JanetBuffer *buffer) {
if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
janet_panic("buffer cannot reallocate foreign memory");
}
}
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity < 4) capacity = 4;
janet_gcpressure(capacity);
@@ -43,15 +50,37 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
return buffer;
}
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
janet_buffer_init_impl(buffer, capacity);
buffer->gc.data.next = NULL;
buffer->gc.flags = JANET_MEM_DISABLED;
return buffer;
}
/* Initialize an unmanaged buffer */
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
if (count < 0) janet_panic("count < 0");
if (capacity < count) janet_panic("capacity < count");
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
buffer->capacity = capacity;
buffer->count = count;
buffer->data = (uint8_t *) memory;
return buffer;
}
/* Deinitialize a buffer (free data memory) */
void janet_buffer_deinit(JanetBuffer *buffer) {
janet_free(buffer->data);
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
janet_free(buffer->data);
}
}
/* Initialize a buffer */
JanetBuffer *janet_buffer(int32_t capacity) {
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
return janet_buffer_init(buffer, capacity);
return janet_buffer_init_impl(buffer, capacity);
}
/* Ensure that the buffer has enough internal capacity */
@@ -59,6 +88,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
uint8_t *new_data;
uint8_t *old = buffer->data;
if (capacity <= buffer->capacity) return;
janet_buffer_can_realloc(buffer);
int64_t big_capacity = ((int64_t) capacity) * growth;
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
janet_gcpressure(capacity - buffer->capacity);
@@ -91,6 +121,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
}
int32_t new_size = buffer->count + n;
if (new_size > buffer->capacity) {
janet_buffer_can_realloc(buffer);
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
janet_gcpressure(new_capacity - buffer->capacity);
@@ -212,6 +243,7 @@ JANET_CORE_FN(cfun_buffer_trim,
"modified buffer.") {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
janet_buffer_can_realloc(buffer);
if (buffer->count < buffer->capacity) {
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
uint8_t *newData = janet_realloc(buffer->data, newcap);
@@ -275,17 +307,8 @@ JANET_CORE_FN(cfun_buffer_chars,
return argv[0];
}
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);
for (i = 1; i < argc; i++) {
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
for (int32_t i = argc_offset; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} else {
@@ -297,6 +320,36 @@ JANET_CORE_FN(cfun_buffer_push,
janet_buffer_push_bytes(buffer, view.bytes, view.len);
}
}
}
JANET_CORE_FN(cfun_buffer_push_at,
"(buffer/push-at buffer index & xs)",
"Same as buffer/push, but inserts new data at index `index`.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t index = janet_getinteger(argv, 1);
int32_t old_count = buffer->count;
if (index < 0 || index > old_count) {
janet_panicf("index out of range [0, %d)", old_count);
}
buffer->count = index;
buffer_push_impl(buffer, argv, 2, argc);
if (buffer->count < old_count) {
buffer->count = old_count;
}
return argv[0];
}
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.") {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
buffer_push_impl(buffer, argv, 1, argc);
return argv[0];
}
@@ -442,7 +495,7 @@ JANET_CORE_FN(cfun_buffer_blit,
JANET_CORE_FN(cfun_buffer_format,
"(buffer/format buffer format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
" the modified buffer.") {
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
const char *strfrmt = (const char *) janet_getstring(argv, 1);
@@ -460,6 +513,7 @@ void janet_lib_buffer(JanetTable *env) {
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/push-at", cfun_buffer_push_at),
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),

View File

@@ -218,6 +218,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->closure_bitset = NULL;
def->flags = 0;
def->slotcount = 0;
def->symbolmap = NULL;
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
@@ -229,6 +230,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->constants_length = 0;
def->bytecode_length = 0;
def->environments_length = 0;
def->symbolmap_length = 0;
return def;
}

View File

@@ -209,14 +209,28 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c
#undef DEFINE_OPTLEN
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_panic("string contains embedded 0s");
if (!janet_checktype(argv[n], JANET_STRING)) {
janet_panic_type(argv[n], n, JANET_TFLAG_STRING);
}
return janet_getcbytes(argv, n);
}
const char *janet_getcbytes(const Janet *argv, int32_t n) {
JanetByteView view = janet_getbytes(argv, n);
const char *cstr = (const char *)view.bytes;
if (strlen(cstr) != (size_t) view.len) {
janet_panic("bytes contain embedded 0s");
}
return cstr;
}
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return dflt;
}
return janet_getcbytes(argv, n);
}
int32_t janet_getnat(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkint(x)) goto bad;

View File

@@ -93,10 +93,14 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
/* Add a slot to a scope with a symbol associated with it (def or var). */
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
janet_v_push(c->scope->syms, sp);
}
@@ -159,21 +163,27 @@ void janetc_popscope(JanetCompiler *c) {
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
newscope->flags |= JANET_SCOPE_CLOSURE;
}
if (newscope->ra.max < oldscope->ra.max)
if (newscope->ra.max < oldscope->ra.max) {
newscope->ra.max = oldscope->ra.max;
/* Keep upvalue slots */
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
if (pair.keep) {
/* The variable should not be lexically accessible */
pair.sym = NULL;
janet_v_push(newscope->syms, pair);
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
}
}
/* Keep upvalue slots and symbols for debugging. */
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
/* The variable should not be lexically accessible */
pair.sym = NULL;
if (pair.death_pc == UINT32_MAX) {
pair.death_pc = (uint32_t) janet_v_count(c->buffer);
}
if (pair.keep) {
/* The variable should also not be included in the locals */
pair.sym2 = NULL;
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
}
janet_v_push(newscope->syms, pair);
}
}
/* Free the old scope */
janet_v_free(oldscope->consts);
janet_v_free(oldscope->syms);
@@ -334,6 +344,7 @@ found:
}
/* non-local scope needs to expose its environment */
JanetScope *original_scope = scope;
pair->keep = 1;
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
scope = scope->parent;
@@ -355,7 +366,7 @@ found:
/* Check if scope already has env. If so, break */
len = janet_v_count(scope->envs);
for (j = 0; j < len; j++) {
if (scope->envs[j] == envindex) {
if (scope->envs[j].envindex == envindex) {
scopefound = 1;
envindex = j;
break;
@@ -364,7 +375,10 @@ found:
/* Add the environment if it is not already referenced */
if (!scopefound) {
len = janet_v_count(scope->envs);
janet_v_push(scope->envs, envindex);
JanetEnvRef ref;
ref.envindex = envindex;
ref.scope = original_scope;
janet_v_push(scope->envs, ref);
envindex = len;
}
}
@@ -408,6 +422,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
int32_t i;
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
for (i = 0; i < len; i++) {
janet_v_push(ret, janetc_value(subopts, vals[i]));
}
@@ -418,6 +433,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
const JanetKV *kvs = NULL;
int32_t cap = 0, len = 0;
janet_dictionary_view(ds, &kvs, &len, &cap);
@@ -868,7 +884,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Copy envs */
def->environments_length = janet_v_count(scope->envs);
def->environments = janet_v_flatten(scope->envs);
def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
for (int32_t i = 0; i < def->environments_length; i++) {
def->environments[i] = scope->envs[i].envindex;
}
def->constants_length = janet_v_count(scope->consts);
def->constants = janet_v_flatten(scope->consts);
@@ -923,6 +942,50 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
def->closure_bitset = chunks;
}
/* Capture symbol to local mapping */
JanetSymbolMap *locals = NULL;
/* Symbol -> upvalue mapping */
JanetScope *top = c->scope;
while (top->parent) top = top->parent;
for (JanetScope *s = top; s != NULL; s = s->child) {
for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
JanetEnvRef ref = scope->envs[j];
JanetScope *upscope = ref.scope;
if (upscope != s) continue;
for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
SymPair pair = upscope->syms[i];
if (pair.sym2) {
JanetSymbolMap jsm;
jsm.birth_pc = UINT32_MAX;
jsm.death_pc = j;
jsm.slot_index = pair.slot.index;
jsm.symbol = pair.sym2;
janet_v_push(locals, jsm);
}
}
}
}
/* Symbol -> slot mapping */
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
SymPair pair = scope->syms[i];
if (pair.sym2) {
if (pair.death_pc == UINT32_MAX) {
pair.death_pc = def->bytecode_length;
}
JanetSymbolMap jsm;
jsm.birth_pc = pair.birth_pc;
jsm.death_pc = pair.death_pc;
jsm.slot_index = pair.slot.index;
jsm.symbol = pair.sym2;
janet_v_push(locals, jsm);
}
}
def->symbolmap_length = janet_v_count(locals);
def->symbolmap = janet_v_flatten(locals);
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
/* Pop the scope */
janetc_popscope(c);

View File

@@ -111,13 +111,21 @@ struct JanetSlot {
typedef struct SymPair {
JanetSlot slot;
const uint8_t *sym;
const uint8_t *sym2;
int keep;
uint32_t birth_pc;
uint32_t death_pc;
} SymPair;
typedef struct JanetEnvRef {
int32_t envindex;
JanetScope *scope;
} JanetEnvRef;
/* A lexical scope during compilation */
struct JanetScope {
/* For debugging */
/* For debugging the compiler */
const char *name;
/* Scopes are doubly linked list */
@@ -133,7 +141,7 @@ struct JanetScope {
/* FuncDefs */
JanetFuncDef **defs;
/* Regsiter allocator */
/* Register allocator */
JanetcRegisterAllocator ra;
/* Upvalue allocator */
@@ -142,7 +150,7 @@ struct JanetScope {
/* Referenced closure environments. The values at each index correspond
* to which index to get the environment from in the parent. The environment
* that corresponds to the direct parent's stack will always have value 0. */
int32_t *envs;
JanetEnvRef *envs;
int32_t bytecode_start;
int flags;
@@ -179,6 +187,7 @@ struct JanetCompiler {
#define JANET_FOPTS_TAIL 0x10000
#define JANET_FOPTS_HINT 0x20000
#define JANET_FOPTS_DROP 0x40000
#define JANET_FOPTS_ACCEPT_SPLICE 0x80000
/* Options for compiling a single form */
struct JanetFopts {
@@ -227,7 +236,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
/* Get a bunch of slots for function arguments */
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
/* Push slots load via janetc_toslots. */
/* Push slots loaded via janetc_toslots. */
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
/* Free slots loaded via janetc_toslots */

View File

@@ -43,6 +43,7 @@ extern size_t janet_core_image_size;
#endif
JanetModule janet_native(const char *name, const uint8_t **error) {
janet_sandbox_assert(JANET_SANDBOX_DYNAMIC_MODULES);
char *processed_name = get_processed_name(name);
Clib lib = load_clib(processed_name);
JanetModule init;
@@ -652,9 +653,9 @@ JANET_CORE_FN(janet_core_signal,
JANET_CORE_FN(janet_core_memcmp,
"(memcmp a b &opt len offset-a offset-b)",
"Compare memory. Takes to byte sequences `a` and `b`, and "
"Compare memory. Takes two byte sequences `a` and `b`, and "
"return 0 if they have identical contents, a negative integer if a is less than b, "
"and a positive integer if a is greather than b. Optionally take a length and offsets "
"and a positive integer if a is greater than b. Optionally take a length and offsets "
"to compare slices of the bytes sequences.") {
janet_arity(argc, 2, 5);
JanetByteView a = janet_getbytes(argv, 0);
@@ -667,6 +668,64 @@ JANET_CORE_FN(janet_core_memcmp,
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
}
typedef struct SandboxOption {
const char *name;
uint32_t flag;
} SandboxOption;
static const SandboxOption sandbox_options[] = {
{"all", JANET_SANDBOX_ALL},
{"env", JANET_SANDBOX_ENV},
{"ffi", JANET_SANDBOX_FFI},
{"fs", JANET_SANDBOX_FS},
{"fs-read", JANET_SANDBOX_FS_READ},
{"fs-temp", JANET_SANDBOX_FS_TEMP},
{"fs-write", JANET_SANDBOX_FS_WRITE},
{"hrtime", JANET_SANDBOX_HRTIME},
{"modules", JANET_SANDBOX_DYNAMIC_MODULES},
{"net", JANET_SANDBOX_NET},
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
JANET_CORE_FN(janet_core_sandbox,
"(sandbox & forbidden-capabilities)",
"Disable feature sets to prevent the interpreter from using certain system resources. "
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
"* :env - disallow reading and write env variables\n"
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :fs - disallow access to the file system\n"
"* :fs-read - disallow read access to the file system\n"
"* :fs-temp - disallow creating temporary files\n"
"* :fs-write - disallow write access to the file system\n"
"* :hrtime - disallow high-resolution timers\n"
"* :modules - disallow load dynamic modules (natives)\n"
"* :net - disallow network access\n"
"* :net-connect - disallow making outbound network connections\n"
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
JanetKeyword kw = janet_getkeyword(argv, i);
const SandboxOption *opt = sandbox_options;
while (opt->name != NULL) {
if (janet_cstrcmp(kw, opt->name) == 0) {
flags |= opt->flag;
break;
}
opt++;
}
if (opt->name == NULL) janet_panicf("unknown capability %v", argv[i]);
}
janet_sandbox(flags);
return janet_wrap_nil();
}
#ifdef JANET_BOOTSTRAP
/* Utility for inline assembly */
@@ -970,6 +1029,7 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),
JANET_CORE_REG("sandbox", janet_core_sandbox),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, corelib_cfuns);

View File

@@ -131,9 +131,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
if (!wrote_error) {
JanetFiberStatus status = janet_fiber_status(fiber);
janet_eprintf("%s%s: %s\n",
prefix,
prefix ? prefix : "",
janet_status_names[status],
errstr);
errstr ? errstr : janet_status_names[status]);
wrote_error = 1;
}
@@ -329,6 +329,27 @@ static Janet doframe(JanetStackFrame *frame) {
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
slots->count = def->slotcount;
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
/* Add local bindings */
if (def->symbolmap) {
JanetTable *local_bindings = janet_table(0);
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
JanetSymbolMap jsm = def->symbolmap[i];
Janet value = janet_wrap_nil();
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
if (jsm.birth_pc == UINT32_MAX) {
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
if (env->offset > 0) {
value = env->as.fiber->data[env->offset + jsm.slot_index];
} else {
value = env->as.values[jsm.slot_index];
}
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
value = stack[jsm.slot_index];
}
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
}
janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
}
}
return janet_wrap_table(t);
}

View File

@@ -172,6 +172,9 @@ static JanetTimestamp ts_now(void);
/* Get current timestamp + an interval (millisecond precision) */
static JanetTimestamp ts_delta(JanetTimestamp ts, double delta) {
if (isinf(delta)) {
return delta < 0 ? ts : INT64_MAX;
}
ts += (int64_t)round(delta * 1000);
return ts;
}
@@ -469,8 +472,12 @@ const JanetAbstractType janet_stream_type = {
/* Register a fiber to resume with value */
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
Janet task_element = janet_wrap_fiber(fiber);
janet_table_put(&janet_vm.active_tasks, task_element, janet_wrap_true());
}
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
}
@@ -556,6 +563,7 @@ void janet_ev_init_common(void) {
janet_vm.tq_count = 0;
janet_vm.tq_capacity = 0;
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
janet_table_init_raw(&janet_vm.active_tasks, 0);
janet_rng_seed(&janet_vm.ev_rng, 0);
#ifndef JANET_WINDOWS
pthread_attr_init(&janet_vm.new_thread_attr);
@@ -570,13 +578,15 @@ void janet_ev_deinit_common(void) {
janet_free(janet_vm.listeners);
janet_vm.listeners = NULL;
janet_table_deinit(&janet_vm.threaded_abstracts);
janet_table_deinit(&janet_vm.active_tasks);
#ifndef JANET_WINDOWS
pthread_attr_destroy(&janet_vm.new_thread_attr);
#endif
}
/* Short hand to yield to event loop */
/* Shorthand to yield to event loop */
void janet_await(void) {
/* Store the fiber in a gobal table */
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
}
@@ -662,19 +672,6 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) {
janet_os_mutex_init((JanetOSMutex *) &chan->lock);
}
static void janet_chan_deinit(JanetChannel *chan) {
janet_q_deinit(&chan->read_pending);
janet_q_deinit(&chan->write_pending);
if (janet_chan_is_threaded(chan)) {
Janet item;
while (!janet_q_pop(&chan->items, &item, sizeof(item))) {
janet_chan_unpack(chan, &item, 1);
}
}
janet_q_deinit(&chan->items);
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
}
static void janet_chan_lock(JanetChannel *chan) {
if (!janet_chan_is_threaded(chan)) return;
janet_os_mutex_lock((JanetOSMutex *) &chan->lock);
@@ -685,6 +682,25 @@ static void janet_chan_unlock(JanetChannel *chan) {
janet_os_mutex_unlock((JanetOSMutex *) &chan->lock);
}
static void janet_chan_deinit(JanetChannel *chan) {
if (janet_chan_is_threaded(chan)) {
Janet item;
janet_chan_lock(chan);
janet_q_deinit(&chan->read_pending);
janet_q_deinit(&chan->write_pending);
while (!janet_q_pop(&chan->items, &item, sizeof(item))) {
janet_chan_unpack(chan, &item, 1);
}
janet_q_deinit(&chan->items);
janet_chan_unlock(chan);
} else {
janet_q_deinit(&chan->read_pending);
janet_q_deinit(&chan->write_pending);
janet_q_deinit(&chan->items);
}
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
}
/*
* Janet Channel abstract type
*/
@@ -761,6 +777,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
int mode = msg.tag;
JanetChannel *channel = (JanetChannel *) msg.argp;
Janet x = msg.argj;
janet_chan_lock(channel);
if (fiber->sched_id == sched_id) {
if (mode == JANET_CP_MODE_CHOICE_READ) {
janet_assert(!janet_chan_unpack(channel, &x, 0), "packing error");
@@ -781,7 +798,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
if (is_read) {
JanetChannelPending reader;
janet_chan_lock(channel);
if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
JanetVM *vm = reader.thread;
JanetEVGenericMessage msg;
@@ -792,10 +808,8 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argj = x;
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
janet_chan_unlock(channel);
} else {
JanetChannelPending writer;
janet_chan_lock(channel);
if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
JanetVM *vm = writer.thread;
JanetEVGenericMessage msg;
@@ -806,21 +820,21 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argj = janet_wrap_nil();
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
janet_chan_unlock(channel);
}
}
janet_chan_unlock(channel);
}
/* Push a value to a channel, and return 1 if channel should block, zero otherwise.
* If the push would block, will add to the write_pending queue in the channel.
* Handles both threaded and unthreaded channels. */
static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode) {
JanetChannelPending reader;
int is_empty;
if (janet_chan_pack(channel, &x)) {
janet_chan_unlock(channel);
janet_panicf("failed to pack value for channel: %v", x);
}
janet_chan_lock(channel);
if (channel->closed) {
janet_chan_unlock(channel);
janet_panic("cannot write to closed channel");
@@ -881,12 +895,16 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
return 0;
}
static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
janet_chan_lock(channel);
return janet_channel_push_with_lock(channel, x, mode);
}
/* Pop from a channel - returns 1 if item was obtained, 0 otherwise. The item
* is returned by reference. If the pop would block, will add to the read_pending
* queue in the channel. */
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) {
static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int is_choice) {
JanetChannelPending writer;
janet_chan_lock(channel);
if (channel->closed) {
janet_chan_unlock(channel);
*item = janet_wrap_nil();
@@ -931,6 +949,11 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
return 1;
}
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) {
janet_chan_lock(channel);
return janet_channel_pop_with_lock(channel, item, is_choice);
}
JanetChannel *janet_channel_unwrap(void *abstract) {
return abstract;
}
@@ -973,13 +996,32 @@ JANET_CORE_FN(cfun_channel_pop,
janet_await();
}
static void chan_unlock_args(const Janet *argv, int32_t n) {
for (int32_t i = 0; i < n; i++) {
int32_t len;
const Janet *data;
JanetChannel *chan;
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
chan = janet_getchannel(data, 0);
} else {
chan = janet_getchannel(argv, i);
}
janet_chan_unlock(chan);
}
}
JANET_CORE_FN(cfun_channel_choice,
"(ev/select & clauses)",
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan], [:take chan x], or [:close chan], where "
"a :give tuple is the result of a write and :take tuple is the result of a read. Each clause must be either a channel (for "
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
"clauses will take precedence over later clauses. Both and give and take operations can return a [:close chan] tuple, which indicates that "
"the specified channel was closed while waiting, or that the channel was already closed.") {
"Block until the first of several channel operations occur. Returns a "
"tuple of the form [:give chan], [:take chan x], or [:close chan], "
"where a :give tuple is the result of a write and a :take tuple is the "
"result of a read. Each clause must be either a channel (for a channel "
"take operation) or a tuple [channel x] (for a channel give operation). "
"Operations are tried in order such that earlier clauses take "
"precedence over later clauses. Both give and take operations can "
"return a [:close chan] tuple, which indicates that the specified "
"channel was closed while waiting, or that the channel was already "
"closed.") {
janet_arity(argc, 1, -1);
int32_t len;
const Janet *data;
@@ -992,29 +1034,29 @@ JANET_CORE_FN(cfun_channel_choice,
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
chan_unlock_args(argv, i);
return make_close_result(chan);
}
if (janet_q_count(&chan->items) < chan->limit) {
janet_chan_unlock(chan);
janet_channel_push(chan, data[1], 1);
janet_channel_push_with_lock(chan, data[1], 1);
chan_unlock_args(argv, i);
return make_write_result(chan);
}
janet_chan_unlock(chan);
} else {
/* Read */
JanetChannel *chan = janet_getchannel(argv, i);
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
chan_unlock_args(argv, i);
return make_close_result(chan);
}
if (chan->items.head != chan->items.tail) {
Janet item;
janet_chan_unlock(chan);
janet_channel_pop(chan, &item, 1);
janet_channel_pop_with_lock(chan, &item, 1);
chan_unlock_args(argv, i);
return make_read_result(chan, item);
}
janet_chan_unlock(chan);
}
}
@@ -1023,12 +1065,12 @@ JANET_CORE_FN(cfun_channel_choice,
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
/* Write */
JanetChannel *chan = janet_getchannel(data, 0);
janet_channel_push(chan, data[1], 1);
janet_channel_push_with_lock(chan, data[1], 1);
} else {
/* Read */
Janet item;
JanetChannel *chan = janet_getchannel(argv, i);
janet_channel_pop(chan, &item, 1);
janet_channel_pop_with_lock(chan, &item, 1);
}
}
@@ -1249,16 +1291,7 @@ JanetFiber *janet_loop1(void) {
while (peek_timeout(&to) && to.when <= now) {
pop_timeout(0);
if (to.curr_fiber != NULL) {
/* This is a deadline (for a fiber, not a function call) */
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
int isFinished = (s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (!isFinished) {
if (janet_fiber_can_resume(to.curr_fiber)) {
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
}
} else {
@@ -1282,6 +1315,9 @@ JanetFiber *janet_loop1(void) {
if (task.expected_sched_id != task.fiber->sched_id) continue;
Janet res;
JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig);
if (!janet_fiber_can_resume(task.fiber)) {
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(task.fiber));
}
void *sv = task.fiber->supervisor_channel;
int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT;
if (is_suspended) {
@@ -1313,15 +1349,8 @@ JanetFiber *janet_loop1(void) {
/* Drop timeouts that are no longer needed */
while ((has_timeout = peek_timeout(&to))) {
if (to.curr_fiber != NULL) {
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
int is_finished = (s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (is_finished) {
if (!janet_fiber_can_resume(to.curr_fiber)) {
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
pop_timeout(0);
continue;
}
@@ -2212,9 +2241,9 @@ typedef struct {
JanetReadMode mode;
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
DWORD flags;
struct sockaddr from;
int fromlen;
#endif
@@ -2273,7 +2302,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
state->wbuf.len = (ULONG) chunk_size;
state->wbuf.buf = state->chunk_buf;
state->wbuf.buf = (char *) state->chunk_buf;
status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
@@ -2288,8 +2317,8 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
state->overlapped.Offset = (DWORD) state->bytes_read;
status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
if (!status && (ERROR_IO_PENDING != GetLastError())) {
if (GetLastError() == ERROR_BROKEN_PIPE) {
if (state->bytes_read) {
janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
} else {
@@ -2441,9 +2470,9 @@ typedef struct {
void *dest_abst;
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
DWORD flags;
#endif
#else
int flags;
@@ -2528,7 +2557,7 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped);
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
if (!status && (ERROR_IO_PENDING != GetLastError())) {
janet_cancel(s->fiber, janet_ev_lasterr());
return JANET_ASYNC_STATUS_DONE;
}
@@ -2664,15 +2693,15 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
* so we lift from the windows source code and modify for our own version.
*/
JanetHandle shandle, chandle;
UCHAR PipeNameBuffer[MAX_PATH];
CHAR PipeNameBuffer[MAX_PATH];
SECURITY_ATTRIBUTES saAttr;
memset(&saAttr, 0, sizeof(saAttr));
saAttr.nLength = sizeof(saAttr);
saAttr.bInheritHandle = TRUE;
sprintf(PipeNameBuffer,
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
GetCurrentProcessId(),
InterlockedIncrement(&PipeSerialNumber));
(unsigned int) GetCurrentProcessId(),
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
/* server handle goes to subprocess */
shandle = CreateNamedPipeA(
@@ -2728,7 +2757,7 @@ error:
JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber-or-fun &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped"
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
"with `fiber/new` first. "
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as a supervisor. When various "
@@ -2775,6 +2804,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
uint32_t flags = args.tag;
args.tag = 0;
janet_init();
janet_vm.sandbox_flags = (uint32_t) args.argi;
JanetTryState tstate;
JanetSignal signal = janet_try(&tstate);
if (!signal) {
@@ -2927,19 +2957,19 @@ JANET_CORE_FN(cfun_ev_thread,
JanetEVGenericMessage arguments;
memset(&arguments, 0, sizeof(arguments));
arguments.tag = (uint32_t) flags;
arguments.argi = argc;
arguments.argi = (uint32_t) janet_vm.sandbox_flags;
arguments.argp = buffer;
arguments.fiber = NULL;
janet_ev_threaded_call(janet_go_thread_subr, arguments, janet_ev_default_threaded_callback);
return janet_wrap_nil();
} else {
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, argc, buffer);
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, (uint32_t) janet_vm.sandbox_flags, buffer);
}
}
JANET_CORE_FN(cfun_ev_give_supervisor,
"(ev/give-supervisor tag & payload)",
"Send a message to the current supervior channel if there is one. The message will be a "
"Send a message to the current supervisor channel if there is one. The message will be a "
"tuple of all of the arguments combined into a single message, where the first element is tag. "
"By convention, tag should be a keyword indicating the type of message. Returns nil.") {
janet_arity(argc, 1, -1);
@@ -3170,6 +3200,20 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
return argv[0];
}
JANET_CORE_FN(janet_cfun_ev_all_tasks,
"(ev/all-tasks)",
"Get an array of all active fibers that are being used by the scheduler.") {
janet_fixarity(argc, 0);
(void) argv;
JanetArray *array = janet_array(janet_vm.active_tasks.count);
for (int32_t i = 0; i < janet_vm.active_tasks.capacity; i++) {
if (!janet_checktype(janet_vm.active_tasks.data[i].key, JANET_NIL)) {
janet_array_push(array, janet_vm.active_tasks.data[i].key);
}
}
return janet_wrap_array(array);
}
void janet_lib_ev(JanetTable *env) {
JanetRegExt ev_cfuns_ext[] = {
JANET_CORE_REG("ev/give", cfun_channel_push),
@@ -3200,6 +3244,7 @@ void janet_lib_ev(JanetTable *env) {
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
JANET_REG_END
};

View File

@@ -61,4 +61,9 @@
#define _NETBSD_SOURCE
#endif
/* Needed for several things when building with -std=c99. */
#if !__BSD_VISIBLE && defined(__DragonFly__)
#define __BSD_VISIBLE 1
#endif
#endif

View File

@@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "gc.h"
#endif
#ifdef JANET_FFI
@@ -309,6 +310,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) {
if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID;
if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL;
if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR;
if (!janet_cstrcmp(name, "pointer")) return JANET_FFI_TYPE_PTR;
if (!janet_cstrcmp(name, "string")) return JANET_FFI_TYPE_STRING;
if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT;
if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE;
@@ -838,7 +840,6 @@ JANET_CORE_FN(cfun_ffi_signature,
}
/* Add reference items */
size_t old_stack_count = stack_count;
stack_count += 2 * ref_stack_count;
if (stack_count & 0x1) {
stack_count++;
@@ -1179,7 +1180,13 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
/* hack to get proper stack placement and avoid clobbering from logic above - shift stack down, otherwise we have issues.
* Technically, this writes into 16 bytes of unallocated stack memory */
#ifdef JANET_MINGW
#pragma GCC diagnostic ignored "-Wstringop-overflow"
#endif
if (stack_size) memmove(stack - stack_shift, stack, stack_size);
#ifdef JANET_MINGW
#pragma GCC diagnostic pop
#endif
switch (signature->variant) {
default:
@@ -1296,6 +1303,7 @@ JANET_CORE_FN(cfun_ffi_jitfn,
"(ffi/jitfn bytes)",
"Create an abstract type that can be used as the pointer argument to `ffi/call`. The content "
"of `bytes` is architecture specific machine code that will be copied into executable memory.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_fixarity(argc, 1);
JanetByteView bytes = janet_getbytes(argv, 0);
@@ -1303,7 +1311,11 @@ JANET_CORE_FN(cfun_ffi_jitfn,
size_t alloc_size = ((size_t) bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
#ifdef JANET_FFI_JIT
#ifdef JANET_EV
JanetFFIJittedFn *fn = janet_abstract_threaded(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
#else
JanetFFIJittedFn *fn = janet_abstract(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
#endif
fn->function_pointer = NULL;
fn->size = 0;
#ifdef JANET_WINDOWS
@@ -1344,6 +1356,7 @@ JANET_CORE_FN(cfun_ffi_call,
"(ffi/call pointer signature & args)",
"Call a raw pointer as a function pointer. The function signature specifies "
"how Janet values in `args` are converted to native machine types.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_arity(argc, 2, -1);
void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
@@ -1364,18 +1377,25 @@ JANET_CORE_FN(cfun_ffi_call,
}
JANET_CORE_FN(cfun_ffi_buffer_write,
"(ffi/write ffi-type data &opt buffer)",
"Append a native tyep to a buffer such as it would appear in memory. This can be used "
"(ffi/write ffi-type data &opt buffer index)",
"Append a native type to a buffer such as it would appear in memory. This can be used "
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
janet_arity(argc, 2, 3);
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_arity(argc, 2, 4);
JanetFFIType type = decode_ffi_type(argv[0]);
uint32_t el_size = (uint32_t) type_size(type);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size);
int32_t index = janet_optnat(argv, argc, 3, 0);
int32_t old_count = buffer->count;
if (index > old_count) janet_panic("index out of bounds");
buffer->count = index;
janet_buffer_extra(buffer, el_size);
memset(buffer->data, 0, el_size);
janet_ffi_write_one(buffer->data, argv, 1, type, JANET_FFI_MAX_RECUR);
buffer->count += el_size;
buffer->count = old_count;
memset(buffer->data + index, 0, el_size);
janet_ffi_write_one(buffer->data + index, argv, 1, type, JANET_FFI_MAX_RECUR);
index += el_size;
if (buffer->count < index) buffer->count = index;
return janet_wrap_buffer(buffer);
}
@@ -1384,6 +1404,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read,
"Parse a native struct out of a buffer and convert it to normal Janet data structures. "
"This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although "
"this is unsafe.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_arity(argc, 2, 3);
JanetFFIType type = decode_ffi_type(argv[0]);
size_t offset = (size_t) janet_optnat(argv, argc, 2, 0);
@@ -1430,6 +1451,7 @@ JANET_CORE_FN(janet_core_raw_native,
" or run any code from it. This is different than `native`, which will "
"run initialization code to get a module table. If `path` is nil, opens the current running binary. "
"Returns a `core/native`.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_arity(argc, 0, 1);
const char *path = janet_optcstring(argv, argc, 0, NULL);
Clib lib = load_clib(path);
@@ -1445,6 +1467,7 @@ JANET_CORE_FN(janet_core_native_lookup,
"(ffi/lookup native symbol-name)",
"Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
"if the symbol is found, else nil.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_fixarity(argc, 2);
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
const char *sym = janet_getcstring(argv, 1);
@@ -1458,6 +1481,7 @@ JANET_CORE_FN(janet_core_native_close,
"(ffi/close native)",
"Free a native object. Dereferencing pointers to symbols in the object will have undefined "
"behavior after freeing.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_fixarity(argc, 1);
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
if (anative->closed) janet_panic("native object already closed");
@@ -1469,23 +1493,42 @@ JANET_CORE_FN(janet_core_native_close,
JANET_CORE_FN(cfun_ffi_malloc,
"(ffi/malloc size)",
"Allocates memory directly using the system memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
"Allocates memory directly using the janet memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_fixarity(argc, 1);
size_t size = janet_getsize(argv, 0);
if (size == 0) return janet_wrap_nil();
return janet_wrap_pointer(malloc(size));
return janet_wrap_pointer(janet_malloc(size));
}
JANET_CORE_FN(cfun_ffi_free,
"(ffi/free pointer)",
"Free memory allocated with `ffi/malloc`.") {
"Free memory allocated with `ffi/malloc`. Returns nil.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_fixarity(argc, 1);
if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
void *pointer = janet_getpointer(argv, 0);
free(pointer);
janet_free(pointer);
return janet_wrap_nil();
}
JANET_CORE_FN(cfun_ffi_pointer_buffer,
"(ffi/pointer-buffer pointer capacity &opt count offset)",
"Create a buffer from a pointer. The underlying memory of the buffer will not be "
"reallocated or freed by the garbage collector, allowing unmanaged, mutable memory "
"to be manipulated with buffer functions. Attempts to resize or extend the buffer "
"beyond its initial capacity will raise an error. As with many FFI functions, this is memory "
"unsafe and can potentially allow out of bounds memory access. Returns a new buffer.") {
janet_sandbox_assert(JANET_SANDBOX_FFI);
janet_arity(argc, 2, 4);
void *pointer = janet_getpointer(argv, 0);
int32_t capacity = janet_getnat(argv, 1);
int32_t count = janet_optnat(argv, argc, 2, 0);
int64_t offset = janet_optinteger64(argv, argc, 3, 0);
uint8_t *offset_pointer = ((uint8_t *) pointer) + offset;
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
}
void janet_lib_ffi(JanetTable *env) {
JanetRegExt ffi_cfuns[] = {
JANET_CORE_REG("ffi/native", janet_core_raw_native),
@@ -1502,6 +1545,7 @@ void janet_lib_ffi(JanetTable *env) {
JANET_CORE_REG("ffi/jitfn", cfun_ffi_jitfn),
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
JANET_CORE_REG("ffi/free", cfun_ffi_free),
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, ffi_cfuns);

View File

@@ -495,6 +495,8 @@ JANET_CORE_FN(cfun_fiber_new,
"* :t - block termination signals: error + user[0-4]\n"
"* :u - block user signals\n"
"* :y - block yield signals\n"
"* :w - block await signals (user9)\n"
"* :r - block interrupt signals (user8)\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"
@@ -518,7 +520,7 @@ JANET_CORE_FN(cfun_fiber_new,
} else {
switch (view.bytes[i]) {
default:
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]);
break;
case 'a':
fiber->flags |=
@@ -548,6 +550,12 @@ JANET_CORE_FN(cfun_fiber_new,
case 'y':
fiber->flags |= JANET_FIBER_MASK_YIELD;
break;
case 'w':
fiber->flags |= JANET_FIBER_MASK_USER9;
break;
case 'r':
fiber->flags |= JANET_FIBER_MASK_USER8;
break;
case 'i':
if (!janet_vm.fiber->env) {
janet_vm.fiber->env = janet_table(0);
@@ -575,7 +583,9 @@ JANET_CORE_FN(cfun_fiber_status,
"* :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"
"* :user(0-7) - the fiber is suspended by a user signal\n"
"* :interrupted - the fiber was interrupted\n"
"* :suspended - the fiber is waiting to be resumed by the scheduler\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);
@@ -625,11 +635,7 @@ JANET_CORE_FN(cfun_fiber_setmaxstack,
return argv[0];
}
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);
int janet_fiber_can_resume(JanetFiber *fiber) {
JanetFiberStatus s = janet_fiber_status(fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
@@ -638,7 +644,15 @@ JANET_CORE_FN(cfun_fiber_can_resume,
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
return janet_wrap_boolean(!isFinished);
return !isFinished;
}
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);
return janet_wrap_boolean(janet_fiber_can_resume(fiber));
}
JANET_CORE_FN(cfun_fiber_last_value,

View File

@@ -209,6 +209,12 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
janet_mark_string(def->source);
if (def->name)
janet_mark_string(def->name);
if (def->symbolmap) {
for (int i = 0; i < def->symbolmap_length; i++) {
janet_mark_string(def->symbolmap[i].symbol);
}
}
}
static void janet_mark_function(JanetFunction *func) {
@@ -314,6 +320,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_free(def->bytecode);
janet_free(def->sourcemap);
janet_free(def->closure_bitset);
janet_free(def->symbolmap);
}
break;
}

View File

@@ -502,6 +502,18 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
return janet_wrap_abstract(box);
}
OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -)
@@ -509,6 +521,7 @@ OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
@@ -521,6 +534,7 @@ OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /)
DIVMETHODINVERT(uint64_t, u64, modi, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
@@ -542,9 +556,9 @@ static JanetMethod it_s64_methods[] = {
{"/", cfun_it_s64_div},
{"r/", cfun_it_s64_divi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
{"r%", cfun_it_s64_rem},
{"r%", cfun_it_s64_remi},
{"&", cfun_it_s64_and},
{"r&", cfun_it_s64_and},
{"|", cfun_it_s64_or},
@@ -567,9 +581,9 @@ static JanetMethod it_u64_methods[] = {
{"/", cfun_it_u64_div},
{"r/", cfun_it_u64_divi},
{"mod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_modi},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_mod},
{"r%", cfun_it_u64_modi},
{"&", cfun_it_u64_and},
{"r&", cfun_it_u64_and},
{"|", cfun_it_u64_or},

View File

@@ -69,12 +69,15 @@ static int32_t checkflags(const uint8_t *str) {
break;
case 'w':
flags |= JANET_FILE_WRITE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'a':
flags |= JANET_FILE_APPEND;
janet_sandbox_assert(JANET_SANDBOX_FS);
break;
case 'r':
flags |= JANET_FILE_READ;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
break;
}
for (i = 1; i < len; i++) {
@@ -84,6 +87,7 @@ static int32_t checkflags(const uint8_t *str) {
break;
case '+':
if (flags & JANET_FILE_UPDATE) return -1;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
flags |= JANET_FILE_UPDATE;
break;
case 'b':
@@ -116,6 +120,7 @@ JANET_CORE_FN(cfun_io_temp,
"(file/temp)",
"Open an anonymous temporary file that is removed on close. "
"Raises an error on failure.") {
janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
(void)argv;
janet_fixarity(argc, 0);
// XXX use mkostemp when we can to avoid CLOEXEC race.
@@ -148,6 +153,7 @@ JANET_CORE_FN(cfun_io_fopen,
flags = checkflags(fmode);
} else {
fmode = (const uint8_t *)"r";
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
@@ -243,6 +249,13 @@ JANET_CORE_FN(cfun_io_fwrite,
return argv[0];
}
static void io_assert_writeable(JanetFile *iof) {
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
}
/* Flush the bytes in the file */
JANET_CORE_FN(cfun_io_fflush,
"(file/flush f)",
@@ -250,10 +263,7 @@ JANET_CORE_FN(cfun_io_fflush,
"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)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
io_assert_writeable(iof);
if (fflush(iof->file))
janet_panic("could not flush file");
return argv[0];
@@ -269,6 +279,7 @@ int janet_file_close(JanetFile *file) {
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
ret = fclose(file->file);
file->flags |= JANET_FILE_CLOSED;
file->file = NULL; /* NULL derefence is easier to debug then other problems */
return ret;
}
return 0;
@@ -337,11 +348,24 @@ JANET_CORE_FN(cfun_io_fseek,
return argv[0];
}
JANET_CORE_FN(cfun_io_ftell,
"(file/tell f)",
"Get the current value of the file position for file `f`.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long pos = ftell(iof->file);
if (pos == -1) janet_panic("error getting position in file");
return janet_wrap_number((double)pos);
}
static JanetMethod io_file_methods[] = {
{"close", cfun_io_fclose},
{"flush", cfun_io_fflush},
{"read", cfun_io_fread},
{"seek", cfun_io_fseek},
{"tell", cfun_io_ftell},
{"write", cfun_io_fwrite},
{NULL, NULL}
};
@@ -449,6 +473,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
JanetFile *iofile = abstract;
io_assert_writeable(iofile);
f = iofile->file;
break;
}
@@ -564,6 +589,10 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
JanetFile *iofile = abstract;
if (iofile->flags & JANET_FILE_CLOSED) {
janet_panic("cannot print to closed file");
}
io_assert_writeable(iofile);
f = iofile->file;
break;
}
@@ -688,6 +717,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
if (janet_abstract_type(abstract) != &janet_file_type)
break;
JanetFile *iofile = abstract;
io_assert_writeable(iofile);
f = iofile->file;
}
fwrite(buffer.data, buffer.count, 1, f);
@@ -718,17 +748,17 @@ JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &janet_file_type);
}
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
JanetFile *janet_makejfile(FILE *f, int flags) {
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
return makef(f, flags);
}
Janet janet_makefile(FILE *f, int flags) {
Janet janet_makefile(FILE *f, int32_t flags) {
return janet_wrap_abstract(makef(f, flags));
}
@@ -736,7 +766,7 @@ JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &janet_file_type);
}
FILE *janet_unwrapfile(Janet j, int *flags) {
FILE *janet_unwrapfile(Janet j, int32_t *flags) {
JanetFile *iof = janet_unwrap_abstract(j);
if (NULL != flags) *flags = iof->flags;
return iof->file;
@@ -766,6 +796,7 @@ void janet_lib_io(JanetTable *env) {
JANET_CORE_REG("file/write", cfun_io_fwrite),
JANET_CORE_REG("file/flush", cfun_io_fflush),
JANET_CORE_REG("file/seek", cfun_io_fseek),
JANET_CORE_REG("file/tell", cfun_io_ftell),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, io_cfuns);

View File

@@ -67,7 +67,8 @@ enum {
LB_UNSAFE_POINTER, /* 222 */
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT/* 224 */
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */
#endif
} LeadBytes;
@@ -153,6 +154,10 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
janet_buffer_push_bytes(st->buf, bytes, len);
}
static void pushpointer(MarshalState *st, void *ptr) {
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
}
/* Marshal a size_t onto the buffer */
static void push64(MarshalState *st, uint64_t x) {
if (x <= 0xF0) {
@@ -252,6 +257,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
pushint(st, def->environments_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
pushint(st, def->defs_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
pushint(st, def->symbolmap_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
marshal_one(st, janet_wrap_string(def->name), flags);
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
@@ -261,6 +268,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
for (int32_t i = 0; i < def->constants_length; i++)
marshal_one(st, def->constants[i], flags);
/* Marshal symbol map, if needed */
for (int32_t i = 0; i < def->symbolmap_length; i++) {
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
pushint(st, (int32_t) def->symbolmap[i].death_pc);
pushint(st, (int32_t) def->symbolmap[i].slot_index);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
}
/* marshal the bytecode */
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
@@ -270,7 +285,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
/* marshal the sub funcdefs if needed */
for (int32_t i = 0; i < def->defs_length; i++)
marshal_one_def(st, def->defs[i], flags);
marshal_one_def(st, def->defs[i], flags + 1);
/* marshal source maps if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
@@ -501,6 +516,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
JanetBuffer *buffer = janet_unwrap_buffer(x);
/* Record reference */
MARK_SEEN();
#ifdef JANET_EV
if ((flags & JANET_MARSHAL_UNSAFE) &&
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
pushbyte(st, LB_POINTER_BUFFER);
pushint(st, buffer->count);
pushint(st, buffer->capacity);
pushpointer(st, buffer->data);
return;
}
#endif
pushbyte(st, LB_BUFFER);
pushint(st, buffer->count);
pushbytes(st, buffer->data, buffer->count);
@@ -596,8 +621,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_POINTER);
void *ptr = janet_unwrap_pointer(x);
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
pushpointer(st, janet_unwrap_pointer(x));
return;
}
no_registry:
@@ -824,6 +848,8 @@ static const uint8_t *unmarshal_one_def(
def->constants = NULL;
def->bytecode = NULL;
def->sourcemap = NULL;
def->symbolmap = NULL;
def->symbolmap_length = 0;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -831,6 +857,7 @@ static const uint8_t *unmarshal_one_def(
int32_t constants_length = 0;
int32_t environments_length = 0;
int32_t defs_length = 0;
int32_t symbolmap_length = 0;
/* Read flags and other fixed values */
def->flags = readint(st, &data);
@@ -846,6 +873,8 @@ static const uint8_t *unmarshal_one_def(
environments_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
defs_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
symbolmap_length = readnat(st, &data);
/* Check name and source (optional) */
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
@@ -874,6 +903,26 @@ static const uint8_t *unmarshal_one_def(
}
def->constants_length = constants_length;
/* Unmarshal symbol map, if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
def->symbolmap = janet_malloc(size);
if (def->symbolmap == NULL) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < symbolmap_length; i++) {
def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
Janet value;
data = unmarshal_one(st, data, &value, flags + 1);
if (!janet_checktype(value, JANET_SYMBOL))
janet_panic("expected symbol in symbol map");
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
}
def->symbolmap_length = (uint32_t) symbolmap_length;
}
/* Unmarshal bytecode */
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
if (!def->bytecode) {
@@ -1380,6 +1429,29 @@ static const uint8_t *unmarshal_one(
janet_v_push(st->lookup, *out);
return data;
}
#ifdef JANET_EV
case LB_POINTER_BUFFER: {
data++;
int32_t count = readnat(st, &data);
int32_t capacity = readnat(st, &data);
MARSH_EOS(st, data + sizeof(void *));
union {
void *ptr;
uint8_t bytes[sizeof(void *)];
} u;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal raw pointer at index %d",
(int)(data - st->start));
}
memcpy(u.bytes, data, sizeof(void *));
data += sizeof(void *);
JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
*out = janet_wrap_buffer(buffer);
janet_v_push(st->lookup, *out);
return data;
}
#endif
case LB_UNSAFE_CFUNCTION: {
MARSH_EOS(st, data + sizeof(JanetCFunction));
data++;

View File

@@ -150,8 +150,8 @@ JANET_CORE_FN(cfun_rng_uniform,
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."
"Extract a random integer in the range [0, max) for max > 0 from the RNG. "
"If max is 0, return 0. 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);
@@ -254,43 +254,45 @@ JANET_CORE_FN(janet_srand,
return janet_wrap_nil();
}
#define JANET_DEFINE_MATHOP(name, fop, doc)\
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
#define JANET_DEFINE_NAMED_MATHOP(janet_name, fop, doc)\
JANET_CORE_FN(janet_##fop, "(math/" janet_name " x)", doc) {\
janet_fixarity(argc, 1); \
double x = janet_getnumber(argv, 0); \
return janet_wrap_number(fop(x)); \
}
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine 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(abs, 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, tgamma, "Returns gamma(x).")
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-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_MATHOP(fop, doc) JANET_DEFINE_NAMED_MATHOP(#fop, fop, doc)
JANET_DEFINE_MATHOP(acos, "Returns the arccosine of x.")
JANET_DEFINE_MATHOP(asin, "Returns the arcsin of x.")
JANET_DEFINE_MATHOP(atan, "Returns the arctangent of x.")
JANET_DEFINE_MATHOP(cos, "Returns the cosine of x.")
JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
JANET_CORE_FN(janet_##name, signature, doc) {\
@@ -303,7 +305,7 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
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.")
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
janet_fixarity(argc, 1);
@@ -315,7 +317,7 @@ static double janet_gcd(double x, double y) {
#ifdef NAN
return NAN;
#else
return 0.0 \ 0.0;
return 0.0 / 0.0;
#endif
}
if (isinf(x) || isinf(y)) return INFINITY;
@@ -368,7 +370,7 @@ void janet_lib_math(JanetTable *env) {
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_abs),
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),
@@ -383,7 +385,7 @@ void janet_lib_math(JanetTable *env) {
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/gamma", janet_tgamma),
JANET_CORE_REG("math/log-gamma", janet_lgamma),
JANET_CORE_REG("math/erfc", janet_erfc),
JANET_CORE_REG("math/erf", janet_erf),

View File

@@ -34,9 +34,11 @@
#include <windows.h>
#include <ws2tcpip.h>
#include <mswsock.h>
#ifdef JANET_MSVC
#pragma comment (lib, "Ws2_32.lib")
#pragma comment (lib, "Mswsock.lib")
#pragma comment (lib, "Advapi32.lib")
#endif
#else
#include <arpa/inet.h>
#include <unistd.h>
@@ -173,7 +175,6 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
SOCKET lsock = (SOCKET) stream->handle;
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
NetStateAccept *state = (NetStateAccept *)s;
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
@@ -333,6 +334,7 @@ JANET_CORE_FN(cfun_net_sockaddr,
"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_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
janet_arity(argc, 2, 4);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
@@ -378,6 +380,7 @@ JANET_CORE_FN(cfun_net_connect,
"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_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
janet_arity(argc, 2, 5);
/* Check arguments */
@@ -572,6 +575,7 @@ JANET_CORE_FN(cfun_net_listen,
"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_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
janet_arity(argc, 2, 3);
/* Get host, port, and handler*/
@@ -706,7 +710,7 @@ JANET_CORE_FN(cfun_net_getsockname,
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");
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
return janet_so_getname(&ss);
}
@@ -722,13 +726,13 @@ JANET_CORE_FN(cfun_net_getpeername,
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");
janet_assert(slen <= (socklen_t) 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 "
"Given an address returned by net/address, 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);
@@ -798,7 +802,7 @@ JANET_CORE_FN(cfun_stream_chunk,
}
JANET_CORE_FN(cfun_stream_recv_from,
"(net/recv-from stream nbytes buf &opt timoeut)",
"(net/recv-from stream nbytes buf &opt timeout)",
"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);

View File

@@ -118,18 +118,26 @@ JANET_CORE_FN(os_which,
"(os/which)",
"Check the current operating system. Returns one of:\n\n"
"* :windows\n\n"
"* :mingw\n\n"
"* :cygwin\n\n"
"* :macos\n\n"
"* :web - Web assembly (emscripten)\n\n"
"* :linux\n\n"
"* :freebsd\n\n"
"* :openbsd\n\n"
"* :netbsd\n\n"
"* :dragonfly\n\n"
"* :bsd\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)
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
#elif defined(JANET_MINGW)
return janet_ckeywordv("mingw");
#elif defined(JANET_CYGWIN)
return janet_ckeywordv("cygwin");
#elif defined(JANET_WINDOWS)
return janet_ckeywordv("windows");
#elif defined(JANET_APPLE)
@@ -144,6 +152,8 @@ JANET_CORE_FN(os_which,
return janet_ckeywordv("netbsd");
#elif defined(__OpenBSD__)
return janet_ckeywordv("openbsd");
#elif defined(__DragonFly__)
return janet_ckeywordv("dragonfly");
#elif defined(JANET_BSD)
return janet_ckeywordv("bsd");
#else
@@ -159,6 +169,8 @@ JANET_CORE_FN(os_arch,
"* :x64\n\n"
"* :arm\n\n"
"* :aarch64\n\n"
"* :riscv32\n\n"
"* :riscv64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :unknown\n") {
@@ -177,6 +189,10 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("aarch64");
#elif defined(_M_ARM) || defined(__arm__)
return janet_ckeywordv("arm");
#elif (defined(__riscv) && (__riscv_xlen == 64))
return janet_ckeywordv("riscv64");
#elif (defined(__riscv) && (__riscv_xlen == 32))
return janet_ckeywordv("riscv32");
#elif (defined(__sparc__))
return janet_ckeywordv("sparc");
#elif (defined(__ppc__))
@@ -188,6 +204,27 @@ JANET_CORE_FN(os_arch,
#endif
}
/* Detect the compiler used to build the interpreter */
JANET_CORE_FN(os_compiler,
"(os/compiler)",
"Get the compiler used to compile the interpreter. Returns one of:\n\n"
"* :gcc\n\n"
"* :clang\n\n"
"* :msvc\n\n"
"* :unknown\n\n") {
janet_fixarity(argc, 0);
(void) argv;
#if defined(_MSC_VER)
return janet_ckeywordv("msvc");
#elif defined(__clang__)
return janet_ckeywordv("clang");
#elif defined(__GNUC__)
return janet_ckeywordv("gcc");
#else
return janet_ckeywordv("unknown");
#endif
}
#undef janet_stringify1
#undef janet_stringify
@@ -445,7 +482,9 @@ typedef struct {
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
JanetProc *proc = (JanetProc *) args.argp;
WaitForSingleObject(proc->pHandle, INFINITE);
GetExitCodeProcess(proc->pHandle, &args.tag);
DWORD exitcode = 0;
GetExitCodeProcess(proc->pHandle, &exitcode);
args.tag = (int32_t) exitcode;
return args;
}
@@ -843,6 +882,7 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
#endif
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_arity(argc, 1, 3);
/* Get flags */
@@ -902,9 +942,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
janet_panic("failed to create pipes");
}
/* Result */
int status = 0;
#ifdef JANET_WINDOWS
HANDLE pHandle, tHandle;
@@ -983,6 +1020,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
#else
/* Result */
int status = 0;
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
for (int32_t i = 0; i < exargs.len; i++)
child_argv[i] = janet_getcstring(exargs.items, i);
@@ -1003,21 +1043,21 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
if (pipe_in != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
posix_spawn_file_actions_addclose(&actions, pipe_in);
} else if (new_in != JANET_HANDLE_NONE) {
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
posix_spawn_file_actions_addclose(&actions, new_in);
}
if (pipe_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
posix_spawn_file_actions_addclose(&actions, pipe_out);
} else if (new_out != JANET_HANDLE_NONE) {
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
posix_spawn_file_actions_addclose(&actions, new_out);
}
if (pipe_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
posix_spawn_file_actions_addclose(&actions, pipe_err);
} else if (new_err != JANET_HANDLE_NONE) {
} else if (new_err != JANET_HANDLE_NONE && new_err != 2) {
posix_spawn_file_actions_adddup2(&actions, new_err, 2);
posix_spawn_file_actions_addclose(&actions, new_err);
}
@@ -1045,7 +1085,8 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
os_execute_cleanup(envp, child_argv);
if (status) {
janet_panicf("%p: %s", argv[0], strerror(errno));
/* correct for macos bug where errno is not set */
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
}
#endif
@@ -1136,6 +1177,7 @@ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
JANET_CORE_FN(os_shell,
"(os/shell str)",
"Pass a command string str directly to the system shell.") {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_arity(argc, 0, 1);
const char *cmd = argc
? janet_getcstring(argv, 0)
@@ -1155,6 +1197,7 @@ JANET_CORE_FN(os_shell,
JANET_CORE_FN(os_environ,
"(os/environ)",
"Get a copy of the OS environment table.") {
janet_sandbox_assert(JANET_SANDBOX_ENV);
(void) argv;
janet_fixarity(argc, 0);
int32_t nenv = 0;
@@ -1186,6 +1229,7 @@ JANET_CORE_FN(os_environ,
JANET_CORE_FN(os_getenv,
"(os/getenv variable &opt dflt)",
"Get the string value of an environment variable.") {
janet_sandbox_assert(JANET_SANDBOX_ENV);
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
const char *res = getenv(cstr);
@@ -1209,6 +1253,7 @@ JANET_CORE_FN(os_setenv,
#define SETENV(K,V) setenv(K, V, 1)
#define UNSETENV(K) unsetenv(K)
#endif
janet_sandbox_assert(JANET_SANDBOX_ENV);
janet_arity(argc, 1, 2);
const char *ks = janet_getcstring(argv, 0);
const char *vs = janet_optcstring(argv, argc, 1, NULL);
@@ -1236,6 +1281,7 @@ 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_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_fixarity(argc, 0);
(void) argv;
struct timespec tv;
@@ -1305,6 +1351,40 @@ JANET_CORE_FN(os_cryptorand,
return janet_wrap_buffer(buffer);
}
/* Helper function to get given or current time as local or UTC struct tm.
* - arg n+0: optional time_t to be converted, uses current time if not given
* - arg n+1: optional truthy to indicate the convnersion uses local time */
static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct tm *t_infos) {
time_t t;
if (argc > n && !janet_checktype(argv[n], JANET_NIL)) {
int64_t integer = janet_getinteger64(argv, n);
t = (time_t) integer;
} else {
time(&t);
}
struct tm *t_info = NULL;
if (argc > n + 1 && janet_truthy(argv[n + 1])) {
/* local time */
#ifdef JANET_WINDOWS
_tzset();
localtime_s(t_infos, &t);
t_info = t_infos;
#else
tzset();
t_info = localtime_r(&t, t_infos);
#endif
} else {
/* utc time */
#ifdef JANET_WINDOWS
gmtime_s(t_infos, &t);
t_info = t_infos;
#else
t_info = gmtime_r(&t, t_infos);
#endif
}
return t_info;
}
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. "
@@ -1322,34 +1402,8 @@ JANET_CORE_FN(os_date,
"* :dst - if Day Light Savings is in effect") {
janet_arity(argc, 0, 2);
(void) argv;
time_t t;
struct tm t_infos;
struct tm *t_info = NULL;
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
int64_t integer = janet_getinteger64(argv, 0);
t = (time_t) integer;
} else {
time(&t);
}
if (argc >= 2 && janet_truthy(argv[1])) {
/* local time */
#ifdef JANET_WINDOWS
_tzset();
localtime_s(&t_infos, &t);
t_info = &t_infos;
#else
tzset();
t_info = localtime_r(&t, &t_infos);
#endif
} else {
/* utc time */
#ifdef JANET_WINDOWS
gmtime_s(&t_infos, &t);
t_info = &t_infos;
#else
t_info = gmtime_r(&t, &t_infos);
#endif
}
struct tm *t_info = time_to_tm(argv, argc, 0, &t_infos);
JanetKV *st = janet_struct_begin(9);
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
@@ -1363,6 +1417,34 @@ JANET_CORE_FN(os_date,
return janet_wrap_struct(janet_struct_end(st));
}
#define SIZETIMEFMT 250
JANET_CORE_FN(os_strftime,
"(os/strftime fmt &opt time local)",
"Format the given time as a string, or the current time if `time` is not given. "
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
"the local timezone.") {
janet_arity(argc, 1, 3);
const char *fmt = janet_getcstring(argv, 0);
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
static const char *valid = "aAbBcdHIjmMpSUwWxXyYZ%";
const char *p = fmt;
while (*p) {
if (*p++ == '%') {
if (!strchr(valid, *p)) {
janet_panicf("invalid conversion specifier '%%%c'", *p);
}
p++;
}
}
struct tm t_infos;
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
char buf[SIZETIMEFMT];
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
return janet_cstringv(buf);
}
static int entry_getdst(Janet env_entry) {
Janet v;
if (janet_checktype(env_entry, JANET_TABLE)) {
@@ -1477,6 +1559,7 @@ JANET_CORE_FN(os_link,
"Iff symlink is truthy, creates a symlink. "
"Iff symlink is falsey or not provided, "
"creates a hard link. Does not work on Windows.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_arity(argc, 2, 3);
#ifdef JANET_WINDOWS
(void) argc;
@@ -1495,6 +1578,7 @@ JANET_CORE_FN(os_link,
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_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 2);
#ifdef JANET_WINDOWS
(void) argc;
@@ -1517,6 +1601,7 @@ JANET_CORE_FN(os_mkdir,
"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_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@@ -1532,6 +1617,7 @@ JANET_CORE_FN(os_mkdir,
JANET_CORE_FN(os_rmdir,
"(os/rmdir path)",
"Delete a directory. The directory must be empty to succeed.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@@ -1546,6 +1632,7 @@ JANET_CORE_FN(os_rmdir,
JANET_CORE_FN(os_cd,
"(os/cd path)",
"Change current directory to path. Returns nil on success, errors on failure.") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@@ -1561,6 +1648,7 @@ 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_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_arity(argc, 1, 3);
const char *path = janet_getcstring(argv, 0);
struct utimbuf timebuf, *bufp;
@@ -1769,9 +1857,11 @@ static Janet os_stat_changed(jstat_t *st) {
}
#ifdef JANET_WINDOWS
static Janet os_stat_blocks(jstat_t *st) {
(void) st;
return janet_wrap_number(0);
}
static Janet os_stat_blocksize(jstat_t *st) {
(void) st;
return janet_wrap_number(0);
}
#else
@@ -1808,6 +1898,7 @@ static const struct OsStatGetter os_stat_getters[] = {
};
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, 2);
const char *path = janet_getcstring(argv, 0);
JanetTable *tab = NULL;
@@ -1859,7 +1950,7 @@ static Janet os_stat_or_lstat(int do_lstat, 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"
"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"
@@ -1889,6 +1980,7 @@ JANET_CORE_FN(os_chmod,
"`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_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 2);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
@@ -1904,6 +1996,7 @@ JANET_CORE_FN(os_chmod,
JANET_CORE_FN(os_umask,
"(os/umask mask)",
"Set a new umask, returns the old umask.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 1);
int mask = (int) os_getmode(argv, 0);
#ifdef JANET_WINDOWS
@@ -1919,6 +2012,7 @@ 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_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, 2);
const char *dir = janet_getcstring(argv, 0);
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
@@ -1956,6 +2050,7 @@ JANET_CORE_FN(os_dir,
JANET_CORE_FN(os_rename,
"(os/rename oldname newname)",
"Rename a file on disk to a new path. Returns nil.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 2);
const char *src = janet_getcstring(argv, 0);
const char *dest = janet_getcstring(argv, 1);
@@ -1969,7 +2064,8 @@ JANET_CORE_FN(os_rename,
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.") {
"Returns an absolute path as a string.") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_fixarity(argc, 1);
const char *src = janet_getcstring(argv, 0);
#ifdef JANET_NO_REALPATH
@@ -2047,6 +2143,7 @@ JANET_CORE_FN(os_open,
uint32_t stream_flags = 0;
JanetHandle fd;
#ifdef JANET_WINDOWS
(void) mode;
DWORD desiredAccess = 0;
DWORD shareMode = 0;
DWORD creationDisp = 0;
@@ -2063,19 +2160,23 @@ JANET_CORE_FN(os_open,
case 'r':
desiredAccess |= GENERIC_READ;
stream_flags |= JANET_STREAM_READABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
break;
case 'w':
desiredAccess |= GENERIC_WRITE;
stream_flags |= JANET_STREAM_WRITABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'c':
creatUnix |= OCREAT;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'e':
creatUnix |= OEXCL;
break;
case 't':
creatUnix |= OTRUNC;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
/* Windows only flags */
case 'D':
@@ -2145,19 +2246,23 @@ JANET_CORE_FN(os_open,
case 'r':
read_flag = 1;
stream_flags |= JANET_STREAM_READABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
break;
case 'w':
write_flag = 1;
stream_flags |= JANET_STREAM_WRITABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'c':
open_flags |= O_CREAT;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'e':
open_flags |= O_EXCL;
break;
case 't':
open_flags |= O_TRUNC;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
/* posix only */
case 'x':
@@ -2230,49 +2335,68 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/exit", os_exit),
JANET_CORE_REG("os/which", os_which),
JANET_CORE_REG("os/arch", os_arch),
JANET_CORE_REG("os/compiler", os_compiler),
#ifndef JANET_REDUCED_OS
/* misc (un-sandboxed) */
JANET_CORE_REG("os/cpu-count", os_cpu_count),
JANET_CORE_REG("os/cwd", os_cwd),
JANET_CORE_REG("os/cryptorand", os_cryptorand),
JANET_CORE_REG("os/perm-string", os_permission_string),
JANET_CORE_REG("os/perm-int", os_permission_int),
JANET_CORE_REG("os/mktime", os_mktime),
JANET_CORE_REG("os/time", os_time), /* not high resolution */
JANET_CORE_REG("os/date", os_date), /* not high resolution */
JANET_CORE_REG("os/strftime", os_strftime),
JANET_CORE_REG("os/sleep", os_sleep),
/* env functions */
JANET_CORE_REG("os/environ", os_environ),
JANET_CORE_REG("os/getenv", os_getenv),
JANET_CORE_REG("os/setenv", os_setenv),
/* fs read */
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/realpath", os_realpath),
JANET_CORE_REG("os/cd", os_cd),
JANET_CORE_REG("os/cpu-count", os_cpu_count),
#ifndef JANET_NO_UMASK
JANET_CORE_REG("os/umask", os_umask),
#endif
#ifndef JANET_NO_SYMLINKS
JANET_CORE_REG("os/readlink", os_readlink),
#endif
/* fs write */
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),
JANET_CORE_REG("os/rename", os_rename),
#ifndef JANET_NO_SYMLINKS
JANET_CORE_REG("os/symlink", os_symlink),
JANET_CORE_REG("os/readlink", os_readlink),
#endif
/* processes */
#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),
/* no need to sandbox process management if you can't create processes
* (allows for limited functionality if use exposes C-functions to create specific processes) */
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),
/* high resolution timers */
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/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
#endif
#endif

View File

@@ -1194,7 +1194,8 @@ static Janet parser_state_delimiters(const JanetParser *_p) {
}
}
}
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
/* avoid ptr arithmetic on NULL */
str = janet_string(oldcount ? p->buf + oldcount : p->buf, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
return janet_wrap_string(str);
}
@@ -1205,10 +1206,11 @@ static Janet parser_state_frames(const JanetParser *p) {
states->count = count;
uint8_t *buf = p->buf;
/* Iterate arg stack backwards */
Janet *args = p->args + p->argcount;
Janet *args = p->argcount ? p->args + p->argcount : p->args; /* avoid ptr arithmetic on NULL */
for (int32_t i = count - 1; i >= 0; --i) {
JanetParseState *s = p->states + i;
if (s->flags & PFLAG_CONTAINER) {
/* avoid ptr arithmetic on args if NULL */
if ((s->flags & PFLAG_CONTAINER) && s->argn) {
args -= s->argn;
}
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);

View File

@@ -1034,7 +1034,7 @@ static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
return;
error:
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[1]);
}
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
@@ -1637,7 +1637,7 @@ typedef struct {
JanetPeg *peg;
PegState s;
JanetByteView bytes;
JanetByteView repl;
Janet subst;
int32_t start;
} PegCall;
@@ -1653,7 +1653,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
ret.peg = compile_peg(argv[0]);
}
if (get_replace) {
ret.repl = janet_getbytes(argv, 1);
ret.subst = argv[1];
ret.bytes = janet_getbytes(argv, 2);
} else {
ret.bytes = janet_getbytes(argv, 1);
@@ -1738,7 +1738,8 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
trail = i;
}
int32_t nexti = (int32_t)(result - c.bytes.bytes);
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
janet_buffer_push_bytes(ret, subst.bytes, subst.len);
trail = nexti;
if (nexti == i) nexti++;
i = nexti;
@@ -1754,14 +1755,20 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
}
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.") {
"(peg/replace-all peg subst text &opt start & args)",
"Replace all matches of `peg` in `text` with `subst`, returning a new buffer. "
"The peg does not need to make captures to do replacement. "
"If `subst` is a function, it will be called with the "
"matching text followed by any captures.") {
return cfun_peg_replace_generic(argc, argv, 0);
}
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. "
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
"The peg does not need to make captures to do replacement. "
"If `subst` is a function, it will be called with the "
"matching text followed by any captures. "
"If no matches are found, returns the input string in a new buffer.") {
return cfun_peg_replace_generic(argc, argv, 1);
}

View File

@@ -109,7 +109,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
pbuf.p = pointer;
*c++ = '<';
/* Maximum of 32 bytes for abstract type name */
for (i = 0; title[i] && i < 32; ++i)
for (i = 0; i < 32 && title[i]; ++i)
*c++ = ((uint8_t *)title) [i];
*c++ = ' ';
*c++ = '0';
@@ -637,7 +637,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
}
}
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
S->keysort_start += len;
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
@@ -809,7 +809,8 @@ static const char *scanformat(
*(form++) = '%';
const char *p2 = strfrmt;
while (p2 <= p) {
if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) {
char *loc = strchr(FMT_REPLACE_INTTYPES, *p2);
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
strcpy(form, mapping);

View File

@@ -39,6 +39,10 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot ret;
if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) {
janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here");
return janetc_cslot(janet_wrap_nil());
}
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument to splice");
return janetc_cslot(janet_wrap_nil());
@@ -75,7 +79,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
const uint8_t *head = janet_unwrap_symbol(tup[0]);
if (!janet_cstrcmp(head, "unquote")) {
if (level == 0) {
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
JanetFopts subopts = janetc_fopts_default(opts.compiler);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
return janetc_value(subopts, tup[1]);
} else {
level--;
}
@@ -203,8 +209,9 @@ static int destructure(JanetCompiler *c,
janetc_emit(c, JOP_JUMP);
int32_t label_loop_exit = janet_v_count(c->buffer);
c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (label_loop_start - label_loop_loop) << 8;
/* avoid shifting negative numbers */
c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
janetc_freeslot(c, argi);
janetc_freeslot(c, arg);
@@ -487,6 +494,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Get options */
condopts = janetc_fopts_default(c);
bodyopts = opts;
bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
/* Set target for compilation */
target = (drop || tail)
@@ -563,6 +571,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
}
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
@@ -586,6 +595,7 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
}
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
@@ -958,12 +968,26 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
if (!seenopt) min_arity = arity;
/* Check for self ref */
/* Check for self ref (also avoid if arguments shadow own name) */
if (selfref) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, janet_unwrap_symbol(head), slot);
/* Check if the parameters shadow the function name. If so, don't
* emit JOP_LOAD_SELF and add a binding since that most users
* seem to expect that function parameters take precedence over the
* function name */
const uint8_t *sym = janet_unwrap_symbol(head);
int32_t len = janet_v_count(c->scope->syms);
int found = 0;
for (int32_t i = 0; i < len; i++) {
if (c->scope->syms[i].sym == sym) {
found = 1;
}
}
if (!found) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, sym, slot);
}
}
/* Compile function body */

View File

@@ -23,6 +23,7 @@
#ifndef JANET_STATE_H_defined
#define JANET_STATE_H_defined
#include <janet.h>
#include <stdint.h>
#ifdef JANET_EV
@@ -60,7 +61,7 @@ typedef struct {
int is_error;
} JanetTimeout;
/* Registry table for C functions - containts metadata that can
/* Registry table for C functions - contains metadata that can
* be looked up by cfunction pointer. All strings here are pointing to
* static memory not managed by Janet. */
typedef struct {
@@ -91,7 +92,7 @@ struct JanetVM {
int auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by janet_run. */
* Set and unset by functions in vm.c */
JanetFiber *fiber;
JanetFiber *root_fiber;
@@ -107,7 +108,7 @@ struct JanetVM {
size_t registry_count;
int registry_dirty;
/* Registry for abstract abstract types that can be marshalled.
/* Registry for abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */
JanetTable *abstract_registry;
@@ -135,6 +136,9 @@ struct JanetVM {
size_t scratch_cap;
size_t scratch_len;
/* Sandbox flags */
uint32_t sandbox_flags;
/* Random number generator */
JanetRNG rng;
@@ -155,6 +159,7 @@ struct JanetVM {
size_t listener_cap;
size_t extra_listeners;
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)

View File

@@ -364,14 +364,13 @@ JANET_CORE_FN(cfun_string_findall,
struct replace_state {
struct kmp_state kmp;
const uint8_t *subst;
int32_t substlen;
Janet subst;
};
static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
janet_arity(argc, 3, 4);
JanetByteView pat = janet_getbytes(argv, 0);
JanetByteView subst = janet_getbytes(argv, 1);
Janet subst = argv[1];
JanetByteView text = janet_getbytes(argv, 2);
int32_t start = 0;
if (argc == 4) {
@@ -380,13 +379,14 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
}
kmp_init(&s->kmp, text.bytes, text.len, pat.bytes, pat.len);
s->kmp.i = start;
s->subst = subst.bytes;
s->substlen = subst.len;
s->subst = subst;
}
JANET_CORE_FN(cfun_string_replace,
"(string/replace patt subst str)",
"Replace the first occurrence of `patt` with `subst` in the string `str`. "
"If `subst` is a function, it will be called with `patt` only if a match is found, "
"and should return the actual replacement text to use. "
"Will return the new string if `patt` is found, otherwise returns `str`.") {
int32_t result;
struct replace_state s;
@@ -397,10 +397,11 @@ JANET_CORE_FN(cfun_string_replace,
kmp_deinit(&s.kmp);
return janet_stringv(s.kmp.text, s.kmp.textlen);
}
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len);
safe_memcpy(buf, s.kmp.text, result);
safe_memcpy(buf + result, s.subst, s.substlen);
safe_memcpy(buf + result + s.substlen,
safe_memcpy(buf + result, subst.bytes, subst.len);
safe_memcpy(buf + result + subst.len,
s.kmp.text + result + s.kmp.patlen,
s.kmp.textlen - result - s.kmp.patlen);
kmp_deinit(&s.kmp);
@@ -411,6 +412,8 @@ 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. "
"If `subst` is a function, it will be called with `patt` once for each match, "
"and should return the actual replacement text to use. "
"Will return the new string if `patt` is found, otherwise returns `str`.") {
int32_t result;
struct replace_state s;
@@ -419,8 +422,9 @@ JANET_CORE_FN(cfun_string_replaceall,
replacesetup(argc, argv, &s);
janet_buffer_init(&b, s.kmp.textlen);
while ((result = kmp_next(&s.kmp)) >= 0) {
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex);
janet_buffer_push_bytes(&b, s.subst, s.substlen);
janet_buffer_push_bytes(&b, subst.bytes, subst.len);
lastindex = result + s.kmp.patlen;
kmp_seti(&s.kmp, lastindex);
}

View File

@@ -39,9 +39,11 @@
#ifdef JANET_WINDOWS
#ifdef JANET_DYNAMIC_MODULES
#include <psapi.h>
#ifdef JANET_MSVC
#pragma comment (lib, "Psapi.lib")
#endif
#endif
#endif
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
@@ -90,8 +92,8 @@ const char *const janet_signal_names[14] = {
"user5",
"user6",
"user7",
"user8",
"user9"
"interrupt",
"await"
};
const char *const janet_status_names[16] = {
@@ -107,8 +109,8 @@ const char *const janet_status_names[16] = {
"user5",
"user6",
"user7",
"user8",
"user9",
"interrupted",
"suspended",
"new",
"alive"
};
@@ -116,6 +118,7 @@ const char *const janet_status_names[16] = {
#ifndef JANET_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
if (NULL == str) return 5381;
const uint8_t *end = str + len;
uint32_t hash = 5381;
while (str < end)
@@ -660,6 +663,59 @@ JanetBinding janet_binding_from_entry(Janet entry) {
return binding;
}
/* If the value at the given address can be coerced to a byte view,
return that byte view. If it can't, replace the value at the address
with the result of janet_to_string, and return a byte view over that
string. */
static JanetByteView memoize_byte_view(Janet *value) {
JanetByteView result;
if (!janet_bytes_view(*value, &result.bytes, &result.len)) {
JanetString str = janet_to_string(*value);
*value = janet_wrap_string(str);
result.bytes = str;
result.len = janet_string_length(str);
}
return result;
}
static JanetByteView to_byte_view(Janet value) {
JanetByteView result;
if (!janet_bytes_view(value, &result.bytes, &result.len)) {
JanetString str = janet_to_string(value);
result.bytes = str;
result.len = janet_string_length(str);
}
return result;
}
JanetByteView janet_text_substitution(
Janet *subst,
const uint8_t *bytes,
uint32_t len,
JanetArray *extra_argv) {
int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count;
JanetType type = janet_type(*subst);
switch (type) {
case JANET_FUNCTION:
case JANET_CFUNCTION: {
int32_t argc = 1 + extra_argc;
Janet *argv = janet_tuple_begin(argc);
argv[0] = janet_stringv(bytes, len);
for (int32_t i = 0; i < extra_argc; i++) {
argv[i + 1] = extra_argv->data[i];
}
janet_tuple_end(argv);
if (type == JANET_FUNCTION) {
return to_byte_view(janet_call(janet_unwrap_function(*subst), argc, argv));
} else {
return to_byte_view(janet_unwrap_cfunction(*subst)(argc, argv));
}
}
default:
return memoize_byte_view(subst);
}
}
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
return janet_binding_from_entry(entry);
@@ -863,13 +919,13 @@ int janet_cryptorand(uint8_t *out, size_t n) {
unsigned int v;
if (rand_s(&v))
return -1;
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
for (int32_t j = 0; (j < (int32_t) sizeof(unsigned int)) && (i + j < n); j++) {
out[i + j] = v & 0xff;
v = v >> 8;
}
}
return 0;
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
@@ -920,6 +976,13 @@ char *get_processed_name(const char *name) {
return ret;
}
#if defined(JANET_NO_DYNAMIC_MODULES)
const char *error_clib(void) {
return "dynamic modules not supported";
}
#else
#if defined(JANET_WINDOWS)
static char error_clib_buf[256];
@@ -967,6 +1030,7 @@ void *symbol_clib(HINSTANCE clib, const char *sym) {
}
}
#endif
#endif
/* Alloc function macro fills */

View File

@@ -93,6 +93,11 @@ void janet_buffer_format(
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
JanetBinding janet_binding_from_entry(Janet entry);
JanetByteView janet_text_substitution(
Janet *subst,
const uint8_t *bytes,
uint32_t len,
JanetArray *extra_args);
/* Registry functions */
void janet_registry_put(
@@ -135,7 +140,7 @@ int janet_gettime(struct timespec *spec);
typedef int Clib;
#define load_clib(name) ((void) name, 0)
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
#define error_clib() "dynamic libraries not supported"
const char *error_clib(void);
#define free_clib(c) ((void) (c), 0)
#elif defined(JANET_WINDOWS)
#include <windows.h>
@@ -150,7 +155,7 @@ typedef void *Clib;
#define load_clib(name) dlopen((name), RTLD_NOW)
#define free_clib(lib) dlclose((lib))
#define symbol_clib(lib, sym) dlsym((lib), (sym))
#define error_clib() dlerror()
#define error_clib dlerror
#endif
char *get_processed_name(const char *name);

View File

@@ -272,6 +272,7 @@ int janet_equals(Janet x, Janet y) {
const Janet *t1 = janet_unwrap_tuple(x);
const Janet *t2 = janet_unwrap_tuple(y);
if (t1 == t2) break;
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(t1) ^ janet_tuple_flag(t2))) return 0;
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
@@ -321,6 +322,7 @@ int32_t janet_hash(Janet x) {
break;
case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x));
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
break;
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
@@ -412,6 +414,9 @@ int janet_compare(Janet x, Janet y) {
case JANET_TUPLE: {
const Janet *lhs = janet_unwrap_tuple(x);
const Janet *rhs = janet_unwrap_tuple(y);
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(lhs) ^ janet_tuple_flag(rhs))) {
return (janet_tuple_flag(lhs) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : -1;
}
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
break;
}

View File

@@ -918,7 +918,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
int32_t i;
for (i = 0; i < elen; ++i) {
int32_t inherit = fd->environments[i];
if (inherit == -1) {
if (inherit == -1 || inherit >= func->def->environments_length) {
JanetStackFrame *frame = janet_stack_frame(stack);
if (!frame->env) {
/* Lazy capture of current stack frame */
@@ -1559,6 +1559,9 @@ int janet_init(void) {
janet_vm.scratch_len = 0;
janet_vm.scratch_cap = 0;
/* Sandbox flags */
janet_vm.sandbox_flags = 0;
/* Initialize registry */
janet_vm.registry = NULL;
janet_vm.registry_cap = 0;
@@ -1600,6 +1603,18 @@ int janet_init(void) {
return 0;
}
/* Disable some features at runtime with no way to re-enable them */
void janet_sandbox(uint32_t flags) {
janet_sandbox_assert(JANET_SANDBOX_SANDBOX);
janet_vm.sandbox_flags |= flags;
}
void janet_sandbox_assert(uint32_t forbidden_flags) {
if (forbidden_flags & janet_vm.sandbox_flags) {
janet_panic("operation forbidden by sandbox");
}
}
/* Clear all memory associated with the VM */
void janet_deinit(void) {
janet_clear_memory();

View File

@@ -67,6 +67,11 @@ extern "C" {
#define JANET_LINUX 1
#endif
/* Check for Cygwin */
#if defined(__CYGWIN__)
#define JANET_CYGWIN 1
#endif
/* Check Unix */
#if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \
@@ -87,6 +92,16 @@ extern "C" {
#define JANET_WINDOWS 1
#endif
/* Check if compiling with MSVC - else assume a GCC-like compiler by default */
#ifdef _MSC_VER
#define JANET_MSVC
#endif
/* Check Mingw 32-bit and 64-bit */
#ifdef __MINGW32__
#define JANET_MINGW
#endif
/* Check 64-bit vs 32-bit */
#if ((defined(__x86_64__) || defined(_M_X64)) \
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
@@ -96,7 +111,8 @@ extern "C" {
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@@ -264,10 +280,11 @@ extern "C" {
#ifndef JANET_NO_NANBOX
#ifdef JANET_32
#define JANET_NANBOX_32
#elif defined(__x86_64__) || defined(_WIN64)
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
/* We will only enable nanboxing by default on 64 bit systems
* on x86. This is mainly because the approach is tied to the
* implicit 47 bit address space. */
* for x64 and risc-v. This is mainly because the approach is tied to the
* implicit 47 bit address space. Many arches allow/require this, but not all,
* and it requires cooperation from the OS. ARM should also work in many configurations. */
#define JANET_NANBOX_64
#endif
#endif
@@ -340,7 +357,7 @@ typedef struct JanetOSRWLock JanetOSRWLock;
/* What to do when out of memory */
#ifndef JANET_OUT_OF_MEMORY
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
#endif
#ifdef JANET_BSD
@@ -432,6 +449,7 @@ typedef struct JanetReg JanetReg;
typedef struct JanetRegExt JanetRegExt;
typedef struct JanetMethod JanetMethod;
typedef struct JanetSourceMapping JanetSourceMapping;
typedef struct JanetSymbolMap JanetSymbolMap;
typedef struct JanetView JanetView;
typedef struct JanetByteView JanetByteView;
typedef struct JanetDictView JanetDictView;
@@ -987,6 +1005,7 @@ struct JanetAbstractHead {
/* Some function definition flags */
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
#define JANET_FUNCDEF_FLAG_HASSYMBOLMAP 0x40000
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
@@ -1002,6 +1021,14 @@ struct JanetSourceMapping {
int32_t column;
};
/* Symbol to slot mapping & lifetime structure. */
struct JanetSymbolMap {
uint32_t birth_pc;
uint32_t death_pc;
uint32_t slot_index;
const uint8_t *symbol;
};
/* A function definition. Contains information needed to instantiate closures. */
struct JanetFuncDef {
JanetGCObject gc;
@@ -1015,6 +1042,7 @@ struct JanetFuncDef {
JanetSourceMapping *sourcemap;
JanetString source;
JanetString name;
JanetSymbolMap *symbolmap;
int32_t flags;
int32_t slotcount; /* The amount of stack space required for the function */
@@ -1025,6 +1053,7 @@ struct JanetFuncDef {
int32_t bytecode_length;
int32_t environments_length;
int32_t defs_length;
int32_t symbolmap_length;
};
/* A function environment */
@@ -1556,8 +1585,10 @@ JANET_API Janet janet_array_pop(JanetArray *array);
JANET_API Janet janet_array_peek(JanetArray *array);
/* Buffer functions */
#define JANET_BUFFER_FLAG_NO_REALLOC 0x10000
JANET_API JanetBuffer *janet_buffer(int32_t capacity);
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count);
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
@@ -1656,6 +1687,7 @@ JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
JANET_API int janet_fiber_can_resume(JanetFiber *fiber);
JANET_API JanetFiber *janet_current_fiber(void);
JANET_API JanetFiber *janet_root_fiber(void);
@@ -1770,6 +1802,24 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
/* Sandboxing API */
#define JANET_SANDBOX_SANDBOX 1
#define JANET_SANDBOX_SUBPROCESS 2
#define JANET_SANDBOX_NET_CONNECT 4
#define JANET_SANDBOX_NET_LISTEN 8
#define JANET_SANDBOX_FFI 16
#define JANET_SANDBOX_FS_WRITE 32
#define JANET_SANDBOX_FS_READ 64
#define JANET_SANDBOX_HRTIME 128
#define JANET_SANDBOX_ENV 256
#define JANET_SANDBOX_DYNAMIC_MODULES 512
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
#define JANET_SANDBOX_ALL (UINT32_MAX)
JANET_API void janet_sandbox(uint32_t flags);
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
/* Scratch Memory API */
typedef void (*JanetScratchFinalizer)(void *);
@@ -1828,7 +1878,7 @@ JANET_API Janet janet_resolve_core(const char *name);
/* 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__; \
static const 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__)
@@ -1844,7 +1894,7 @@ JANET_API Janet janet_resolve_core(const char *name);
/* 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 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) \
@@ -1918,6 +1968,7 @@ JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
JANET_API JanetStruct janet_getstruct(const Janet *argv, int32_t n);
JANET_API JanetString janet_getstring(const Janet *argv, int32_t n);
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
JANET_API const char *janet_getcbytes(const Janet *argv, int32_t n);
JANET_API JanetSymbol janet_getsymbol(const Janet *argv, int32_t n);
JANET_API JanetKeyword janet_getkeyword(const Janet *argv, int32_t n);
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
@@ -1947,6 +1998,7 @@ JANET_API JanetTuple janet_opttuple(const Janet *argv, int32_t argc, int32_t n,
JANET_API JanetStruct janet_optstruct(const Janet *argv, int32_t argc, int32_t n, JanetStruct dflt);
JANET_API JanetString janet_optstring(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
JANET_API const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
JANET_API JanetSymbol janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API JanetKeyword janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);

View File

@@ -30,9 +30,13 @@
#ifdef _WIN32
#include <windows.h>
#include <shlwapi.h>
#include <versionhelpers.h>
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
#endif
#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
#endif
#endif
void janet_line_init();
@@ -143,9 +147,13 @@ static void setup_console_output(void) {
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
if (IsWindows10OrGreater()) {
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
}
SetConsoleMode(hOut, dwMode);
SetConsoleOutputCP(65001);
if (IsValidCodePage(65001)) {
SetConsoleOutputCP(65001);
}
}
/* Ansi terminal raw mode */
@@ -157,8 +165,10 @@ static int rawmode(void) {
dwMode &= ~ENABLE_LINE_INPUT;
dwMode &= ~ENABLE_INSERT_MODE;
dwMode &= ~ENABLE_ECHO_INPUT;
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode &= ~ENABLE_PROCESSED_INPUT;
if (IsWindows10OrGreater()) {
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode &= ~ENABLE_PROCESSED_INPUT;
}
if (!SetConsoleMode(hOut, dwMode)) return 1;
gbl_israwmode = 1;
return 0;
@@ -173,8 +183,10 @@ static void norawmode(void) {
dwMode |= ENABLE_LINE_INPUT;
dwMode |= ENABLE_INSERT_MODE;
dwMode |= ENABLE_ECHO_INPUT;
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode |= ENABLE_PROCESSED_INPUT;
if (IsWindows10OrGreater()) {
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode |= ENABLE_PROCESSED_INPUT;
}
SetConsoleMode(hOut, dwMode);
gbl_israwmode = 0;
}
@@ -296,6 +308,7 @@ static char *sdup(const char *s) {
return memcpy(mem, s, len);
}
#ifndef _WIN32
static int curpos(void) {
char buf[32];
int cols, rows;
@@ -311,6 +324,7 @@ static int curpos(void) {
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
return cols;
}
#endif
static int getcols(void) {
#ifdef _WIN32
@@ -950,6 +964,7 @@ static int line() {
break;
#ifndef _WIN32
case 26: /* ctrl-z */
clearlines();
norawmode();
kill(getpid(), SIGSTOP);
rawmode();

View File

@@ -24,6 +24,11 @@
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defn check-compile-error
[form]
(def result (compile form))
(assert (table? result) (string/format "expected compilation error for %j, but compiled without error" form)))
(defmacro assert-no-error
[msg & forms]
(def errsym (keyword (gensym)))

View File

@@ -228,7 +228,7 @@
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
(def myfun (juxt + - * /))
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
# Case statements
(assert
@@ -252,6 +252,9 @@
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
(def xs (catseq [x :range [0 3]] [x x]))
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
# :range-to and :down-to
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
@@ -342,6 +345,8 @@
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
(assert (= (and 1) 1) "and 1")
(assert (= (and) true) "and with no arguments")
(assert (= (and 1 true) true) "and with trailing true")
(assert (= (and 1 true 2) 2) "and with internal true")
(assert (= (or true true) true) "or true true")
(assert (= (or true false) true) "or true false")

View File

@@ -41,10 +41,10 @@
# Looping idea
(def xs
(seq [x :in '[-1 0 1] y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
(def txs (apply tuple xs))
(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
# Generators
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
@@ -72,6 +72,10 @@
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyxxxy") "string/replace function")
(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyXXxy") "string/replace-all function")
(assert (= (string/replace "x" 12 "xyx") "12yx") "string/replace stringable")
(assert (= (string/replace-all "x" 12 "xyx") "12y12") "string/replace-all stringable")
(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower")
(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower")
(assert (= (string/reverse "") "") "string/reverse 1")

View File

@@ -349,7 +349,7 @@
(def janet-longstring
~{:delim (some "`")
:open (capture :delim :n)
:close (cmt (* (not (> -1 "`")) (-> :n) (<- :delim)) ,=)
:close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
:main (* :open (any (if-not :close 1)) :close -1)})
(check-match janet-longstring "`john" false)
@@ -359,6 +359,7 @@
(check-match janet-longstring "`` ``" true)
(check-match janet-longstring "``` `` ```" true)
(check-match janet-longstring "`` ```" false)
(check-match janet-longstring "`a``b`" false)
# Line and column capture

View File

@@ -83,8 +83,13 @@
(assert (deep= (drop 10 []) []) "drop 2")
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
(assert (deep= (drop -2 [:a :b :c]) [:a :b :c]) "drop 5")
(assert-error :invalid-type (drop 3 {}) "drop 6")
(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
(assert (deep= (drop 1 "abc") "bc") "drop 7")
(assert (deep= (drop 10 "abc") "") "drop 8")
(assert (deep= (drop -1 "abc") "ab") "drop 9")
(assert (deep= (drop -10 "abc") "") "drop 10")
(assert-error :invalid-type (drop 3 {}) "drop 11")
# drop-until
@@ -98,4 +103,18 @@
# Quasiquote bracketed tuples
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
# No useless splices
(check-compile-error '((splice [1 2 3]) 0))
(check-compile-error '(if ;[1 2] 5))
(check-compile-error '(while ;[1 2 3] (print :hi)))
(check-compile-error '(def x ;[1 2 3]))
(check-compile-error '(fn [x] ;[x 1 2 3]))
# No splice propagation
(check-compile-error '(+ 1 (do ;[2 3 4]) 5))
(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5))
# compiler inlines when condition is constant, ensure that optimization doesn't break
(check-compile-error '(+ 1 (if true ;[3 4])))
(check-compile-error '(+ 1 (if false nil ;[3 4])))
(end-suite)

View File

@@ -261,4 +261,12 @@
(modcheck -10 3)
(modcheck -10 -3)
# Check for issue #1130
(var d (int/s64 7))
(mod 0 d)
(var d (int/s64 7))
(def result (seq [n :in (range -21 0)] (mod n d)))
(assert (deep= result (map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6])) "issue #1130")
(end-suite)

View File

@@ -60,7 +60,7 @@
:buffer (/ '(* "@" :bytes) (constant :string))
:long-bytes {:delim (some "`")
:open (capture :delim :n)
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
:close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n)) ,=)
:main (drop (* :open (any (if-not :close 1)) :close))}
:long-string (/ ':long-bytes (constant :string))
:long-buffer (/ '(* "@" :long-bytes) (constant :string))
@@ -239,6 +239,12 @@
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
# OS strftime test
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00") "strftime UTC epoch")
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200) "2014-01-01 20:30:00") "strftime january 2014")
(assert (= (try (os/strftime "%%%d%t") ([err] err)) "invalid conversion specifier '%t'") "invalid conversion specifier")
# Appending buffer to self
(with-dyns [:out @""]
@@ -294,9 +300,12 @@
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
(with [f (file/temp)]
(assert (= 0 (file/tell f)) "start of file")
(file/write f "foo\n")
(assert (= 4 (file/tell f)) "after written string")
(file/flush f)
(file/seek f :set 0)
(assert (= 0 (file/tell f)) "start of file again")
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
(var counter 0)

View File

@@ -330,7 +330,6 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
# Peg replace and replace-all
(var ti 0)
(defn check-replacer
[x y z]
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
@@ -339,6 +338,32 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(check-replacer "abc" "Z" "")
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
(check-replacer "aba" string/ascii-upper "ababababababa")
(check-replacer "aba" 123 "ababababababa")
(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa"))
"ABcAA")
"peg/replace-all cfunction")
(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa"))
"abcaa")
"peg/replace-all function")
(defn peg-test [name f peg subst text expected]
(assert (= (string (f peg subst text)) expected) name))
(peg-test "peg/replace has access to captures"
peg/replace
~(sequence "." (capture (set "ab")))
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
".a.b.c"
".a -> A, .b.c")
(peg-test "peg/replace-all has access to captures"
peg/replace-all
~(sequence "." (capture (set "ab")))
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
".a.b.c"
".a -> A, .b -> B, .c")
# Peg bug
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")

View File

@@ -44,6 +44,43 @@
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
# Sourcemaps in threading macros
(defn check-threading [macro expansion]
(def expanded (macex1 (tuple macro 0 '(x) '(y))))
(assert (= expanded expansion) (string macro " expansion value"))
(def smap-x (tuple/sourcemap (get expanded 1)))
(def smap-y (tuple/sourcemap expanded))
(def line first)
(defn column [t] (t 1))
(assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
(assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
(assert (or (< (line smap-x) (line smap-y))
(and (= (line smap-x) (line smap-y))
(< (column smap-x) (column smap-y))))
(string macro " relation between x and y sourcemap")))
(check-threading '-> '(y (x 0)))
(check-threading '->> '(y (x 0)))
# keep-syntax
(let [brak '[1 2 3]
par '(1 2 3)]
(tuple/setmap brak 2 1)
(assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3]) "keep-syntax brackets ignore array")
(assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3]) "keep-syntax! brackets replace array")
(assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4)) "keep-syntax! parens coerce array")
(assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3)) "keep-syntax! brackets not parens")
(assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3]) "keep-syntax! parens not brackets")
(assert (= (tuple/sourcemap brak)
(tuple/sourcemap (keep-syntax! brak @[1 2 3]))) "keep-syntax! brackets source map")
(keep-syntax par brak)
(assert (not= (tuple/sourcemap brak) (tuple/sourcemap par)) "keep-syntax no mutate")
(assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
# Cancel test
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1")
@@ -144,7 +181,7 @@
(assert (< 1000 1e23) "greater than immediate 2")
# os/execute with environment variables
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env")
# Regression #638
(compwhen

View File

@@ -102,5 +102,7 @@
(assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
(assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
(end-suite)
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
(assert (= ((f 10) 37) 47) "asm environment tables")
(end-suite)

48
test/suite0015.janet Normal file
View File

@@ -0,0 +1,48 @@
# test *debug* flags
(import ./helper :prefix "" :exit true)
(start-suite 15)
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
@[[0 3 0 'a] [1 3 1 'x]])
"symbolslots when *debug* is true")
(defn a [arg]
(def x 10)
(do
(def y 20)
(def z 30)
(+ x y z)))
(def symbolslots (in (disasm a) :symbolslots))
(def f (asm (disasm a)))
(assert (deep= (in (disasm f) :symbolslots)
symbolslots)
"symbolslots survive disasm/asm")
(comment
(setdyn *debug* true)
(setdyn :pretty-format "%.40M")
(def f (fn [x] (fn [y] (+ x y))))
(assert (deep= (map last (in (disasm (f 10)) :symbolmap))
@['x 'y])
"symbolslots upvalues"))
(assert (deep= (in (disasm (defn a [arg]
(def x 10)
(do
(def y 20)
(def z 30)
(+ x y z)))) :symbolmap)
@[[0 7 0 'arg]
[0 7 1 'a]
[1 7 2 'x]
[2 7 3 'y]
[3 7 4 'z]])
"arg & inner symbolslots")
# buffer/push-at
(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456")) "buffer/push-at 1")
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
(end-suite)