1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-01 20:41:27 +00:00

Compare commits

...

63 Commits

Author SHA1 Message Date
Calvin Rose
df32109eea Small typo fixes in comments. 2026-03-15 20:22:20 -05:00
Calvin Rose
8b89901298 Deduplicate lints.
Why see the same message twice?
2026-03-15 18:27:13 -05:00
Calvin Rose
079776d39e Elaborate comment. 2026-03-15 15:34:52 -05:00
Calvin Rose
6c2f08ef49 Add unit tests for variable shadowing. 2026-03-15 13:34:12 -05:00
Calvin Rose
980999c97b Make test suite not shadow any variables. 2026-03-15 13:14:10 -05:00
Calvin Rose
1197cfe433 Check redef only once per compile call. 2026-03-15 12:56:10 -05:00
Calvin Rose
c63c6740d9 First pass at linting binding shadowing.
Prevent redefining bindings by accident. There are
a few cases where we want to allow this, such as the `default` macro, so
we allow a keyword :shadow to be included in the `def` expression to
turn off this lint.

TODO:
* Clean up test suite to remove binding shadowing
* Make sure that we don't get lints with *redef* turned on
* Add positive and negative tests for lint messages.
* Add location of shadowed binding in message
2026-03-15 11:24:07 -05:00
Calvin Rose
612971503d Add LLM, AI and tool usage section to contribution guide. (#1730)
* Add LLM, AI and tool usage section to contribution guide.

* Word order and punctuation.

* Add suggestions.

- No bot PRs
- Define "Large" code contribution

Also try to disuade users from using AI for one-line or simple changes, instead
preferring to treat that as "feedback" and rewrite instead.

* Remove wiggle room for any AI code in the Janet runtime.

Still leave open the possibity for AI / tool usage for static analysis
and bug repots. However, the 5-15 lines of code limitation is fuzzy and
arbitrary. We can just say no.

* Remove word.
2026-03-14 23:13:29 -05:00
PinieP
df56efbae0 Fix: add missing :symbolmap keyword to disasm function (#1729) 2026-03-12 19:25:51 -05:00
sogaiu
b160f4f5c0 Macro hygiene tweaks (#1727)
* Tweak hygiene for when-with, if-with, when-let

* Tweak hygiene for loop1 helper

* Tweak hygiene for repeat

* Tweak hygiene for seq and catseq

* Tweak hygiene for -?> and -?>>

* Tweak hygiene for varfn

* Tweak hygiene for ev/with-deadline

* Tweak hygiene for ffi/defbind-alias + ffi/defbind

---------

Co-authored-by: sogaiu <983021772@users.noreply.github.com>
2026-03-11 19:06:43 -05:00
Calvin Rose
a0cc867f14 Improve macro hygiene in boot.janet. 2026-03-09 19:46:55 -05:00
Calvin Rose
8f446736ed Fix #1723 - handle prompt longer than terminal is wide.
When this happened, we tried to print a buffer with a negative length
that resulted in invalid memmove call. This fix both checks that we
don't tried to append a negative buffer, and truncates a prompt that is
too long for the termimal so that one can still enter text with at least
16 visible characters for data entry.
2026-03-07 15:28:59 -06:00
PinieP
decd7078af fix janet_make_threaded to return threaded channel (#1724)
janet_make_threaded previously created a channel with threaded set to 0
2026-03-07 15:01:03 -06:00
McSinyx
b96350f132 Align items in multiline pretty format (%m and %p) (#1721)
Indentation levels are not sufficiently clear for deeply nested
data structures.  Instead, align items in a collection
with its opening bracket, also known as hanging indentation.

To avoid guessing the length of a "short" collection to print it
on one line, items are now always printed on separate lines.
2026-03-05 19:34:05 -06:00
Calvin Rose
aa63adccb4 Update CHANGELOG.md 2026-03-02 19:39:21 -06:00
Calvin Rose
7fc12ff167 Use ConnectEx for non-blocking connect on windows when available.
Still fallback to blocking connect with WSAConnect when ConnectEx is not
available or applicable, but ConnectEx is preferred and recommended by
Microsoft.

Also make some changes to our use of OVERLAPPED in various places in the
ev code, replacing all uses with JanetOverlapped. This also let's us
avoid reusing internal fields for OVERLAPPED which may or may not be
used in various places.
2026-03-02 19:39:21 -06:00
Calvin Rose
39f8cf207c Cast for warning on mingw DWORD printing. 2026-03-01 12:24:03 -06:00
Calvin Rose
95f2e233c5 Try io.h on windows 2026-03-01 12:20:15 -06:00
Calvin Rose
e8f9c12935 Fix regression where private main was not run. 2026-03-01 10:52:52 -06:00
Calvin Rose
32d75c9e49 Dup io file descriptors when marshalling closable files.
For unclosable files, no need to dup, but for closable files we can get
a resource leak. Valgrind and similar tools won't catch this but IO will
unexpectedly start going to the wrong descriptor if a file was
transferred to a new thread, closed, and then a new file was created.
2026-03-01 10:39:50 -06:00
Calvin Rose
5fec2aa9df Move some files around code more defensively for mitigation. 2026-02-27 18:19:40 -06:00
Brett
54fbd7607f Fix GC collecting active fiber during nested janet_continue (#1720)
janet_collect() marks janet_vm.root_fiber but not janet_vm.fiber.
When janet_pcall (or janet_continue) is called from a C function,
the inner fiber becomes janet_vm.fiber while root_fiber still points
to the outer fiber. If GC triggers inside the inner fiber's execution,
the inner fiber is not in any GC root set and can be collected —
including its stack memory — while actively running.

This also affects deeply nested cases: F1 -> C func -> janet_pcall ->
F2 -> C func -> janet_pcall -> F3, where F2 is saved only in a C
stack local (tstate.vm_fiber), invisible to GC.

Fix: in janet_continue_no_check, root the fiber with janet_gcroot
when this is a nested call (root_fiber already set). Each nesting
level roots its own fiber, handling arbitrary depth. Top-level calls
(event loop, REPL) skip the root/unroot entirely since root_fiber
is NULL.

Add test/test-gc-pcall.c: standalone C test covering both single
and deep nesting cases.

Co-authored-by: Brett Adams <brett@bletia-9.local>
2026-02-27 18:13:46 -06:00
sogaiu
019829fdf9 Tweak a docstring and a comment (#1718)
Co-authored-by: sogaiu <983021772@users.noreply.github.com>
2026-02-25 17:51:54 -06:00
Calvin Rose
2602bec017 Check stderr for redirection before turning on/off color. 2026-02-21 08:17:12 -06:00
Calvin Rose
403b2c704a Add sanitizer test to github actions and sr.ht builds.
This will run both clang and gcc sanitizers as part of ordinary testing.
2026-02-20 18:08:09 -06:00
Calvin Rose
ca9ffaa5bb Avoid memory leak when canceling fibers with threaded channels.
Objects in channels are sent as messages that need to be freed by the
consumer. However, in certain cases, no consumer is available and the
messages were being discarded without properly being freed. This should
also fix `-fsanitize=address` on GCC and CLANG with the default test
suite.
2026-02-20 14:47:00 -06:00
Calvin Rose
e61194a8d9 Remove older extra channel unlocks. 2026-02-20 08:17:25 -06:00
Calvin Rose
08e4030487 Add builders for issue #1716 2026-02-20 08:00:36 -06:00
Calvin Rose
56b5998553 Suspicious locking behavior with select.
This looks like it could cause deadlocks with threaded channels
(normal channels are unaffected, locking/unlocking is a no-op).
2026-02-20 07:35:18 -06:00
R Fisher
ea997d585b fix multicast on illumos (#1717)
illumos, like BSD, expects IP_MULTICAST_TTL to be
an unsigned char
2026-02-20 07:30:30 -06:00
Calvin Rose
fc725e2511 Prepare for next patch release. 2026-02-18 08:46:17 -06:00
Calvin Rose
d636502c32 Fix vestigial doc string. 2026-02-18 08:41:31 -06:00
Calvin Rose
0fea20c821 Prepare for v1.41.2 and indicate vm changes for stack correction. 2026-02-18 08:27:10 -06:00
Calvin Rose
91cc499e77 1.42.2 patch. 2026-02-18 08:19:55 -06:00
Calvin Rose
68850a0a05 Update for 1.41.2 patch. 2026-02-18 08:19:13 -06:00
Calvin Rose
d3d7c675a8 Update CHANGELOG.md 2026-02-17 18:56:21 -06:00
Calvin Rose
b2c9fc123c Generate JOP_PUT_INDEX in the compiler when possible. 2026-02-17 09:07:01 -06:00
Calvin Rose
fa0c039cd3 Add regression test for issue #1714 2026-02-17 07:59:08 -06:00
Evan Shaw
78ef9d1733 Initialize memory allocated by put (#1715) 2026-02-17 07:50:50 -06:00
sogaiu
b6676f350c Use snprintf instead of sprintf - sequel (#1713)
Co-authored-by: sogaiu <983021772@users.noreply.github.com>
2026-02-16 09:12:02 -06:00
Calvin Rose
0299620a2d Code defensively with regard to stack resizes from custom get and put
for abstract types.

Abstract types whose get/put/length/etc. implementations allocated fiber
slots could break the VM by invalidating the stack pointer in the
interpreter. This is admittedly a bit unusual but is something most
users would probably expect to work. Debugging this would be a real pain.
2026-02-16 09:02:07 -06:00
Calvin Rose
739d9d9fe3 Expose module/add-syspath and update CHANGELOG.md 2026-02-15 22:20:54 -06:00
Calvin Rose
1557f9da78 Don't reference argv after fiber may have been resized. 2026-02-15 21:54:42 -06:00
Calvin Rose
529d8c9e4a Improve ability to load modules by full path.
Be explicit when we are including this functionality. Add a function
module/add-file-extension that can do this programatically.
2026-02-15 21:10:26 -06:00
Calvin Rose
2df16e5a48 Allow garbage collection to be called inside the module entry.
This usually shouldn't be needed, but in the case that it is, or if
garbage collection is triggered manually, we can prevent use-after-free.
2026-02-15 18:46:21 -06:00
Calvin Rose
b0db2b22d6 Remove macos-13 2026-02-15 11:18:40 -06:00
Calvin Rose
8b6d56edae Patch release to 1.41.1 2026-02-15 10:36:46 -06:00
Calvin Rose
a2a7e9f01e Add explicit include of inttypes.h 2026-02-15 10:24:56 -06:00
Calvin Rose
4b078e7a45 Use correct format specifier on windows if missing message. 2026-02-15 10:17:16 -06:00
Calvin Rose
5c0bb4b385 Cosmo libc builds were not working. 2026-02-15 09:57:10 -06:00
Calvin Rose
2aaa7dfa10 Sort keys when compiling struct and table literals.
Order of evaluation becomes more clear in some cases.
2026-02-15 09:42:55 -06:00
Calvin Rose
10bb17199c Prepare for 1.41.0 release 2026-02-15 08:45:56 -06:00
Calvin Rose
0aa7dfeb9a Work on windows for WSAConnect not working.
For remote connections, if you did not manually wait for the connection
to settle, the programmer would see unspecified network errors. This is
is because the underlying TCP Connection had not been established yet.
The correct way to deal with this is to use ConnectEx if available
instead of WSAConnect.
2026-02-14 21:11:28 -06:00
Calvin Rose
8f7c32e5cb Update for msvc build. 2026-02-14 18:31:57 -06:00
sogaiu
abd7bb1110 Use snprintf instead of sprintf (#1711)
Co-authored-by: sogaiu <983021772@users.noreply.github.com>
2026-02-14 09:04:33 -06:00
Calvin Rose
d81512723b When pretty printing, don't sort keys for huge tables.
This was exposed when printing `(invert (range 200000))`, which
isn't so large that we shouldn't be able to sort it, but was taking
far too long to compute.
2026-02-14 08:57:27 -06:00
Calvin Rose
2a54154976 Don't use preload on absolute paths.
When importing full paths, the old preload code was preventing
(import <fullpath> :fresh true) from working as expected.
2026-02-13 19:36:09 -06:00
Calvin Rose
306ce892ea Merge branch 'make-modules-easier' 2026-02-06 00:31:08 -06:00
Calvin Rose
c7c3821aa6 Remove extra output from peg test. 2026-02-06 00:23:45 -06:00
Calvin Rose
d2685594f9 VERBOSE=1 caused tests to fail as we did more asserts inside the assert.
Thenc checked stderr for messages. Since the helper makes assert write
to stderr, this caused extra cruft in our test output.
2026-02-06 00:17:11 -06:00
Calvin Rose
ca5c617fba More tweaks to peg suite for arm32 failures. 2026-02-06 00:04:18 -06:00
Calvin Rose
16b449a137 Print "actual" output on verbose mode for suite-peg 2026-02-05 23:52:28 -06:00
Calvin Rose
2e8dd90a51 Line endings in tests. 2026-02-05 23:38:55 -06:00
53 changed files with 1113 additions and 439 deletions

View File

@@ -10,3 +10,9 @@ tasks:
gmake test
sudo gmake install
sudo gmake uninstall
- build-sanitizers: |
cd janet
CFLAGS="-g -O2 -fsanitize=address,undefined" gmake
gmake test
sudo gmake install
sudo gmake uninstall

8
.github/cosmo/setup vendored
View File

@@ -1,19 +1,19 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get update
sudo apt-get install -y ca-certificates libssl-dev\
qemu qemu-utils qemu-user-static\
qemu-utils qemu-user-static\
texinfo groff\
cmake ninja-build bison zip\
pkg-config build-essential autoconf re2c
# download cosmocc
cd /sc
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
wget https://github.com/jart/cosmopolitan/releases/download/4.0.2/cosmocc-4.0.2.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
unzip ../cosmocc-4.0.2.zip
# register
cd /sc/cosmocc

View File

@@ -17,7 +17,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-13 ]
os: [ ubuntu-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -46,7 +46,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ macos-latest ]
os: [ macos-latest, macos-15-intel ]
steps:
- name: Checkout the repository
uses: actions/checkout@master

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest, macos-14 ]
os: [ ubuntu-latest, macos-latest, macos-14, macos-15-intel ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -21,6 +21,20 @@ jobs:
- name: Test the project
run: make test
test-posix-sanitizers:
name: Build and test on POSIX systems with sanitizers turned on
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Compile the project
run: make clean && CFLAGS="-g -O2 -fsanitize=address,undefined" make
- name: Test the project
run: make test
test-windows:
name: Build and test on Windows
strategy:
@@ -42,6 +56,27 @@ jobs:
shell: cmd
run: build_win dist
test-windows-sanitizers:
name: Build and test on Windows with sanitizers
strategy:
matrix:
os: [ windows-latest ]
runs-on: ${{ matrix.os }}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Build the project
shell: cmd
run: set SANITIZE=1 & build_win
- name: Test the project
shell: cmd
run: set VERBOSE=1 & build_win test
- name: Test installer build
shell: cmd
run: build_win dist
test-windows-min:
name: Build and test on Windows Minimal build
strategy:
@@ -136,3 +171,22 @@ jobs:
run: docker run --privileged --rm tonistiigi/binfmt --install s390x
- name: Build and run on emulated architecture
run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"
test-cosmo:
name: Test build for Cosmo
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: create build folder
run: |
sudo mkdir -p /sc
sudo chmod -R 0777 /sc
- name: setup Cosmopolitan Libc
run: bash ./.github/cosmo/setup
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=cosmo" >> $GITHUB_ENV
- name: build Janet APE binary
run: bash ./.github/cosmo/build

1
.gitignore vendored
View File

@@ -12,6 +12,7 @@ janet
/src/include/generated/*.h
janet-*.tar.gz
dist
/tmp
# jpm lockfile
lockfile.janet

View File

@@ -2,6 +2,19 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Documentation fixes
- ev/thread-chan deadlock bug fixed
- Re-add removed support for non-blocking net/connect on windows.
## 1.41.2 - 2026-02-18
- Fix regressions in `put` for arrays and buffers.
- Add `module/add-file-extension`
- Add `module/add-syspath`
- Fix issue with possible stack corrpution with abstract types that modify the current fiber.
- Allow use of the interpreter and garbage collection inside module entry for native modules.
## 1.41.1 - 2026-02-15
- Revert to blocking behaior of `net/connect` on windows to fix spurious errors.
- Allow overriding the loader when doing imports with the `:loader` argument.
- Allow importing modules with a path extension to do what one would expect.
- Add `find-all` argument to `module/find`

View File

@@ -37,6 +37,12 @@ may require changes before being merged.
do this indentation, or approximate as close as possible. There is a janet formatter
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
Bot pull requests will not be accepted, and anonymous submissions, including
new accounts, unknown emails, and first time contributors will be subjected
to greater scrutiny and code reivew. Automatically generated and filed bug
reports MAY be ok, if they are of consistent and good quality, such as
OSSFuzz or well constructed CI pipelines.
## C style
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
@@ -90,3 +96,18 @@ timely manner. In short, if you want extra functionality now, then build it.
* Include a good description of the problem that is being solved
* Include descriptions of potential solutions if you have some in mind.
## LLMs, Tool Usage, and Transparency
All usage of Large Language Models (LLMs), Neural Networks, "AI" tools, and
other tools such as software fuzzers or static analyzers must be disclosed.
This applies to pull requests, email patches, bug reports, and any other
meaningful contribution to Janet's source code. Please also refrain from using
generative AI for code that will be embedded in the Janet runtime, which include
all C source files as well as boot.janet. All code should be well
and completely understood by the human author, including test cases. Large and
obviously AI-driven changes will be rejected. Be mindful and transparent on the
copyright implications of any submitted code. We will use discretion when
accepting generated test cases for bug reproductions, one-line bug
fixes, or typo fixes. Often, these can be trivially rewritten by a human to
avoid the problem.

View File

@@ -23,7 +23,17 @@
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
if DEFINED CLANG (
@set COMPILER=clang-cl.exe
) else (
@set COMPILER=cl.exe
)
if DEFINED SANITIZE (
@set "SANITIZERS=/fsanitize=address"
) else (
@set "SANITIZERS="
)
@set JANET_COMPILE=%COMPILER% /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD %SANITIZERS%
@set JANET_LINK=link /nologo
@set JANET_LINK_STATIC=lib /nologo

View File

@@ -3,10 +3,10 @@
(defn bork [x]
(defn bark [x]
(defn bark [y]
(print "Woof!")
(print x)
(error x)
(print y)
(error y)
(print "Woof!"))
(bark (* 2 x))

View File

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

View File

@@ -4,7 +4,7 @@
# that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro delay
(defmacro dolazy
"Lazily evaluate a series of expressions. Returns a function that
returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result."
@@ -35,7 +35,7 @@
(def x (tuple h t))
(fn [] x))
(defn empty?
(defn lazy-empty?
"Check if a sequence is empty."
[s]
(not (s)))
@@ -55,14 +55,14 @@
[start end &]
(if end
(if (< start end)
(delay (tuple start (lazy-range (+ 1 start) end)))
(dolazy (tuple start (lazy-range (+ 1 start) end)))
empty-seq)
(lazy-range 0 start)))
(defn lazy-map
"Return a sequence that is the result of applying f to each value in s."
[f s]
(delay
(dolazy
(def x (s))
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
@@ -76,31 +76,31 @@
[f s]
(when (s) (f (head s)) (realize-map f (tail s))))
(defn drop
(defn lazy-drop
"Ignores the first n values of the sequence and returns the rest."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
(defn take
(defn lazy-take
"Returns at most the first n values of s."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n))
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
(defn randseq
"Return a sequence of random numbers."
[]
(delay (tuple (math/random) (randseq))))
(dolazy (tuple (math/random) (randseq))))
(defn take-while
(defn lazy-take-while
"Returns a sequence of values until the predicate is false."
[pred s]
(delay
(dolazy
(def x (s))
(when x
(def thehead (get HEAD x))
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))

View File

@@ -16,8 +16,8 @@
(def cell-set (frequencies state))
(def neighbor-set (frequencies (mapcat neighbors state)))
(seq [coord :keys neighbor-set
:let [count (get neighbor-set coord)]
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
:let [ncount (get neighbor-set coord)]
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
coord))
(defn draw

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.41.0')
version : '1.41.3')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

View File

@@ -46,7 +46,6 @@
(defn defmacro :macro :flycheck
"Define a macro."
[name & more]
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
(apply defn name :macro more))
(defmacro as-macro
@@ -219,9 +218,9 @@
(defmacro default
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``
Expands to `(def sym :shadow (if (= nil sym) val sym))`.``
[sym val]
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
(defmacro comment
"Ignores the body of the comment."
@@ -443,11 +442,36 @@
(def ,binding ,ctor)
,(defer-impl :with [(or dtor :close) binding] body)))
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
the `fal` form. Bindings have the same syntax as the `let` macro.``
[bindings tru &opt fal]
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-with
``Similar to with, but if binding is false or nil, returns
nil without evaluating the body. Otherwise, the same as `with`.``
[[binding ctor dtor] & body]
~(if-let [,binding ,ctor]
~(as-macro ,if-let [,binding ,ctor]
,(defer-impl :when-with [(or dtor :close) binding] body)))
(defmacro if-with
@@ -455,7 +479,7 @@
the falsey path. Otherwise, evaluates the truthy path. In both cases,
`ctor` is bound to binding.``
[[binding ctor dtor] truthy &opt falsey]
~(if-let [,binding ,ctor]
~(as-macro ,if-let [,binding ,ctor]
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
,falsey))
@@ -539,13 +563,13 @@
(case binding
:until ~(do (if ,verb (break) nil) ,rest)
:while ~(do (if ,verb nil (break)) ,rest)
:let ~(let ,verb (do ,rest))
:let ~(as-macro ,let ,verb (do ,rest))
:after ~(do ,rest ,verb nil)
:before ~(do ,verb ,rest nil)
:repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
:when ~(when ,verb ,rest)
:unless ~(unless ,verb ,rest)
~(do (var ,iter ,verb) (while (,> ,iter 0) ,rest (as-macro ,-- ,iter))))
:when ~(as-macro ,when ,verb ,rest)
:unless ~(as-macro ,unless ,verb ,rest)
(error (string "unexpected loop modifier " binding))))))
# 3 term expression
@@ -587,7 +611,7 @@
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
~(do (var ,iter ,n) (while (,> ,iter 0) ,;body (as-macro ,-- ,iter)))))
(defmacro forever
"Evaluate body forever in a loop, or until a break statement."
@@ -683,7 +707,7 @@
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
~(do (def ,$accum @[]) (as-macro ,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.
@@ -691,21 +715,21 @@
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
~(do (def ,$accum @[]) (as-macro ,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.``
[head key-body & value-body]
(def $accum (gensym))
~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
~(do (def ,$accum @{}) (as-macro ,loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
(defmacro generate
``Create a generator expression using the `loop` syntax. Returns a fiber
that yields all values inside the loop in order. See `loop` for details.``
[head & body]
(check-empty-body body)
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
~(,fiber/new (fn :generate [] (as-macro ,loop ,head (,yield (do ,;body)))) :yi))
(defmacro coro
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
@@ -754,35 +778,10 @@
(each x xs (*= accum x))
accum)
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
the `fal` form. Bindings have the same syntax as the `let` macro.``
[bindings tru &opt fal]
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-let
"Same as `(if-let bindings (do ;body))`."
[bindings & body]
~(if-let ,bindings (do ,;body)))
~(as-macro ,if-let ,bindings (do ,;body)))
(defn comp
`Takes multiple functions and returns a function that is the composition
@@ -1432,7 +1431,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h sym] t))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defmacro -?>>
@@ -1448,7 +1447,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h] t @[sym]))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defn- walk-ind [f form]
@@ -2411,8 +2410,8 @@
(dictionary? m) (merge-into metadata m)
(error (string "invalid metadata " m))))
(with-syms [entry old-entry f]
~(let [,old-entry (,dyn ',name)]
(def ,entry (or ,old-entry @{:ref @[nil]}))
~(as-macro ,let [,old-entry (,dyn ',name)]
(def ,entry (as-macro ,or ,old-entry @{:ref @[nil]}))
(,setdyn ',name ,entry)
(def ,f ,fbody)
(,put-in ,entry [:ref 0] ,f)
@@ -2675,17 +2674,17 @@
(var resumeval nil)
(def f
(fiber/new
(fn []
(fn :compile-and-lint []
(array/clear lints)
(def res (compile source env where lints))
(unless (empty? lints)
(when (next lints)
# Convert lint levels to numbers.
(def levels (get env *lint-levels* lint-levels))
(def lint-error (get env *lint-error*))
(def lint-warning (get env *lint-warn*))
(def lint-error (or (get levels lint-error lint-error) 0))
(def lint-warning (or (get levels lint-warning lint-warning) 2))
(each [level line col msg] lints
(each [level line col msg] (distinct lints) # some macros might cause code to be duplicated. Avoid repeated messages.
(def lvl (get lint-levels level 0))
(cond
(<= lvl lint-error) (do
@@ -2874,7 +2873,8 @@
(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
# Don't try to preload absolute or relative paths
(defn- check-preloadable [x] (if-not (or (string/has-prefix? "/" x) (string/find "." x) (string/find "@" x)) x))
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
@@ -2924,11 +2924,23 @@
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
mp)
(defn module/add-file-extension
```
Add paths to `module/paths` for a given file extension such that
the programmer can import a module by relative or absolute path from
the current working directory.
Returns the modified `module/paths`.
```
[ext loader]
(assert (string/has-prefix? "." ext) "file extension must have . prefix")
(def mp (dyn *module-paths* module/paths))
(array/insert mp 0 [":all:" loader (fn :check-ext [x] (string/has-suffix? ext x))])
mp)
# Don't expose this externally yet - could break if custom module/paths is setup.
(defn- module/add-syspath
(defn module/add-syspath
```
Add a custom syspath to `module/paths` by duplicating all entries that being with `:sys:` and
adding duplicates with a specific path prefix instead.
@@ -2949,7 +2961,16 @@
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
(module/add-file-extension ".janet" :source)
(module/add-file-extension ".jimage" :source)
# These obviously won't work on all platforms, but if a user explicitly
# tries to import them, we may as well try.
(module/add-file-extension ".so" :native)
(module/add-file-extension ".dll" :native)
(array/insert module/paths 0
[(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path))
:preload
check-preloadable])
# Version of fexists that works even with a reduced OS
(defn- fexists
@@ -3219,7 +3240,7 @@
(def prefix (or
(and as (string as "/"))
prefix
(string (last (string/split "/" path)) "/")))
(string (first (string/split "." (last (string/split "/" path)))) "/")))
(merge-module env newenv prefix ep only))
(defmacro import
@@ -3280,7 +3301,6 @@
[&opt env local]
(env-walk keyword? env local))
(defdyn *doc-width*
"Width in columns to print documentation printed with `doc-format`.")
@@ -3932,7 +3952,7 @@
``
[sec & body]
(with-syms [f]
~(let [,f (coro ,;body)]
~(as-macro ,let [,f (as-macro ,coro ,;body)]
(,ev/deadline ,sec nil ,f)
(,resume ,f))))
@@ -3993,7 +4013,7 @@
"handler not supported for :datagram servers")
(def s (net/listen host port type no-reuse))
(if handler
(ev/go (fn [] (net/accept-loop s handler))))
(ev/go (fn :net/server-handler [] (net/accept-loop s handler))))
s))
###
@@ -4064,15 +4084,15 @@
(defn make-ptr []
(assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
(if lazy
~(defn ,alias ,;meta [,;formal-args]
~(as-macro ,defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,alias ,;meta [,;formal-args]
~(as-macro ,defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind :flycheck
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
~(as-macro ,ffi/defbind-alias ,name ,name ,ret-type ,;body)))
###
###
@@ -4649,8 +4669,7 @@
(defn- run-main
[env subargs arg]
(when-let [entry (in env 'main)
main (or (get entry :value) (in (get entry :ref) 0))]
(when-let [main (module/value env 'main true)]
(def guard (if (get env :debug) :ydt :y))
(defn wrap-main [&]
(main ;subargs))
@@ -4739,7 +4758,8 @@
(apply-color
(and
(not (getenv-alias "NO_COLOR"))
(os/isatty stdout)))
(os/isatty stdout)
(os/isatty stderr)))
(defn- get-lint-level
[i]

View File

@@ -37,7 +37,7 @@ int system_test() {
/* Check the version defines are self consistent */
char version_combined[256];
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
snprintf(version_combined, sizeof(version_combined), "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */

View File

@@ -5,9 +5,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 41
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_PATCH 3
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.41.0-dev"
#define JANET_VERSION "1.41.3-dev"
/* #define JANET_BUILD "local" */

View File

@@ -1110,6 +1110,7 @@ JANET_CORE_FN(cfun_disasm,
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
if (!janet_cstrcmp(kw, "symbolmap")) return janet_disasm_symbolslots(f->def);
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);

View File

@@ -201,14 +201,29 @@ static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
return janetc_cslot(janet_wrap_nil());
int8_t inline_index = 0;
if (can_slot_be_imm(args[1], &inline_index)) {
/* Use JOP_PUT_INDEX */
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_ssi(opts.compiler, JOP_PUT_INDEX, args[0], args[2], inline_index, 0);
return janetc_cslot(janet_wrap_nil());
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_ssi(opts.compiler, JOP_PUT_INDEX, t, args[2], inline_index, 0);
return t;
}
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
return t;
/* Use JOP_PUT */
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
return janetc_cslot(janet_wrap_nil());
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
return t;
}
}
}
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {

View File

@@ -91,29 +91,28 @@ 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) {
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
if (sym[0] != '_') {
int check = janetc_shadowcheck(c, sym);
if (check == 2) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a local binding", janet_wrap_symbol(sym));
} else if (check) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a global binding", janet_wrap_symbol(sym));
}
}
}
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
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);
}
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
void janetc_nameslot_no_unused(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.referenced = 1;
if (flags & JANET_DEFFLAG_NO_UNUSED) {
sp.referenced = 1;
} else {
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
}
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
@@ -260,6 +259,24 @@ static int lookup_missing(
return 1;
}
/* Check if a binding is defined in an upper scope. This lets us check for
* variable shadowing. */
int janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
/* Check locals */
JanetScope *scope = c->scope;
while (scope) {
int32_t len = janet_v_count(scope->syms);
for (int32_t i = len - 1; i >= 0; i--) {
SymPair *pair = scope->syms + i;
if (pair->sym == sym) return 2;
}
scope = scope->parent;
}
/* Check globals */
JanetBinding binding = janet_resolve_ext(c->env, sym);
return binding.type != JANET_BINDING_NONE;
}
/* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve(
JanetCompiler *c,
@@ -459,11 +476,22 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
const JanetKV *kvs = NULL;
int32_t cap = 0, len = 0;
janet_dictionary_view(ds, &kvs, &len, &cap);
for (int32_t i = 0; i < cap; i++) {
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
/* Sort keys for stability of order? */
int32_t *index_buf;
int32_t index_buf_stack[32];
int32_t *index_buf_heap = NULL;
if (len < 32) {
index_buf = index_buf_stack;
} else {
index_buf_heap = janet_smalloc(sizeof(int32_t) * len);
index_buf = index_buf_heap;
}
if (len) janet_sorted_keys(kvs, cap, index_buf);
for (int32_t i = 0; i < len; i++) {
janet_v_push(ret, janetc_value(subopts, kvs[index_buf[i]].key));
janet_v_push(ret, janetc_value(subopts, kvs[index_buf[i]].value));
}
if (index_buf_heap) janet_sfree(index_buf_heap);
return ret;
}
@@ -1092,6 +1120,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
c->current_mapping.line = -1;
c->current_mapping.column = -1;
c->lints = lints;
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
/* Init result */
c->result.error = NULL;
c->result.status = JANET_COMPILE_OK;

View File

@@ -184,6 +184,9 @@ struct JanetCompiler {
/* Collect linting results */
JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
};
#define JANET_FOPTS_TAIL 0x10000
@@ -221,9 +224,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
/* Get a special. Return NULL if none exists */
const JanetSpecial *janetc_special(const uint8_t *name);
#define JANET_DEFFLAG_NO_SHADOWCHECK 1
#define JANET_DEFFLAG_NO_UNUSED 2
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
@@ -267,9 +272,12 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
/* Check if a symbol is already in scope for shadowing lints */
int janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym);
/* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(JanetFuncDef *def);

View File

@@ -27,6 +27,7 @@
#include "compile.h"
#include "state.h"
#include "util.h"
#include "fiber.h"
#endif
/* Generated bytes */
@@ -294,6 +295,7 @@ JANET_CORE_FN(janet_core_native,
"from the native module.") {
JanetModule init;
janet_arity(argc, 1, 2);
Janet argv0 = argv[0];
const uint8_t *path = janet_getstring(argv, 0);
const uint8_t *error = NULL;
JanetTable *env;
@@ -306,8 +308,10 @@ JANET_CORE_FN(janet_core_native,
if (!init) {
janet_panicf("could not load native %S: %S", path, error);
}
/* GC root incase garbage collection called inside module entry */
janet_fiber_push(janet_vm.fiber, janet_wrap_table(env));
init(env);
janet_table_put(env, janet_ckeywordv("native"), argv[0]);
janet_table_put(env, janet_ckeywordv("native"), argv0);
return janet_wrap_table(env);
}

View File

@@ -524,9 +524,9 @@ static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal s
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
if (soon) {
janet_q_push_head(&janet_vm.spawn, &t, sizeof(t));
janet_assert(!janet_q_push_head(&janet_vm.spawn, &t, sizeof(t)), "schedule queue overflow");
} else {
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
janet_assert(!janet_q_push(&janet_vm.spawn, &t, sizeof(t)), "schedule queue overflow");
}
}
@@ -959,11 +959,12 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
janet_schedule(fiber, janet_wrap_nil());
}
} else if (mode != JANET_CP_MODE_CLOSE) {
/* Fiber has already been cancelled or resumed. */
/* Fiber has already been canceled or resumed. */
/* Resend event to another waiting thread, depending on mode */
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
if (is_read) {
JanetChannelPending reader;
int sent = 0;
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
JanetVM *vm = reader.thread;
if (!vm) continue;
@@ -974,8 +975,12 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel;
msg.argj = x;
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
sent = 1;
break;
}
if (!sent) {
janet_chan_unpack(channel, &x, 1);
}
} else {
JanetChannelPending writer;
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
@@ -1001,14 +1006,14 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
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);
}
if (channel->closed) {
janet_chan_unlock(channel);
janet_panic("cannot write to closed channel");
}
if (janet_chan_pack(channel, &x)) {
janet_chan_unlock(channel);
janet_panicf("failed to pack value for channel: %v", x);
}
int is_threaded = janet_chan_is_threaded(channel);
if (is_threaded) {
/* don't dereference fiber from another thread */
@@ -1021,6 +1026,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
if (is_empty) {
/* No pending reader */
if (janet_q_push(&channel->items, &x, sizeof(Janet))) {
janet_chan_unpack(channel, &x, 1);
janet_chan_unlock(channel);
janet_panicf("channel overflow: %v", x);
} else if (janet_q_count(&channel->items) > channel->limit) {
@@ -1054,6 +1060,9 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
msg.argj = x;
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
} else {
/* If no vm to send to, we must clean up (unpack) the packed payload to avoid leak */
janet_chan_unpack(channel, &x, 1);
}
} else {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
@@ -1163,7 +1172,7 @@ JanetChannel *janet_channel_make(uint32_t limit) {
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
janet_chan_init(channel, (int32_t) limit, 1);
return channel;
}
@@ -1199,20 +1208,6 @@ 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 "
@@ -1241,29 +1236,27 @@ 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_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_channel_pop_with_lock(chan, &item, 1);
chan_unlock_args(argv, i);
return make_read_result(chan, item);
}
janet_chan_unlock(chan);
}
}
@@ -1474,11 +1467,12 @@ static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
int32_t limit = janet_unmarshal_int(ctx);
int32_t count = janet_unmarshal_int(ctx);
if (count < 0) janet_panic("invalid negative channel count");
if (count > limit) janet_panic("invalid channel count");
janet_chan_init(abst, limit, 0);
abst->closed = !!is_closed;
for (int32_t i = 0; i < count; i++) {
Janet item = janet_unmarshal_janet(ctx);
janet_q_push(&abst->items, &item, sizeof(item));
janet_assert(!janet_q_push(&abst->items, &item, sizeof(item)), "bad unmarshal channel");
}
return abst;
}
@@ -1718,20 +1712,20 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
janet_free(response);
} else {
/* Normal event */
JanetOverlapped *jo = (JanetOverlapped *) overlapped;
JanetStream *stream = (JanetStream *) completionKey;
JanetFiber *fiber = NULL;
if (stream->read_fiber && stream->read_fiber->ev_state == overlapped) {
if (stream->read_fiber && stream->read_fiber->ev_state == jo) {
fiber = stream->read_fiber;
} else if (stream->write_fiber && stream->write_fiber->ev_state == overlapped) {
} else if (stream->write_fiber && stream->write_fiber->ev_state == jo) {
fiber = stream->write_fiber;
}
if (fiber != NULL) {
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
/* System is done with this, we can reused this data */
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred;
jo->bytes_transfered = (ULONG_PTR) num_bytes_transferred;
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
} else {
janet_free((void *) overlapped);
janet_free((void *) jo);
janet_ev_dec_refcount();
}
janet_stream_checktoclose(stream);
@@ -2416,7 +2410,7 @@ Janet janet_ev_lasterr(void) {
msgbuf,
sizeof(msgbuf),
NULL);
if (!*msgbuf) sprintf(msgbuf, "%d", code);
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%d", code);
char *c = msgbuf;
while (*c) {
if (*c == '\n' || *c == '\r') {
@@ -2443,7 +2437,7 @@ typedef enum {
typedef struct {
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
JanetOverlapped overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
@@ -2478,7 +2472,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_FAILED:
case JANET_ASYNC_EVENT_COMPLETE: {
/* Called when read finished */
uint32_t ev_bytes = (uint32_t) state->overlapped.InternalHigh;
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
state->bytes_read += ev_bytes;
if (state->bytes_read == 0 && (state->mode != JANET_ASYNC_READMODE_RECVFROM)) {
janet_schedule(fiber, janet_wrap_nil());
@@ -2510,7 +2504,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
/* fallthrough */
case JANET_ASYNC_EVENT_INIT: {
int32_t chunk_size = state->bytes_left > JANET_EV_CHUNKSIZE ? JANET_EV_CHUNKSIZE : state->bytes_left;
memset(&(state->overlapped), 0, sizeof(OVERLAPPED));
memset(&(state->overlapped), 0, sizeof(JanetOverlapped));
int status;
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
@@ -2518,7 +2512,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
state->wbuf.buf = (char *) state->chunk_buf;
state->fromlen = sizeof(state->from);
status = WSARecvFrom((SOCKET) stream->handle, &state->wbuf, 1,
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped.as.wsaoverlapped, NULL);
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
janet_cancel(fiber, janet_ev_lasterr());
janet_async_end(fiber);
@@ -2529,9 +2523,9 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
{
/* Some handles (not all) read from the offset in lpOverlapped
* if its not set before calling `ReadFile` these streams will always read from offset 0 */
state->overlapped.Offset = (DWORD) state->bytes_read;
state->overlapped.as.overlapped.Offset = (DWORD) state->bytes_read;
status = ReadFile(stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
status = ReadFile(stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped.as.overlapped);
if (!status && (ERROR_IO_PENDING != GetLastError())) {
if (GetLastError() == ERROR_BROKEN_PIPE) {
if (state->bytes_read) {
@@ -2687,7 +2681,7 @@ typedef enum {
typedef struct {
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
JanetOverlapped overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
@@ -2728,7 +2722,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_FAILED:
case JANET_ASYNC_EVENT_COMPLETE: {
/* Called when write finished */
uint32_t ev_bytes = (uint32_t) state->overlapped.InternalHigh;
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
if (ev_bytes == 0 && (state->mode != JANET_ASYNC_WRITEMODE_SENDTO)) {
janet_cancel(fiber, janet_cstringv("disconnect"));
janet_async_end(fiber);
@@ -2757,7 +2751,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
bytes = state->src.str;
len = janet_string_length(bytes);
}
memset(&(state->overlapped), 0, sizeof(WSAOVERLAPPED));
memset(&(state->overlapped), 0, sizeof(JanetOverlapped));
int status;
#ifdef JANET_NET
@@ -2767,7 +2761,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
state->wbuf.len = len;
const struct sockaddr *to = state->dest_abst;
int tolen = (int) janet_abstract_size((void *) to);
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped, NULL);
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped.as.wsaoverlapped, NULL);
if (status) {
if (WSA_IO_PENDING == WSAGetLastError()) {
janet_async_in_flight(fiber);
@@ -2790,9 +2784,9 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
* for more details see the lpOverlapped parameter in
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile
*/
state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
status = WriteFile(stream->handle, bytes, len, NULL, &state->overlapped);
state->overlapped.as.overlapped.Offset = (DWORD) 0xFFFFFFFF;
state->overlapped.as.overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
status = WriteFile(stream->handle, bytes, len, NULL, &state->overlapped.as.overlapped);
if (!status) {
if (ERROR_IO_PENDING == GetLastError()) {
janet_async_in_flight(fiber);
@@ -2948,10 +2942,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1;
return 0;
}
sprintf(PipeNameBuffer,
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
snprintf(PipeNameBuffer,
sizeof(PipeNameBuffer),
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
/* server handle goes to subprocess */
shandle = CreateNamedPipeA(

View File

@@ -592,8 +592,8 @@ JANET_CORE_FN(cfun_fiber_status,
"* :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") {
"* :new - the fiber has just been created and not yet run\n"
"* :alive - the fiber is currently running and cannot be resumed") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
uint32_t s = janet_fiber_status(fiber);

View File

@@ -326,7 +326,7 @@ static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uin
#define FILE_INFO_PADDING (4096 * 4)
typedef struct {
OVERLAPPED overlapped;
JanetOverlapped overlapped;
JanetStream *stream;
JanetWatcher *watcher;
JanetFiber *fiber;
@@ -456,7 +456,7 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
Janet pathv = janet_wrap_string(ow->dir_path);
ow->flags = flags | watcher->default_flags;
ow->watcher = watcher;
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
ow->overlapped.as.overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
Janet streamv = janet_wrap_pointer(ow);
janet_table_put(watcher->watch_descriptors, pathv, streamv);
if (watcher->is_watching) {

View File

@@ -43,6 +43,7 @@ static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
#ifdef JANET_WINDOWS
#include <io.h>
#define ftell _ftelli64
#define fseek _fseeki64
#endif
@@ -109,10 +110,11 @@ static int32_t checkflags(const uint8_t *str) {
return flags;
}
static void *makef(FILE *f, int32_t flags) {
static void *makef(FILE *f, int32_t flags, size_t bufsize) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
iof->vbufsize = bufsize;
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
* not standard. */
@@ -164,6 +166,7 @@ JANET_CORE_FN(cfun_io_fopen,
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
size_t bufsize = BUFSIZ;
if (f != NULL) {
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
struct stat st;
@@ -173,7 +176,7 @@ JANET_CORE_FN(cfun_io_fopen,
janet_panicf("cannot open directory: %s", fname);
}
#endif
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
if (result) {
@@ -181,7 +184,7 @@ JANET_CORE_FN(cfun_io_fopen,
}
}
}
return f ? janet_makefile(f, flags)
return f ? janet_wrap_abstract(makef(f, flags, bufsize))
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
@@ -410,12 +413,23 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
JanetFile *iof = (JanetFile *)p;
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
janet_marshal_abstract(ctx, p);
int fno = -1;
#ifdef JANET_WINDOWS
janet_marshal_int(ctx, _fileno(iof->file));
if (iof->flags & JANET_FILE_NOT_CLOSEABLE) {
fno = _fileno(iof->file);
} else {
fno = _dup(_fileno(iof->file));
}
#else
janet_marshal_int(ctx, fileno(iof->file));
if (iof->flags & JANET_FILE_NOT_CLOSEABLE) {
fno = fileno(iof->file);
} else {
fno = dup(fileno(iof->file));
}
#endif
janet_marshal_int(ctx, fno);
janet_marshal_int(ctx, iof->flags);
janet_marshal_size(ctx, iof->vbufsize);
} else {
janet_panic("cannot marshal file in safe mode");
}
@@ -444,6 +458,11 @@ static void *io_file_unmarshal(JanetMarshalContext *ctx) {
} else {
iof->flags = flags;
}
iof->vbufsize = janet_unmarshal_size(ctx);
if (iof->vbufsize != BUFSIZ) {
int result = setvbuf(iof->file, NULL, iof->vbufsize ? _IOFBF : _IONBF, iof->vbufsize);
janet_assert(!result, "unmarshal setvbuf");
}
return iof;
} else {
janet_panic("cannot unmarshal file in safe mode");
@@ -785,11 +804,11 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
}
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
return makef(f, flags);
return makef(f, flags, BUFSIZ);
}
Janet janet_makefile(FILE *f, int32_t flags) {
return janet_wrap_abstract(makef(f, flags));
return janet_wrap_abstract(makef(f, flags, BUFSIZ));
}
JanetAbstract janet_checkfile(Janet j) {

View File

@@ -140,6 +140,35 @@ static int net_get_address_family(Janet x) {
}
/* State machine for async connect */
#ifdef JANET_WINDOWS
typedef struct NetStateConnect {
/* Only used for ConnectEx */
JanetOverlapped overlapped;
} NetStateConnect;
static LPFN_CONNECTEX lazy_get_connectex(JSock sock) {
/* Get ConnectEx */
if (janet_vm.connect_ex_loaded) {
return janet_vm.connect_ex;
}
GUID guid = WSAID_CONNECTEX;
LPFN_CONNECTEX connect_ex_ptr = NULL;
DWORD byte_len = 0;
int success = WSAIoctl(sock, SIO_GET_EXTENSION_FUNCTION_POINTER,
(void*)&guid, sizeof(guid),
(void*)&connect_ex_ptr, sizeof(connect_ex_ptr),
&byte_len, NULL, NULL);
if (success) {
janet_vm.connect_ex = connect_ex_ptr;
} else {
janet_vm.connect_ex = NULL;
}
janet_vm.connect_ex_loaded = 1;
return janet_vm.connect_ex;
}
#endif
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
@@ -159,15 +188,21 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
return;
}
#ifdef JANET_WINDOWS
/* We should be using ConnectEx here */
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_CONNECT_TIME, (char *)&res, &size);
if (r == NO_ERROR && res == 0xFFFFFFFF) {
return; /* This apparently indicates we haven't yet gotten a connection */
}
const int no_error = NO_ERROR;
#else
int res = 0;
socklen_t size = sizeof res;
socklen_t size = sizeof(res);
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
const int no_error = 0;
#endif
if (r == 0) {
if (r == no_error) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
@@ -181,8 +216,8 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
janet_async_end(fiber);
}
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream, void *state) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, state);
}
/* State machine for accepting connections. */
@@ -190,7 +225,7 @@ static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
#ifdef JANET_WINDOWS
typedef struct {
WSAOVERLAPPED overlapped;
JanetOverlapped overlapped;
JanetFunction *function;
JanetStream *lstream;
JanetStream *astream;
@@ -253,7 +288,7 @@ void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
memset(&state->overlapped, 0, sizeof(JanetOverlapped));
memset(&state->buf, 0, 1024);
state->function = fun;
state->lstream = stream;
@@ -274,7 +309,7 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
JanetStream *astream = make_stream(asock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
state->astream = astream;
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped.as.wsaoverlapped)) {
int code = WSAGetLastError();
if (code == WSA_IO_PENDING) {
/* indicates io is happening async */
@@ -570,15 +605,44 @@ JANET_CORE_FN(cfun_net_connect,
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
/* Set up the socket for non-blocking IO before connecting */
janet_net_socknoblock(sock);
/* Connect to socket */
#ifdef JANET_WINDOWS
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
int err = WSAGetLastError();
freeaddrinfo(ai);
int status = 0;
int err = 0;
LPFN_CONNECTEX connect_ex = NULL;
if (socktype == SOCK_STREAM && ((connect_ex = lazy_get_connectex(sock)))) {
/* Prefer ConnecEx as it works well with overlapped IO. */
janet_net_socknoblock(sock);
NetStateConnect *state = janet_malloc(sizeof(NetStateConnect));
memset(state, 0, sizeof(NetStateConnect));
BOOL success = connect_ex(sock, addr, addrlen, NULL, 0, NULL, &state->overlapped.as.overlapped);
freeaddrinfo(ai);
if (success) {
/* Did not fail */
} else {
int err = WSAGetLastError();
if (err == ERROR_IO_PENDING) {
/* Did not actually fail yet */
} else {
janet_free(state);
Janet lasterr = janet_ev_lasterr();
janet_panicf("could not connect socket (ConnectEx): %V", lasterr);
}
}
net_sched_connect(stream, state);
} else {
/* Default to blocking connect if ConnectEx not available */
status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
err = WSAGetLastError();
freeaddrinfo(ai);
/* Set up the socket for non-blocking IO after connecting on windows by default */
janet_net_socknoblock(sock);
}
#else
/* Set up the socket for non-blocking IO before connecting */
janet_net_socknoblock(sock);
int status;
do {
status = connect(sock, addr, addrlen);
@@ -599,10 +663,11 @@ JANET_CORE_FN(cfun_net_connect,
return janet_wrap_abstract(stream);
}
if (status == -1) {
#ifdef JANET_WINDOWS
if (status == SOCKET_ERROR) {
if (err != WSAEWOULDBLOCK) {
#else
if (status == -1) {
if (err != EINPROGRESS) {
#endif
JSOCKCLOSE(sock);
@@ -611,7 +676,7 @@ JANET_CORE_FN(cfun_net_connect,
}
}
net_sched_connect(stream);
net_sched_connect(stream, NULL);
}
JANET_CORE_FN(cfun_net_socket,
@@ -1120,7 +1185,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
val.v_int = janet_getboolean(argv, 2);
optlen = sizeof(val.v_int);
} else if (st->type == JANET_NUMBER) {
#ifdef JANET_BSD
#if defined(JANET_BSD) || defined(JANET_ILLUMOS)
int v_int = janet_getinteger(argv, 2);
if (st->optname == IP_MULTICAST_TTL) {
val.v_uchar = v_int;
@@ -1211,6 +1276,8 @@ void janet_net_init(void) {
#ifdef JANET_WINDOWS
WSADATA wsaData;
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
janet_vm.connect_ex_loaded = 0;
janet_vm.connect_ex = NULL;
#endif
}

View File

@@ -40,6 +40,7 @@
#include <sys/stat.h>
#include <signal.h>
#include <locale.h>
#include <inttypes.h>
#ifdef JANET_BSD
#include <sys/sysctl.h>
@@ -1331,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
msgbuf,
sizeof(msgbuf),
NULL);
if (!*msgbuf) sprintf(msgbuf, "%d", cp_error_code);
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%" PRIu32, (uint32_t) cp_error_code);
char *c = msgbuf;
while (*c) {
if (*c == '\n' || *c == '\r') {
@@ -2578,7 +2579,7 @@ JANET_CORE_FN(os_dir,
char pattern[MAX_PATH + 1];
if (strlen(dir) > (sizeof(pattern) - 3))
janet_panicf("path too long: %s", dir);
sprintf(pattern, "%s/*", dir);
snprintf(pattern, sizeof(pattern), "%s/*", dir);
intptr_t res = _findfirst(pattern, &afile);
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
do {

View File

@@ -220,9 +220,9 @@ tail:
janet_eprintf("tag stack [%d]:\n", s->tagged_captures->count);
for (int32_t i = 0; i < s->tagged_captures->count; i++) {
if (has_color) {
janet_eprintf(" [%d] tag=%d: %M\n", i, s->tags->data[i], s->tagged_captures->data[i]);
janet_eprintf(" [%d] tag=%d: %M\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
} else {
janet_eprintf(" [%d] tag=%d: %m\n", i, s->tags->data[i], s->tagged_captures->data[i]);
janet_eprintf(" [%d] tag=%d: %m\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
}
}
}

View File

@@ -72,7 +72,7 @@ static int count_dig10(int32_t x) {
}
}
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
static int32_t integer_to_string_b(JanetBuffer *buffer, int32_t x) {
janet_buffer_extra(buffer, BUFSIZE);
uint8_t *buf = buffer->data + buffer->count;
int32_t neg = 0;
@@ -80,7 +80,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
if (x == 0) {
buf[0] = '0';
buffer->count++;
return;
return 1;
}
if (x > 0) {
x = -x;
@@ -96,6 +96,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
x /= 10;
}
buffer->count += len + neg;
return len + neg;
}
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
@@ -134,43 +135,55 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
static int janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
int align = 1;
for (int32_t i = 0; i < len; ++i) {
uint8_t c = str[i];
switch (c) {
case '"':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
align += 2;
break;
case '\n':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
align += 2;
break;
case '\r':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
align += 2;
break;
case '\0':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
align += 2;
break;
case '\f':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
align += 2;
break;
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
align += 2;
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
align += 2;
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
align += 2;
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
align += 2;
break;
case '\\':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
align += 2;
break;
case '\t':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
align += 2;
break;
default:
if (c < 32 || c > 126) {
@@ -180,13 +193,16 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
buf[2] = janet_base64[(c >> 4) & 0xF];
buf[3] = janet_base64[c & 0xF];
janet_buffer_push_bytes(buffer, buf, 4);
align += 4;
} else {
janet_buffer_push_u8(buffer, c);
align++;
}
break;
}
}
janet_buffer_push_u8(buffer, '"');
return align + 1;
}
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
@@ -358,7 +374,7 @@ const uint8_t *janet_to_string(Janet x) {
struct pretty {
JanetBuffer *buffer;
int depth;
int indent;
int align;
int flags;
int32_t bufstartlen;
int32_t *keysort_buffer;
@@ -450,14 +466,15 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
return 0;
}
static void print_newline(struct pretty *S, int just_a_space) {
static void print_newline(struct pretty *S, int align) {
int i;
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
S->align = align;
if (S->flags & JANET_PRETTY_ONELINE) {
janet_buffer_push_u8(S->buffer, ' ');
return;
}
janet_buffer_push_u8(S->buffer, '\n');
for (i = 0; i < S->indent; i++) {
for (i = 0; i < S->align; i++) {
janet_buffer_push_u8(S->buffer, ' ');
}
}
@@ -484,13 +501,12 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m"
};
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
#define JANET_PRETTY_ARRAY_LIMIT 160
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
static void janet_pretty_one(struct pretty *S, Janet x) {
/* Add to seen */
switch (janet_type(x)) {
case JANET_NIL:
@@ -505,7 +521,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
}
janet_buffer_push_cstring(S->buffer, "<cycle ");
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
S->align += 8 + integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
janet_buffer_push_u8(S->buffer, '>');
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -527,9 +543,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
janet_buffer_push_u8(S->buffer, '@');
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
S->align += 1 + janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
} else {
S->align -= S->buffer->count;
janet_description_b(S->buffer, x);
S->align += S->buffer->count;
}
if (color && (S->flags & JANET_PRETTY_COLOR)) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -546,35 +564,34 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
janet_buffer_push_cstring(S->buffer, startstr);
const int align = S->align += strlen(startstr);
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
for (i = 0; i < 3; i++) {
if (i) print_newline(S, 0);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
print_newline(S, 0);
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
for (i = 0; i < 3; i++) {
print_newline(S, 0);
janet_pretty_one(S, arr[len - 3 + i], 0);
S->align += 3;
for (i = len - 3; i < len; i++) {
print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
} else {
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
}
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, endchar);
S->align++;
break;
}
case JANET_STRUCT:
@@ -585,6 +602,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (istable) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
S->align++;
janet_buffer_push_cstring(S->buffer, "@");
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
@@ -595,6 +613,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
@@ -612,73 +631,99 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
}
}
}
janet_buffer_push_cstring(S->buffer, "{");
janet_buffer_push_u8(S->buffer, '{');
const int align = ++S->align;
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
int32_t i = 0, len = 0, cap = 0;
int32_t len = 0, cap = 0;
const JanetKV *kvs = NULL;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
int32_t ks_start = S->keysort_start;
/* Ensure buffer is large enough to sort keys. */
int truncated = 0;
int64_t mincap = (int64_t) len + (int64_t) ks_start;
if (mincap > INT32_MAX) {
truncated = 1;
len = 0;
mincap = ks_start;
}
if (S->keysort_capacity < mincap) {
if (mincap >= INT32_MAX / 2) {
S->keysort_capacity = INT32_MAX;
} else {
S->keysort_capacity = (int32_t)(mincap * 2);
/* Shortcut for huge dictionaries, don't bother sorting keys */
if (len > JANET_PRETTY_DICT_KEYSORT_LIMIT) {
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
truncated = 1;
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
int32_t j = 0;
for (int32_t i = 0; i < len; i++) {
while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
if (i) print_newline(S, align);
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
S->align++;
janet_pretty_one(S, kvs[j].value);
j++;
}
}
if (truncated) {
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
} else {
/* Sorted keys dictionaries */
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;
truncated = 1;
}
/* Ensure buffer is large enough to sort keys. */
int64_t mincap = (int64_t) len + (int64_t) ks_start;
if (mincap > INT32_MAX) {
truncated = 1;
len = 0;
mincap = ks_start;
}
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
}
if (S->keysort_capacity < mincap) {
if (mincap >= INT32_MAX / 2) {
S->keysort_capacity = INT32_MAX;
} else {
S->keysort_capacity = (int32_t)(mincap * 2);
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
}
}
if (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
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;
truncated = 1;
}
for (int32_t i = 0; i < len; i++) {
if (i) print_newline(S, align);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
S->align++;
janet_pretty_one(S, kvs[j].value);
}
if (truncated) {
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
}
S->keysort_start = ks_start;
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, '}');
S->align++;
break;
}
}
@@ -694,14 +739,14 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.align = 0;
S.flags = flags;
S.bufstartlen = startlen;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
janet_table_init(&S.seen, 10);
janet_pretty_one(&S, x, 0);
janet_pretty_one(&S, x);
janet_table_deinit(&S.seen);
return S.buffer;
}
@@ -719,7 +764,7 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.align = 0;
S.flags = 0;
S.bufstartlen = startlen;
S.keysort_capacity = 0;
@@ -897,7 +942,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
case 's':
case 'S': {
const char *str = va_arg(args, const char *);
int32_t len = c[-1] == 's'
int32_t len = (c[-1] == 's')
? (int32_t) strlen(str)
: janet_string_length((JanetString) str);
if (form[2] == '\0')

View File

@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
}
/* Def or var a symbol in a local scope */
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, uint32_t def_flags) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
@@ -425,11 +425,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
ret = localslot;
}
ret.flags |= flags;
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
janetc_nameslot_no_unused(c, head, ret);
} else {
janetc_nameslot(c, head, ret);
if (c->scope->flags & JANET_SCOPE_TOP) {
def_flags |= JANET_DEFFLAG_NO_UNUSED;
}
janetc_nameslot(c, head, ret, def_flags);
return !isUnnamedRegister;
}
@@ -443,7 +442,7 @@ static int varleaf(
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
int is_redef = c->is_redef;
JanetArray *ref;
JanetBinding old_binding;
@@ -464,7 +463,11 @@ static int varleaf(
return 1;
} else {
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
int no_shadow = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "shadow"));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, def_flags);
}
}
@@ -505,12 +508,14 @@ static int defleaf(
const uint8_t *sym,
JanetSlot s,
JanetTable *tab) {
JanetTable *entry = NULL;
int is_redef = 0;
if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *entry = janet_table_clone(tab);
entry = janet_table_clone(tab);
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
is_redef = c->is_redef;
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
if (is_redef) {
@@ -530,12 +535,18 @@ static int defleaf(
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
/* Add env entry to env */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
return namelocal(c, sym, 0, s, no_unused);
int no_shadow = is_redef || (tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "shadow")));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
int result = namelocal(c, sym, 0, s, def_flags);
if (entry) {
/* Add env entry to env AFTER namelocal to avoid the shadowcheck false positive */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
return result;
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -909,7 +920,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0);
/* Compile function */
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
def->name = janet_cstring("while");
janet_def_addflags(def);
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
@@ -1066,10 +1077,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
named_table = janet_table(10);
named_slot = janetc_farslot(c);
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janet_v_push(destructed_params, janetc_farslot(c));
@@ -1118,7 +1129,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot_no_unused(c, sym, slot);
/* We should figure out a better way to avoid `(def x 1) (def x :shadow (fn x [...] ...))` triggering a
* shadow lint for the last x */
janetc_nameslot(c, sym, slot, JANET_DEFFLAG_NO_UNUSED | JANET_DEFFLAG_NO_SHADOWCHECK);
}
}

View File

@@ -182,6 +182,8 @@ struct JanetVM {
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
void *connect_ex; /* MSWsock extension if available */
int connect_ex_loaded;
#elif defined(JANET_EV_EPOLL)
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];

View File

@@ -157,7 +157,7 @@ Janet janet_table_get(JanetTable *t, Janet key) {
/* Used internally for compiler stuff */
Janet janet_table_get_keyword(JanetTable *t, const char *keyword) {
int32_t keyword_len = strlen(keyword);
int32_t keyword_len = (int32_t) strlen(keyword);
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
JanetKV *bucket = (JanetKV *) janet_dict_find_keyword(t->data, t->capacity, (const uint8_t *) keyword, keyword_len);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))

View File

@@ -268,7 +268,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
return (int32_t) hash;
}
/* Calculate next power of 2. May overflow. If n is 0,
/* Calculate next power of 2. May overflow. If n < 0,
* will return 0. */
int32_t janet_tablen(int32_t n) {
if (n < 0) return 0;

View File

@@ -203,6 +203,21 @@ char *get_processed_name(const char *name);
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#endif
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <io.h>
typedef struct {
union {
OVERLAPPED overlapped;
WSAOVERLAPPED wsaoverlapped;
} as;
uint32_t bytes_transfered;
} JanetOverlapped;
#endif
#endif
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
void janet_lib_math(JanetTable *env);

View File

@@ -335,10 +335,9 @@ int32_t janet_hash(Janet x) {
} as;
as.d = janet_unwrap_number(x);
as.d += 0.0; /* normalize negative 0 */
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
as.u = murmur64(as.u);
uint32_t hi = (uint32_t)(as.u >> 32);
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
hash = (int32_t)hi;
break;
}
case JANET_ABSTRACT: {
@@ -496,7 +495,7 @@ Janet janet_in(Janet ds, Janet key) {
if (!(type->get)(janet_unwrap_abstract(ds), key, &value))
janet_panicf("key %v not found in %v ", key, ds);
} else {
janet_panicf("no getter for %v ", ds);
janet_panicf("no getter for %v", ds);
}
break;
}
@@ -623,7 +622,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
if (!(type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index), &value))
value = janet_wrap_nil();
} else {
janet_panicf("no getter for %v ", ds);
janet_panicf("no getter for %v", ds);
}
break;
}
@@ -725,6 +724,9 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
JanetArray *array = janet_unwrap_array(ds);
if (index >= array->count) {
janet_array_ensure(array, index + 1, 2);
for (int32_t i = array->count; i < index + 1; i++) {
array->data[i] = janet_wrap_nil();
}
array->count = index + 1;
}
array->data[index] = value;
@@ -736,6 +738,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
janet_panicf("can only put integers in buffers, got %v", value);
if (index >= buffer->count) {
janet_buffer_ensure(buffer, index + 1, 2);
memset(buffer->data + buffer->count, 0, index + 1 - buffer->count);
buffer->count = index + 1;
}
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
@@ -769,6 +772,9 @@ void janet_put(Janet ds, Janet key, Janet value) {
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
if (index >= array->count) {
janet_array_ensure(array, index + 1, 2);
for (int32_t i = array->count; i < index + 1; i++) {
array->data[i] = janet_wrap_nil();
}
array->count = index + 1;
}
array->data[index] = value;
@@ -781,6 +787,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
janet_panicf("can only put integers in buffers, got %v", value);
if (index >= buffer->count) {
janet_buffer_ensure(buffer, index + 1, 2);
memset(buffer->data + buffer->count, 0, index + 1 - buffer->count);
buffer->count = index + 1;
}
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);

View File

@@ -129,7 +129,9 @@
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
Janet a = janet_mcall(#op, 2, _argv);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
} else {\
double x1 = janet_unwrap_number(op1);\
@@ -143,7 +145,9 @@
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
Janet a = janet_mcall(#op, 2, _argv);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
} else {\
double y1 = janet_unwrap_number(op1);\
@@ -166,7 +170,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
Janet a = janet_binop_call(#op, "r" #op, op1, op2);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -186,7 +192,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
Janet a = janet_binop_call(#op, "r" #op, op1, op2);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -203,7 +211,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
Janet a = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -217,7 +227,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
Janet a = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -710,7 +722,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
Janet a = janet_binop_call("div", "rdiv", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -730,7 +744,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
Janet a = janet_binop_call("mod", "rmod", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -745,7 +761,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("%", "r%", op1, op2);
Janet a = janet_binop_call("%", "r%", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -766,7 +784,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_unary_call("~", op);
Janet a = janet_unary_call("~", op);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -872,8 +892,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
vm_pcnext();
VM_OP(JOP_COMPARE)
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
VM_OP(JOP_COMPARE) {
Janet a = janet_wrap_integer(janet_compare(stack[B], stack[C]));
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_NEXT)
@@ -1104,11 +1127,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
fiber->child = child;
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
stack = fiber->data + fiber->frame;
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
vm_checkgc_pcnext();
}
@@ -1157,6 +1180,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_put(stack[A], stack[B], stack[C]);
stack = fiber->data + fiber->frame;
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
@@ -1164,27 +1188,44 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_putindex(stack[A], C, stack[B]);
stack = fiber->data + fiber->frame;
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
VM_OP(JOP_IN)
vm_commit();
stack[A] = janet_in(stack[B], stack[C]);
{
Janet a = janet_in(stack[B], stack[C]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_GET)
vm_commit();
stack[A] = janet_get(stack[B], stack[C]);
{
Janet a = janet_get(stack[B], stack[C]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_GET_INDEX)
vm_commit();
stack[A] = janet_getindex(stack[B], C);
{
Janet a = janet_getindex(stack[B], C);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_LENGTH)
vm_commit();
stack[A] = janet_lengthv(stack[E]);
{
Janet a = janet_lengthv(stack[E]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_MAKE_ARRAY) {
@@ -1518,6 +1559,15 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
}
}
/* If this is a nested continue (root_fiber already set), root the fiber
* so it survives GC. janet_collect only marks root_fiber, so without
* this a nested fiber (e.g., from janet_pcall in a C function) would be
* invisible to GC and could be collected while actively running. */
int fiber_rooted = (janet_vm.root_fiber != NULL);
if (fiber_rooted) {
janet_gcroot(janet_wrap_fiber(fiber));
}
/* Save global state */
JanetTryState tstate;
JanetSignal sig = janet_try(&tstate);
@@ -1533,6 +1583,9 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
janet_fiber_set_status(fiber, sig);
janet_restore(&tstate);
if (fiber_rooted) {
janet_gcunroot(janet_wrap_fiber(fiber));
}
fiber->last_value = tstate.payload;
*out = tstate.payload;

View File

@@ -1281,6 +1281,7 @@ typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int32_t flags;
size_t vbufsize;
};
/* For janet_try and janet_restore */

View File

@@ -26,6 +26,7 @@
#include <janet.h>
#include <errno.h>
#include <assert.h>
#ifdef _WIN32
#include <windows.h>
@@ -362,33 +363,50 @@ static void clear(void) {
}
}
static int getplen(void) {
int _plen = gbl_plen;
/* Ensure at least 16 characters of data entry; */
while (_plen && (_plen + 16 > gbl_cols)) {
_plen--;
}
return _plen;
}
static void refresh(void) {
char seq[64];
JanetBuffer b;
/* If prompt is too long, truncate */
int _plen = getplen();
/* Keep cursor position on screen */
char *_buf = gbl_buf;
int _len = gbl_len;
int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
while ((_plen + _pos) >= gbl_cols) {
_buf++;
_len--;
_pos--;
}
while ((gbl_plen + _len) > gbl_cols) {
while ((_plen + _len) > gbl_cols) {
_len--;
}
janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
janet_buffer_push_bytes(&b, (const uint8_t *) gbl_prompt, _plen);
if (_len > 0) {
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
}
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K\r");
/* Move cursor to original position. */
if (_pos + gbl_plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + gbl_plen));
if (_pos + _plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + _plen));
janet_buffer_push_cstring(&b, seq);
}
if (write_console((char *) b.data, b.count) == -1) {
@@ -414,7 +432,8 @@ static int insert(char c, int draw) {
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (draw) {
if (gbl_plen + gbl_len < gbl_cols) {
int _plen = getplen();
if (_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write_console(&c, 1) == -1) return -1;
@@ -925,11 +944,12 @@ static int line() {
gbl_len = 0;
gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++;
int _plen = getplen();
gbl_buf[0] = '\0';
addhistory();
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
if (write_console((char *) gbl_prompt, _plen) == -1) return -1;
for (;;) {
char c;
char seq[5];
@@ -1258,7 +1278,10 @@ int main(int argc, char **argv) {
status = janet_loop_fiber(fiber);
/* Deinitialize vm */
#if !defined(JANET_SIMPLE_GETLINE)
savehistory();
#endif
janet_deinit();
janet_line_deinit();

143
test/c/test-gc-pcall.c Normal file
View File

@@ -0,0 +1,143 @@
/*
* Test that GC does not collect fibers during janet_pcall.
*
* Bug: janet_collect() marks janet_vm.root_fiber but not janet_vm.fiber.
* When janet_pcall is called from a C function, the inner fiber becomes
* janet_vm.fiber while root_fiber still points to the outer fiber. If GC
* triggers inside the inner fiber's execution, the inner fiber is not in
* any GC root set and can be collected — including its stack memory —
* while it is actively running.
*
* Two tests:
* 1. Single nesting: F1 -> C func -> janet_pcall -> F2
* F2 is not marked (it's janet_vm.fiber but not root_fiber)
* 2. Deep nesting: F1 -> C func -> janet_pcall -> F2 -> C func -> janet_pcall -> F3
* F2 is not marked (saved only in a C stack local tstate.vm_fiber)
*
* Build (after building janet):
* cc -o build/test-gc-pcall test/test-gc-pcall.c \
* -Isrc/include -Isrc/conf build/libjanet.a -lm -lpthread -ldl
*
* Run:
* ./build/test-gc-pcall
*/
#include "janet.h"
#include <stdio.h>
/* C function that calls a Janet callback via janet_pcall. */
static Janet cfun_call_via_pcall(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFunction *fn = janet_getfunction(argv, 0);
Janet result;
JanetFiber *fiber = NULL;
JanetSignal sig = janet_pcall(fn, 0, NULL, &result, &fiber);
if (sig != JANET_SIGNAL_OK) {
janet_panicv(result);
}
return result;
}
static int run_test(JanetTable *env, const char *name, const char *source) {
printf(" %s... ", name);
fflush(stdout);
Janet result;
int status = janet_dostring(env, source, name, &result);
if (status != 0) {
printf("FAIL (crashed or errored)\n");
return 1;
}
printf("PASS\n");
return 0;
}
/* Test 1: Single nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2
* F2 is janet_vm.fiber but not root_fiber, so GC can collect it.
*
* All allocations are done in Janet code so GC checks trigger in the
* VM loop (janet_gcalloc does NOT call janet_collect — only the VM's
* vm_checkgc_next does). */
static const char test_single[] =
"(gcsetinterval 1024)\n"
"(def cb\n"
" (do\n"
" (def captured @{:key \"value\" :nested @[1 2 3 4 5]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"(for round 0 200\n"
" (def result (call-via-pcall cb))\n"
" (assert (= result \"value\")\n"
" (string \"round \" round \": expected 'value', got \" (describe result))))\n";
/* Test 2: Deep nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2 -> cfun_call_via_pcall -> janet_pcall -> F3
* F2 is saved only in C stack local tstate.vm_fiber, invisible to GC.
* F2's stack data can be freed if F2 is collected during F3's execution.
*
* The inner callback allocates in Janet code (not C) to ensure the
* VM loop triggers GC checks during F3's execution. */
static const char test_deep[] =
"(gcsetinterval 1024)\n"
"(def inner-cb\n"
" (do\n"
" (def captured @{:key \"deep\" :nested @[10 20 30]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"\n"
"(def outer-cb\n"
" (do\n"
" (def state @{:count 0 :data @[\"a\" \"b\" \"c\" \"d\" \"e\"]})\n"
" (fn []\n"
" # This runs on F2. Calling call-via-pcall here creates F3.\n"
" # F2 becomes unreachable: it's not root_fiber (that's F1)\n"
" # and it's no longer janet_vm.fiber (that's now F3).\n"
" (def inner-result (call-via-pcall inner-cb))\n"
" # If F2 was collected during F3's execution, accessing\n"
" # state here reads freed memory.\n"
" (put state :count (+ (state :count) 1))\n"
" (string inner-result \"-\" (state :count)))))\n"
"\n"
"(for round 0 200\n"
" (def result (call-via-pcall outer-cb))\n"
" (def expected (string \"deep-\" (+ round 1)))\n"
" (assert (= result expected)\n"
" (string \"round \" round \": expected '\" expected \"', got '\" (describe result) \"'\")))\n";
int main(int argc, char **argv) {
(void)argc;
(void)argv;
int failures = 0;
janet_init();
JanetTable *env = janet_core_env(NULL);
janet_def(env, "call-via-pcall",
janet_wrap_cfunction(cfun_call_via_pcall),
"Call a function via janet_pcall from C.");
printf("Testing janet_pcall GC safety:\n");
failures += run_test(env, "single-nesting", test_single);
failures += run_test(env, "deep-nesting", test_deep);
janet_deinit();
if (failures > 0) {
printf("\n%d test(s) FAILED\n", failures);
return 1;
}
printf("\nAll tests passed.\n");
return 0;
}

View File

@@ -27,9 +27,11 @@
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(when is-verbose
(eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)
(eflush) (flush))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
x)
(defn skip-asserts
@@ -38,7 +40,7 @@
(+= skip-n n)
nil)
(defmacro assert
(defmacro assert :shadow
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
@@ -50,12 +52,12 @@
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error
[form]

View File

@@ -70,9 +70,9 @@
(assert (= (array/pop @[]) nil) "array/pop empty")
# Code coverage
(def a @[1])
(array/pop a)
(array/trim a)
(def a1 @[1])
(array/pop a1)
(array/trim a1)
(array/ensure @[1 1] 6 2)
# array/join
@@ -86,5 +86,10 @@
(assert-error "array/join error 4" (array/join @[] "abc123"))
(assert-error "array/join error 5" (array/join @[] "abc123"))
# Regression 1714
(repeat 10
(assert (deep= (put @[] 100 10) (put (seq [_ :range [0 101]] nil) 100 10)) "regression 1714")
(assert (deep= (put @[] 200 10) (put (seq [_ :range [0 201]] nil) 200 10)) "regression 1714"))
(end-suite)

View File

@@ -48,8 +48,8 @@
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
(def b @"AA")
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
(def b1 @"AA")
(assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
# buffer/push-byte
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
@@ -145,8 +145,8 @@
# Regression #301
# a3d4ecddb
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def b8 (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
@@ -179,5 +179,10 @@
(assert (= (string buf) "xxxxxx") "buffer/format-at negative index")
(assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc"))
# Regression 1714
(repeat 10
(assert (deep= (put @"" 100 10) (put (buffer (string/repeat "\0" 101)) 100 10)) "regression 1714")
(assert (deep= (put @"" 200 10) (put (buffer (string/repeat "\0" 201)) 200 10)) "regression 1714"))
(end-suite)

View File

@@ -84,23 +84,23 @@
(assert (get result :error) "bad sum3 fuzz issue valgrind")
# Issue #1700
(def result
(def result1
(compile
'(defn fuzz-case-1
[start end &]
(if end
(if e start (lazy-range (+ 1 start) end)))
1)))
(assert (get result :error) "fuzz case issue #1700")
(assert (get result1 :error) "fuzz case issue #1700")
# Issue #1702 - fuzz case with upvalues
(def result
(def result2
(compile
'(each item [1 2 3]
# Generate a lot of upvalues (more than 224)
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
(with-dyns [:out out-buf] 1))))
(assert result "bad upvalues fuzz case")
(assert result2 "bad upvalues fuzz case")
# Named argument linting
# Enhancement for #1654
@@ -117,14 +117,14 @@
(defn check-good-compile
[code msg]
(def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (empty? lints)) msg))
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (empty? lints)) msg))
(defn check-lint-compile
[code msg]
(def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (next lints)) msg))
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (next lints)) msg))
(check-good-compile '(fnamed) "named no args")
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
@@ -150,5 +150,10 @@
(check-lint-compile '(g 1 2 :z) "g lint 1")
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
(end-suite)
# Variable shadowing linting
(def outer1 "a")
(check-lint-compile '(def outer1 "b") "shadow global-to-global")
(check-lint-compile '(let [outer1 "b"] outer1) "shadow local-to-global")
(check-lint-compile '(do (def x "b") (def x "c")) "shadow local-to-local")
(end-suite)

View File

@@ -43,9 +43,9 @@
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(def thread-channel :shadow (ev/thread-chan 100))
(def super :shadow (ev/thread-chan 10))
(defn worker :shadow []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)
@@ -84,4 +84,21 @@
(assert-error "cannot schedule non-new fiber"
(ev/go f))
# IO file copying
(os/mkdir "tmp")
(def f-original (file/open "tmp/out.txt" :wb))
(xprin f-original "hello\n")
(file/flush f-original)
(ev/do-thread
# Closes a COPY of the original file, otherwise we get a user-after-close file descriptor
(:close f-original))
(def g-original (file/open "tmp/out2.txt" :wb))
(xprin g-original "world1\n")
(xprin f-original "world2\n")
(:close f-original)
(xprin g-original "abc\n")
(:close g-original)
(assert (deep= @"hello\nworld2\n" (slurp "tmp/out.txt")) "file threading 1")
(assert (deep= @"world1\nabc\n" (slurp "tmp/out2.txt")) "file threading 2")
(end-suite)

View File

@@ -37,7 +37,7 @@
# Printing to functions
# 4e263b8c3
(def out-buf @"")
(def out-buf :shadow @"")
(defn prepend [x]
(with-dyns [:out out-buf]
(prin "> " x)))
@@ -59,8 +59,8 @@
# issue #1055 - 2c927ea76
(let [b @""]
(defn dummy [a b c]
(+ a b c))
(defn dummy [a bb c]
(+ a bb c))
(trace dummy)
(defn errout [arg]
(buffer/push b arg))

View File

@@ -95,11 +95,11 @@
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f1 :shadow [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ tup] (protect (f1 @[0])))
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
(def [f1 f2] :shadow (unmarshal (marshal tup make-image-dict) load-image-dict))
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
@@ -108,10 +108,10 @@
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(defn f1 :shadow [] (++ (a 0)))
(defn f2 :shadow [] (++ (a 0)))
(marshal [f1 f2] make-image-dict))
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
(def [f1 f2] :shadow (unmarshal (f1 @[0]) load-image-dict))
(assert (= 1 (f1)) "marshal-live-closure 1")
(assert (= 2 (f2)) "marshal-live-closure 2"))
@@ -189,11 +189,11 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= t tclone) "table/weak marsh 7")
# table weak keys
(def t (table/weak-keys 1))
(def t :shadow (table/weak-keys 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
@@ -201,23 +201,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= t tclone) "table/weak-keys marsh 5")
# table weak values
(def t (table/weak-values 1))
(def t :shadow (table/weak-values 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
(def t :shadow (table/weak-values 1))
(table/setproto t @{:abc 123})
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
(def tclone (-> t marshal unmarshal))
(def tclone :shadow (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")

View File

@@ -148,11 +148,10 @@
# os/execute with empty environment
# pr #1686
# native MinGW can't find system DLLs without PATH and so fails
(assert (= (if (and (= :mingw (os/which))
(nil? (os/stat "C:\\windows\\system32\\wineboot.exe")))
-1073741515 0)
(os/execute [;run janet "-e" "(+ 1 2 3)"] :pe {}))
# native MinGW can't find system DLLs without PATH, SystemRoot, etc. and so fails
# Also fails for address sanitizer builds on windows.
(def result (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe {}))
(assert (or (= result -1073741515) (= result 0))
"os/execute with minimal env")
# os/execute regressions

View File

@@ -138,13 +138,13 @@
# Parser clone
# 43520ac67
(def p (parser/new))
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p))
(def p0 (parser/new))
(assert (= 7 (parser/consume p0 "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p0))
(parser/consume p2 ") 1 ")
(parser/consume p ") 1 ")
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
(parser/consume p0 ") 1 ")
(assert (deep= (parser/status p0) (parser/status p2)) "parser 2")
(assert (deep= (parser/state p0) (parser/state p2)) "parser 3")
# Parser errors
# 976dfc719
@@ -179,11 +179,11 @@
(parser/consume p1 step1)
(loop [_ :iterate (parser/produce p1)])
(parser/state p1)
(def p2 (parser/clone p1))
(parser/state p2)
(parser/consume p2 step2)
(loop [_ :iterate (parser/produce p2)])
(parser/state p2)
(def p3 (parser/clone p1))
(parser/state p3)
(parser/consume p3 step2)
(loop [_ :iterate (parser/produce p3)])
(parser/state p3)
# parser delimiter errors
(defn test-error [delim fmt]
@@ -202,11 +202,11 @@
(parser/consume p ")")
(assert (= (parser/produce p) ["hello"]))
(def p (parser/new))
(parser/consume p `("hel`)
(parser/insert p `lo`)
(parser/consume p `")`)
(assert (= (parser/produce p) ["hello"]))
(def p4 (parser/new))
(parser/consume p4 `("hel`)
(parser/insert p4 `lo`)
(parser/consume p4 `")`)
(assert (= (parser/produce p4) ["hello"]))
# Hex floats
(assert (= math/pi +0x1.921fb54442d18p+0001))

View File

@@ -84,10 +84,10 @@
# Substitution test with peg
# d7626f8c5
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(defn try-grammar [text]
(assert (= (string/replace-all "dog" "purple panda" text)
(0 (peg/match grammar text))) text))
(0 (peg/match grammar1 text))) text))
(try-grammar "i have a dog called doug the dog. he is good.")
(try-grammar "i have a dog called doug the dog. he is a good boy.")
@@ -336,7 +336,7 @@
# unref
# 96513665d
(def grammar
(def grammar2
(peg/compile
~{:main (* :tagged -1)
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
@@ -344,9 +344,9 @@
:value (* (constant :value) (group (any (+ :tagged :untagged))))
:close-tag (* "</" (backmatch :tag-name) ">")
:untagged (capture (any (if-not "<" 1)))}))
(check-deep grammar "<p><em>foobar</em></p>"
(check-deep grammar2 "<p><em>foobar</em></p>"
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
(check-deep grammar2 "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
# Using a large test grammar
# cf05ff610
@@ -369,7 +369,7 @@
(def sym (symbol text))
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
(def grammar
(def grammar3
~{:ws (set " \v\t\r\f\n\0")
:readermac (set "';~,")
:symchars (+ (range "09" "AZ" "az" "\x80\xFF")
@@ -408,13 +408,13 @@
:dict (* '"@" :struct)
:main (+ :root (error ""))})
(def p (peg/compile grammar))
(def porig (peg/compile grammar3))
# Just make sure is valgrind clean.
(def p (-> p make-image load-image))
(def pprime (-> porig make-image load-image))
(assert (peg/match p "abc") "complex peg grammar 1")
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
(assert (peg/match pprime "abc") "complex peg grammar 1")
(assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
###
### Compiling brainfuck to Janet.
@@ -565,8 +565,8 @@
"peg/replace-all function")
# 9dc7e8ed3
(defn peg-test [name f peg subst text expected]
(assert (= (string (f peg subst text)) expected) name))
(defn peg-test [name f pegg subst text expected]
(assert (= (string (f pegg subst text)) expected) name))
(peg-test "peg/replace has access to captures"
peg/replace
@@ -602,10 +602,10 @@
# Marshal and unmarshal pegs
# 446ab037b
(def p (-> "abcd" peg/compile marshal unmarshal))
(assert (peg/match p "abcd") "peg marshal 1")
(assert (peg/match p "abcdefg") "peg marshal 2")
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
(def p3 (-> "abcd" peg/compile marshal unmarshal))
(assert (peg/match p3 "abcd") "peg marshal 1")
(assert (peg/match p3 "abcdefg") "peg marshal 2")
(assert (not (peg/match p3 "zabcdefg")) "peg marshal 3")
# to/thru bug
# issue #971 - a895219d2
@@ -669,10 +669,10 @@
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
@[]) "peg if not")
(defn test [name peg input expected]
(assert-no-error "compile peg" (peg/compile peg))
(assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal))
(assert (deep= (peg/match peg input) expected) name))
(defn test [name pegg input expected]
(assert-no-error "compile peg" (peg/compile pegg))
(assert-no-error "marshal/unmarshal peg" (-> pegg marshal unmarshal))
(assert (deep= (peg/match pegg input) expected) name))
(test "sub: matches the same input twice"
~(sub "abcd" "abc")
@@ -852,41 +852,49 @@
@[["b" "b" "b"]])
# Debug and ?? tests.
(defn test-stderr [name peg input expected-matches expected-stderr]
(defn test-stderr [name pegg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name pegg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* true]
(test name peg input expected-matches))
(peg/match pegg input))
(assert (deep= (string actual) expected-stderr)))
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
(defn test-stderr-no-color [name pegg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name pegg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* false]
(test name peg input expected-matches))
(peg/match pegg input))
(assert (deep= (string actual) expected-stderr)))
(test-stderr "?? long form"
'(* (debug) "abc")
"abc"
@[]
"?? at [abc] (index 0)\n")
(test-stderr
"?? long form"
'(* (debug) "abc")
"abc"
@[]
"?? at [abc] (index 0)\n")
(test-stderr "?? short form"
'(* (??) "abc")
"abc"
@[]
"?? at [abc] (index 0)\n")
(test-stderr
"?? short form"
'(* (??) "abc")
"abc"
@[]
"?? at [abc] (index 0)\n")
(test-stderr "?? end of text"
'(* "abc" (??))
"abc"
@[]
"?? at [] (index 3)\n")
(test-stderr
"?? end of text"
'(* "abc" (??))
"abc"
@[]
"?? at [] (index 3)\n")
(test-stderr "?? between rules"
'(* "a" (??) "bc")
"abc"
@[]
"?? at [bc] (index 1)\n")
(test-stderr
"?? between rules"
'(* "a" (??) "bc")
"abc"
@[]
"?? at [bc] (index 1)\n")
(test-stderr
"?? stack display, string"

View File

@@ -44,8 +44,8 @@
(def buftemp @"abcd")
(assert (= (string (buffer/format buftemp "---%p---" buftemp))
`abcd---@"abcd"---`) "buffer/format on self 1")
(def buftemp @"abcd")
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
(def buftemp2 @"abcd")
(assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
# 5c364e0
@@ -61,5 +61,68 @@
(check-jdn "a string")
(check-jdn @"a buffer")
# Test multiline pretty specifiers
(let [tup [:keyword "string" @"buffer"]
tab @{true (table/setproto @{:bar tup
:baz 42}
@{:_name "Foo"})}]
(set (tab tup) tab)
(assert (= (string/format "%m" {tup @[tup tab]
'symbol tup})
`
{symbol (:keyword
"string"
@"buffer")
(:keyword
"string"
@"buffer") @[(:keyword
"string"
@"buffer")
@{true @Foo{:bar (:keyword
"string"
@"buffer")
:baz 42}
(:keyword
"string"
@"buffer") <cycle 2>}]}`))
(assert (= (string/format "%p" {(freeze (zipcoll (range 42)
(range -42 0))) tab})
`
{{0 -42
1 -41
2 -40
3 -39
4 -38
5 -37
6 -36
7 -35
8 -34
9 -33
10 -32
11 -31
12 -30
13 -29
14 -28
15 -27
16 -26
17 -25
18 -24
19 -23
20 -22
21 -21
22 -20
23 -19
24 -18
25 -17
26 -16
27 -15
28 -14
29 -13
...} @{true @Foo{:bar (:keyword
"string"
@"buffer")
:baz 42}
(:keyword
"string"
@"buffer") <cycle 1>}}`)))
(end-suite)

View File

@@ -132,11 +132,11 @@
# Cancel test
# 28439d822
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1")
(assert (= 2 (resume f)) "cancel resume 2")
(assert (= :hi (cancel f :hi)) "cancel resume 3")
(assert (= :error (fiber/status f)) "cancel resume 4")
(def fc (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume fc)) "cancel resume 1")
(assert (= 2 (resume fc)) "cancel resume 2")
(assert (= :hi (cancel fc :hi)) "cancel resume 3")
(assert (= :error (fiber/status fc)) "cancel resume 4")
(end-suite)

Binary file not shown.

View File

@@ -87,7 +87,9 @@
<Directory Id="BinDir" Name="bin"/>
<Directory Id="CDir" Name="C"/>
<Directory Id="DocsDir" Name="docs"/>
<Directory Id="LibraryDir" Name="Library"/>
<Directory Id="LibraryDir" Name="Library">
<Directory Id="LibBinDir" Name="bin"/>
</Directory>
</Directory>
</Directory>
<Directory Id="ProgramMenuFolder">
@@ -169,6 +171,7 @@
<Component Id="SetEnvVarsPerMachine" Directory="ApplicationProgramsFolder" Guid="57b1e1ef-89c8-4ce4-9f0f-37618677c5a4" KeyPath="yes">
<Condition>ALLUSERS=1</Condition>
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
<Environment Id="PATH2_PERMACHINE" Name="PATH" Value="[LibBinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
<Environment Id="JANET_BINPATH_PERMACHINE" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="yes"/>
<Environment Id="JANET_MANPATH_PERMACHINE" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="yes"/>
<Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
@@ -178,6 +181,7 @@
<Component Id="SetEnvVarsPerUser" Directory="ApplicationProgramsFolder" Guid="128be307-488b-49aa-971a-d2ae00a1a584" KeyPath="yes">
<Condition>NOT ALLUSERS=1</Condition>
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
<Environment Id="PATH2_PERUSER" Name="PATH" Value="[LibBinDir]" Action="set" Permanent="no" System="no" Part="last"/>
<Environment Id="JANET_BINPATH_PERUSER" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="no"/>
<Environment Id="JANET_MANPATH_PERUSER" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="no"/>
<Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />