Compare commits

...

51 Commits

Author SHA1 Message Date
Calvin Rose 7bae7d9efd Merge changes from bundle-tools branch:
- Update file IO to explicitly use 64bit ftell/fseek
- Add env argument to eval
- Allow naming function literals with keywords.
2024-05-26 12:04:35 -05:00
Calvin Rose ae2c5820a1 Fix janet_strerror when _GNU_SOURCE defined. 2024-05-25 13:24:01 -05:00
Calvin Rose 60e0c8ea92 Ignore gcov 2024-05-25 09:25:27 -05:00
Calvin Rose 7d3acc0ed6 Get rid of "extended locale" support.
While useful on some platforms, behavior seems to be different across
the board, making use difficult.
2024-05-19 18:01:20 -05:00
Calvin Rose 2637b33957 Include locale.h and xlocale.h on some platforms. 2024-05-19 17:40:39 -05:00
Calvin Rose 58ccb66659 Move janet_buffer_dtostr 2024-05-19 17:14:21 -05:00
Calvin Rose 634429cf61 Merge branch 'locales' 2024-05-19 17:05:49 -05:00
Calvin Rose 03166a745a Disallow nan and inf in jdn. 2024-05-19 13:25:25 -05:00
Calvin Rose ace60e1898 Add ev/with-*lock macros. 2024-05-18 17:55:47 -05:00
Calvin Rose 876b7f106f OpenBSD does not work with LC_*_MASK stuff. 2024-05-18 17:22:10 -05:00
Calvin Rose 809b6589a1 Put limits.h back. 2024-05-18 15:31:23 -05:00
Calvin Rose 02f53ca014 Formatting. 2024-05-18 15:21:37 -05:00
Calvin Rose 0b03ddb21b More work on setting locale for extended locale support. 2024-05-18 15:20:22 -05:00
Calvin Rose ea5d4fd3af JANET_BSD not defined on apple. 2024-05-18 14:24:51 -05:00
Calvin Rose e6b73f8cd1 BSD, use xlocale for thread safe functionality 2024-05-18 14:11:05 -05:00
Calvin Rose af232ef729 windows needs a distinct implementation from posix for thread safety.
I must say, the windows solution is a lot simpler.
2024-05-18 14:02:20 -05:00
Calvin Rose 2e2f8abfc0 Work on add locales.
Need to be careful not to mess with %j formatter, or
in some other places.
2024-05-18 13:23:33 -05:00
Calvin Rose 91a583db27
Merge pull request #1448 from znley/master
Add LoongArch64 support
2024-05-18 06:33:07 -05:00
znley c1647a74c5 Add LoongArch64 support 2024-05-18 07:18:59 +00:00
Calvin Rose 721f280966 Add `with-env`. 2024-05-16 21:52:49 -05:00
Calvin Rose e914eaf055 Update CHANGELOG.md 2024-05-16 21:37:08 -05:00
Calvin Rose fe54013679 Update naming *module-make-env* for #1447 2024-05-16 19:11:25 -05:00
Calvin Rose fdaf2e1594 Add *module/make-env* 2024-05-16 19:10:30 -05:00
Calvin Rose 9946f3bdf4 Add buffer/format-at
Move changes over from bundle-tools branch and add testing.
2024-05-15 20:16:42 -05:00
Calvin Rose c747e8d16c Address some compiler linter messages on openbsd 2024-05-15 18:20:20 -05:00
Calvin Rose 3e402d397e Use older openbsd build for CI. 2024-05-15 18:16:19 -05:00
Calvin Rose 0350834cd3 By default, require and import extend current env. 2024-05-15 07:40:21 -05:00
Calvin Rose 60e22d9703
Merge pull request #1445 from wishdev/defbind-alias
Add ffi/defbind-alias
2024-05-11 14:25:03 -05:00
John W Higgins ee7362e847 Add ffi/defbind-alias 2024-05-09 21:31:22 -07:00
Calvin Rose 369f96b80e Update README to prefer Zulip. 2024-05-03 07:51:35 -05:00
Calvin Rose 7c5ed04ab1 A few minor improvements.
- Add long-form CLI options
- Update changelog.
- Use snprintf instead of sprintf for linters.
2024-05-02 09:13:29 -05:00
Calvin Rose 4779a445e0 Fix BSD/Macos issue for #1431 2024-04-26 19:32:47 -05:00
Calvin Rose f0f1b7ce9e Address #1431 - level-trigger mode for net/accept-loop
In the edge-trigger mode before this change, if a socket
receives 2 connections before one can be handled, then only a single
connection is handle and 1 connection will never be handled in some
cases. Reverting to level-trigger mode makes this impossible.
2024-04-26 19:28:20 -05:00
Calvin Rose 7c9157a0ed Remove unneeded `string` functions. 2024-04-26 18:11:10 -05:00
Calvin Rose 522a6cb435
Merge pull request #1440 from ahgamut/cosmo-build
Build janet with Cosmopolitan Libc
2024-04-21 08:06:51 -05:00
Gautham d0d551d739 remove superconfigure recipe 2024-04-21 01:16:54 -05:00
Gautham 71a123fef7 apelink 2024-04-21 01:14:58 -05:00
Gautham 3f40c8d7fb fix typo 2024-04-21 01:12:59 -05:00
Gautham 983c2e5499 simplify build to use only cosmocc 2024-04-21 01:10:06 -05:00
Gautham eebb4c3ade remove logging 2024-04-20 22:35:04 -05:00
Gautham 50425eac72 typo 2024-04-20 22:23:29 -05:00
Gautham 382ff77bbe typo 2024-04-20 22:16:23 -05:00
Gautham bf680fb5d3 simplify janet APE build 2024-04-20 22:09:10 -05:00
Gautham 4ed7db4f91 simplify naming 2024-04-19 10:56:46 -05:00
Calvin Rose bf19920d65 Improve casting. 2024-04-18 03:29:45 -05:00
Gautham 174b5f6686 missing folder 2024-04-16 22:24:31 -05:00
Gautham 4173645b81 missing folder 2024-04-16 22:23:12 -05:00
Gautham af511f1f55 patch folder location 2024-04-16 22:15:54 -05:00
Gautham 83c6080380 yml config for building with Cosmopolitan Libc 2024-04-16 22:02:31 -05:00
Calvin Rose 2f0c789ea1 More work to address #1391
Properly set read_fiber and write_fiber to NULL when unused.
This was causing extra listening in the poll implemenation leading to
busy loops where a read was accidentally listening for POLLOUT.
2024-04-15 21:32:17 -05:00
Calvin Rose a9b8f8e8a9 Address #1391 - set fd to negative value if not used.
See https://groups.google.com/g/comp.unix.programmer/c/bNNadBIEpTo/m/G5gs1mqNhbIJ?pli=1 for a conversation and workaround.
2024-04-15 18:12:42 -05:00
32 changed files with 568 additions and 187 deletions

View File

@ -1,4 +1,4 @@
image: openbsd/latest
image: openbsd/7.4
sources:
- https://git.sr.ht/~bakpakin/janet
packages:

38
.github/cosmo/build vendored Normal file
View File

@ -0,0 +1,38 @@
#!/bin/sh
set -eux
COSMO_DIR="/sc/cosmocc"
# build x86_64
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/x86_64
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/x86_64/janet
make clean
# build aarch64
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/aarch64
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/aarch64/janet
make clean
# fat binary
apefat () {
OUTPUT="$1"
OLDNAME_X86_64="$(basename -- "$2")"
OLDNAME_AARCH64="$(basename -- "$3")"
TARG_FOLD="$(dirname "$OUTPUT")"
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
-M "$COSMO_DIR/bin/ape-m1.c" \
-o "$OUTPUT" \
"$2" \
"$3"
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
}
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet

21
.github/cosmo/setup vendored Normal file
View File

@ -0,0 +1,21 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
qemu 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
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"

View File

@ -60,3 +60,30 @@ jobs:
./dist/*.zip
./*.zip
./*.msi
release-cosmo:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries 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
- name: push binary to github
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
/sc/cosmocc/janet.com

View File

@ -73,7 +73,7 @@ jobs:
- name: Compile the project
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
- name: Test the project
run: make test UNAME=MINGW RUN=wine
run: make test UNAME=MINGW RUN=wine VERBOSE=1
test-arm-linux:
name: Build and test ARM32 cross compilation
@ -88,4 +88,4 @@ jobs:
- name: Compile the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
- name: Test the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1

7
.gitignore vendored
View File

@ -48,6 +48,7 @@ janet.wasm
# Generated files
*.gen.h
*.gen.c
*.tmp
# Generate test files
*.out
@ -126,6 +127,9 @@ vgcore.*
*.idb
*.pdb
# GGov
*.gcov
# Kernel Module Compile Results
*.mod*
*.cmd
@ -134,6 +138,9 @@ Module.symvers
Mkfile.old
dkms.conf
# Coverage files
*.cov
# End of https://www.gitignore.io/api/c
# Created by https://www.gitignore.io/api/cmake

View File

@ -1,6 +1,17 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Add extra optional `env` argument to `eval` and `eval-string`.
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
accidentally adding new bindings.
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
- Add `with-env`
- Add *module-make-env* dynamic binding
- Add buffer/format-at
- Add long form command line options for readable CLI usage
- Fix bug with `net/accept-loop` that would sometimes miss connections.
## 1.34.0 - 2024-03-22
- Add a new (split) PEG special by @ianthehenry
- Add buffer/push-* sized int and float by @pnelson

View File

@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## Discussion
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
## FAQ

View File

@ -55,6 +55,7 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
# Struct reading and writing
@ -119,6 +120,7 @@
(tracev (return-struct 42))
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
(tracev (struct-big 11 99.5))
(tracev (int-fn-aliased 10 20))
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))

View File

@ -1,5 +1,5 @@
# The core janet library
# Copyright 2023 © Calvin Rose
# Copyright 2024 © Calvin Rose
###
###
@ -244,7 +244,7 @@
(let [[[err fib]] catch
f (gensym)
r (gensym)]
~(let [,f (,fiber/new (fn [] ,body) :ie)
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error)
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
@ -256,7 +256,7 @@
error, and the second is the return value or error.`
[& body]
(let [f (gensym) r (gensym)]
~(let [,f (,fiber/new (fn [] ,;body) :ie)
~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
,r (,resume ,f)]
[(,not= :error (,fiber/status ,f)) ,r])))
@ -313,7 +313,7 @@
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ti))
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
(def ,r (,resume ,f))
,form
(if (= (,fiber/status ,f) :dead)
@ -326,7 +326,7 @@
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ti))
(def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
(def ,r (,resume ,f))
(if (= (,fiber/status ,f) :dead)
,r
@ -338,7 +338,7 @@
[tag & body]
(with-syms [res target payload fib]
~(do
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
(def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0))
(def ,res (,resume ,fib))
(def [,target ,payload] ,res)
(if (,= ,tag ,target)
@ -629,17 +629,17 @@
``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]
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
~(,fiber/new (fn :generate [] (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)`."
[& body]
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
(tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
(defmacro fiber-fn
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
[flags & body]
(tuple fiber/new (tuple 'fn '[] ;body) flags))
(tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
(defn sum
"Returns the sum of xs. If xs is empty, returns 0."
@ -702,11 +702,11 @@
(case (length functions)
0 nil
1 (in functions 0)
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
(let [[f g h i] functions]
(comp (fn [x] (f (g (h (i x)))))
(comp (fn :comp [x] (f (g (h (i x)))))
;(tuple/slice functions 4 -1)))))
(defn identity
@ -717,7 +717,7 @@
(defn complement
"Returns a function that is the complement to the argument."
[f]
(fn [x] (not (f x))))
(fn :complement [x] (not (f x))))
(defmacro- do-extreme
[order args]
@ -880,7 +880,7 @@
``Sorts `ind` in-place by calling a function `f` on each element and
comparing the result with `<`.``
[f ind]
(sort ind (fn [x y] (< (f x) (f y)))))
(sort ind (fn :sort-by-comp [x y] (< (f x) (f y)))))
(defn sorted
``Returns a new sorted array without modifying the old one.
@ -893,7 +893,7 @@
``Returns a new sorted array that compares elements by invoking
a function `f` on each element and comparing the result with `<`.``
[f ind]
(sorted ind (fn [x y] (< (f x) (f y)))))
(sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y)))))
(defn reduce
``Reduce, also know as fold-left in many languages, transforms
@ -1192,7 +1192,7 @@
``Returns the juxtaposition of functions. In other words,
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
[& funs]
(fn [& args]
(fn :juxt* [& args]
(def ret @[])
(each f funs
(array/push ret (f ;args)))
@ -1205,7 +1205,7 @@
(def $args (gensym))
(each f funs
(array/push parts (tuple apply f $args)))
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
@ -1421,7 +1421,12 @@
(def dyn-forms
(seq [i :range [0 (length bindings) 2]]
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p)))
(defmacro with-env
`Run a block of code with a given environment table`
[env & body]
~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
(defmacro with-vars
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
@ -1436,7 +1441,7 @@
(with-syms [ret f s]
~(do
,;saveold
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
(def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
(def ,ret (,resume ,f))
,;restoreold
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
@ -1445,7 +1450,7 @@
"Partial function application."
[f & more]
(if (zero? (length more)) f
(fn [& r] (f ;more ;r))))
(fn :partial [& r] (f ;more ;r))))
(defn every?
``Evaluates to the last element of `ind` if all preceding elements are truthy,
@ -1802,7 +1807,6 @@
(printf (dyn *pretty-format* "%q") x)
(flush))
(defn file/lines
"Return an iterator over the lines of a file."
[file]
@ -2325,7 +2329,7 @@
x)))
x))
(def expanded (macex arg on-binding))
(def name-splice (if name [name] []))
(def name-splice (if name [name] [:short-fn]))
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
@ -2415,29 +2419,9 @@
col
": parse error: "
(:error p)
(if ec "\e[0m" ""))
(if ec "\e[0m"))
(eflush))
(defn- print-line-col
``Print the source code at a line, column in a source file. If unable to open
the file, prints nothing.``
[where line col]
(if-not line (break))
(unless (string? where) (break))
(when-with [f (file/open where :r)]
(def source-code (file/read f :all))
(var index 0)
(repeat (dec line)
(if-not index (break))
(set index (string/find "\n" source-code index))
(if index (++ index)))
(when index
(def line-end (string/find "\n" source-code index))
(eprint " " (string/slice source-code index line-end))
(when col
(+= index col)
(eprint (string/repeat " " (inc col)) "^")))))
(defn warn-compile
"Default handler for a compile warning."
[msg level where &opt line col]
@ -2450,10 +2434,7 @@
":"
col
": compile warning (" level "): ")
(eprint msg)
(when ec
(print-line-col where line col)
(eprin "\e[0m"))
(eprint msg (if ec "\e[0m"))
(eflush))
(defn bad-compile
@ -2470,10 +2451,7 @@
": compile error: ")
(if macrof
(debug/stacktrace macrof msg "")
(eprint msg))
(when ec
(print-line-col where line col)
(eprin "\e[0m"))
(eprint msg (if ec "\e[0m")))
(eflush))
(defn curenv
@ -2542,7 +2520,7 @@
:read read
:expander expand} opts)
(default env (or (fiber/getenv (fiber/current)) @{}))
(default chunks (fn [buf p] (getline "" buf env)))
(default chunks (fn chunks [buf p] (getline "" buf env)))
(default onstatus debug/stacktrace)
(default on-compile-error bad-compile)
(default on-compile-warning warn-compile)
@ -2677,8 +2655,8 @@
(defn eval
``Evaluates a form in the current environment. If more control over the
environment is needed, use `run-context`.``
[form]
(def res (compile form nil :eval))
[form &opt env]
(def res (compile form env :eval))
(if (= (type res) :function)
(res)
(error (get res :error))))
@ -2717,9 +2695,9 @@
(defn eval-string
``Evaluates a string in the current environment. If more control over the
environment is needed, use `run-context`.``
[str]
[str &opt env]
(var ret nil)
(each x (parse-all str) (set ret (eval x)))
(each x (parse-all str) (set ret (eval x env)))
ret)
(def load-image-dict
@ -2767,10 +2745,11 @@
(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))
(defdyn *module/cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module/paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
(def module/cache
"A table, mapping loaded module identifiers to their environments."
@ -2800,7 +2779,7 @@
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
```
[ext loader]
(def mp (dyn *module/paths* module/paths))
(def mp (dyn *module-paths* module/paths))
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
@ -2818,7 +2797,7 @@
(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])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
# Version of fexists that works even with a reduced OS
(defn- fexists
@ -2848,7 +2827,7 @@
```
[path]
(var ret nil)
(def mp (dyn *module/paths* module/paths))
(def mp (dyn *module-paths* module/paths))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
@ -2861,7 +2840,7 @@
(set ret [fullpath mod-kind])
(break))))))
(if ret ret
(let [expander (fn [[t _ chk]]
(let [expander (fn :expander [[t _ chk]]
(when (string? t)
(when (mod-filter chk path)
(module/expand-path path t))))
@ -2928,7 +2907,7 @@
set to a truthy value."
[env &opt level is-repl]
(default level 1)
(fn [f x]
(fn :debugger [f x]
(def fs (fiber/status f))
(if (= :dead fs)
(when is-repl
@ -2958,7 +2937,7 @@
:core/stream path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(default env ((dyn *module-make-env* make-env)))
(def spath (string path))
(put env :source (or source (if-not path-is-file spath path)))
(var exit-error nil)
@ -3018,14 +2997,14 @@
``A table of loading method names to loading functions.
This table lets `require` and `import` load many different kinds
of files as modules.``
@{:native (fn native-loader [path &] (native path (make-env)))
@{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env))))
:source (fn source-loader [path args]
(def ml (dyn *module/loading* module/loading))
(def ml (dyn *module-loading* module/loading))
(put ml path true)
(defer (put ml path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(def mc (dyn *module/cache* module/cache))
(def mc (dyn *module-cache* module/cache))
(when-let [m (in mc path)]
(if (function? m)
(set (mc path) (m path ;args))
@ -3036,9 +3015,9 @@
[path args kargs]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(def mc (dyn *module/cache* module/cache))
(def ml (dyn *module/loading* module/loading))
(def mls (dyn *module/loaders* module/loaders))
(def mc (dyn *module-cache* module/cache))
(def ml (dyn *module-loading* module/loading))
(def mls (dyn *module-loaders* module/loaders))
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (ml fullpath)
@ -3136,6 +3115,7 @@
[&opt env local]
(env-walk keyword? env local))
(defdyn *doc-width*
"Width in columns to print documentation printed with `doc-format`.")
@ -3444,9 +3424,9 @@
(defn- print-special-form-entry
[x]
(print "\n\n"
(string " special form\n\n")
(string " (" x " ...)\n\n")
(string " See https://janet-lang.org/docs/specials.html\n\n")))
" special form\n\n"
" (" x " ...)\n\n"
" See https://janet-lang.org/docs/specials.html\n\n"))
(defn doc*
"Get the documentation for a symbol in a given environment. Function form of `doc`."
@ -3698,7 +3678,7 @@
[&opt chunks onsignal env parser read]
(default env (make-env))
(default chunks
(fn [buf p]
(fn :chunks [buf p]
(getline
(string
"repl:"
@ -3729,23 +3709,47 @@
Returns a fiber that is scheduled to run the function.
```
[f & args]
(ev/go (fn _call [&] (f ;args))))
(ev/go (fn :call [&] (f ;args))))
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
[& body]
~(,ev/go (fn _spawn [&] ,;body)))
~(,ev/go (fn :spawn [&] ,;body)))
(defmacro ev/do-thread
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
evaluates to nil.``
[& body]
~(,ev/thread (fn _do-thread [&] ,;body)))
~(,ev/thread (fn :do-thread [&] ,;body)))
(defn- acquire-release
[acq rel lock body]
(def l (gensym))
~(do
(def ,l ,lock)
(,acq ,l)
(defer (,rel ,l)
,;body)))
(defmacro ev/with-lock
``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-lock ev/release-lock lock body))
(defmacro ev/with-rlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
(defmacro ev/with-wlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
(defmacro ev/spawn-thread
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
[& body]
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
(defmacro ev/with-deadline
``
@ -3794,7 +3798,7 @@
(def ,res @[])
,;(seq [[i body] :pairs bodies]
~(do
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
(,put ,fset ,ftemp ,ftemp)))
(,wait-for-fibers ,chan ,fset)
,res))))
@ -3853,9 +3857,11 @@
:lazy lazy
:map-symbols map-symbols}))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
(defmacro ffi/defbind-alias
"Generate bindings for native functions in a convenient manner.
Similar to defbind but allows for the janet function name to be
different than the FFI function."
[name alias ret-type & body]
(def real-ret-type (eval ret-type))
(def meta (slice body 0 -2))
(def arg-pairs (partition 2 (last body)))
@ -3872,10 +3878,15 @@
(defn make-ptr []
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
(if lazy
~(defn ,name ,;meta [,;formal-args]
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,name ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
###
###
@ -3952,7 +3963,6 @@
(merge-into module/cache old-modcache)
nil)
###
###
### CLI Tool Main
@ -3989,6 +3999,28 @@
(compwhen (not (dyn 'os/isatty))
(defmacro os/isatty [&] true))
(def- long-to-short
"map long options to short options"
{"-help" "h"
"-version" "v"
"-stdin" "s"
"-eval" "e"
"-expression" "E"
"-debug" "d"
"-repl" "r"
"-noprofile" "R"
"-persistent" "p"
"-quiet" "q"
"-flycheck" "k"
"-syspath" "m"
"-compile" "c"
"-image" "i"
"-nocolor" "n"
"-color" "N"
"-library" "l"
"-lint-warn" "w"
"-lint-error" "x"})
(defn cli-main
`Entrance for the Janet CLI tool. Call this function with the command line
arguments as an array or tuple of strings to invoke the CLI interface.`
@ -4027,25 +4059,25 @@
(print
```
Options are:
-h : Show this help
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-E code arguments... : Evaluate an expression as a short-fn with arguments
-d : Set the debug flag in the REPL
-r : Enter the REPL after running all scripts
-R : Disables loading profile.janet when JANET_PROFILE is present
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide logo (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-i : Load the script argument as an image file instead of source code
-n : Disable ANSI color output in the REPL
-N : Enable ANSI color output in the REPL
-l lib : Use a module before processing more arguments
-w level : Set the lint warning level - default is "normal"
-x level : Set the lint error level - default is "none"
--help (-h) : Show this help
--version (-v) : Print the version string
--stdin (-s) : Use raw stdin instead of getline like functionality
--eval (-e) code : Execute a string of janet
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
--debug (-d) : Set the debug flag in the REPL
--repl (-r) : Enter the REPL after running all scripts
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
--quiet (-q) : Hide logo (quiet)
--flycheck (-k) : Compile scripts but do not execute (flycheck)
--syspath (-m) syspath : Set system path for loading global modules
--compile (-c) source output : Compile janet source code into an image
--image (-i) : Load the script argument as an image file instead of source code
--nocolor (-n) : Disable ANSI color output in the REPL
--color (-N) : Enable ANSI color output in the REPL
--library (-l) lib : Use a module before processing more arguments
--lint-warn (-w) level : Set the lint warning level - default is "normal"
--lint-error (-x) level : Set the lint error level - default is "none"
-- : Stop handling options
```)
(os/exit 0)
@ -4090,8 +4122,8 @@
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
(def h (in handlers n))
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
(def h (in handlers (get long-to-short n n)))
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
# Process arguments
(var i 0)

View File

@ -655,6 +655,27 @@ JANET_CORE_FN(cfun_buffer_format,
return argv[0];
}
JANET_CORE_FN(cfun_buffer_format_at,
"(buffer/format-at buffer at format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t at = janet_getinteger(argv, 1);
if (at < 0) {
at += buffer->count + 1;
}
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
int32_t oldcount = buffer->count;
buffer->count = at;
const char *strfrmt = (const char *) janet_getstring(argv, 2);
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
if (buffer->count < oldcount) {
buffer->count = oldcount;
}
return argv[0];
}
void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
@ -681,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
JANET_CORE_REG("buffer/format", cfun_buffer_format),
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, buffer_cfuns);

View File

@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
int32_t slotchunks = (def->slotcount + 31) >> 5;
/* numchunks is min of slotchunks and scope->ua.count */
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
def->name = janet_cstring("thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {

View File

@ -69,7 +69,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,

View File

@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
janet_eprintf(" (tailcall)");
janet_eprintf(" (tail call)");
if (frame->func && frame->pc) {
int32_t off = (int32_t)(frame->pc - def->bytecode);
if (def->sourcemap) {
@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
janet_eprintf("\n");
/* Print fiber points optionally. Clutters traces but provides info
if (i <= 0 && fi > 0) {
janet_eprintf(" in parent fiber\n");
}
*/
}
}

View File

@ -279,8 +279,16 @@ void janet_async_in_flight(JanetFiber *fiber) {
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
JanetFiber *fiber = janet_vm.root_fiber;
janet_assert(!fiber->ev_callback, "double async on fiber");
if (mode & JANET_ASYNC_LISTEN_READ) stream->read_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_WRITE) stream->write_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_READ) {
stream->read_fiber = fiber;
} else {
stream->read_fiber = NULL;
}
if (mode & JANET_ASYNC_LISTEN_WRITE) {
stream->write_fiber = fiber;
} else {
stream->write_fiber = NULL;
}
fiber->ev_callback = callback;
fiber->ev_stream = stream;
janet_ev_inc_refcount();
@ -462,6 +470,12 @@ static Janet janet_stream_next(void *p, Janet key) {
return janet_nextmethod(stream->methods, key);
}
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
JanetStream *stream = p;
/* Let user print the file descriptor for debugging */
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
}
const JanetAbstractType janet_stream_type = {
"core/stream",
janet_stream_gc,
@ -470,7 +484,7 @@ const JanetAbstractType janet_stream_type = {
NULL,
janet_stream_marshal,
janet_stream_unmarshal,
NULL,
janet_stream_tostring,
NULL,
NULL,
janet_stream_next,
@ -1516,6 +1530,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
}
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
#elif defined(JANET_EV_EPOLL)
static JanetTimestamp ts_now(void) {
@ -1527,15 +1549,15 @@ static JanetTimestamp ts_now(void) {
}
/* Wait for the next event */
static void janet_register_stream(JanetStream *stream) {
static void janet_register_stream_impl(JanetStream *stream, int mod, int edge_trigger) {
struct epoll_event ev;
ev.events = EPOLLET;
ev.events = edge_trigger ? EPOLLET : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) ev.events |= EPOLLIN;
if (stream->flags & JANET_STREAM_WRITABLE) ev.events |= EPOLLOUT;
ev.data.ptr = stream;
int status;
do {
status = epoll_ctl(janet_vm.epoll, EPOLL_CTL_ADD, stream->handle, &ev);
status = epoll_ctl(janet_vm.epoll, mod ? EPOLL_CTL_MOD : EPOLL_CTL_ADD, stream->handle, &ev);
} while (status == -1 && errno == EINTR);
if (status == -1) {
if (errno == EPERM) {
@ -1549,6 +1571,18 @@ static void janet_register_stream(JanetStream *stream) {
}
}
static void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 0, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 0);
}
#define JANET_EPOLL_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
struct itimerspec its;
@ -1678,14 +1712,15 @@ static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
}
void janet_register_stream(JanetStream *stream) {
void janet_register_stream_impl(JanetStream *stream, int edge_trigger) {
struct kevent kevs[2];
int length = 0;
int clear = edge_trigger ? EV_CLEAR : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
int status;
do {
@ -1696,6 +1731,18 @@ void janet_register_stream(JanetStream *stream) {
}
}
void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 0);
}
#define JANET_KQUEUE_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
@ -1818,15 +1865,30 @@ void janet_register_stream(JanetStream *stream) {
janet_vm.stream_count = new_count;
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* set event flags */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
JanetStream *stream = janet_vm.streams[i];
janet_vm.fds[i + 1].events = 0;
janet_vm.fds[i + 1].revents = 0;
if (stream->read_fiber && stream->read_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLIN;
if (stream->write_fiber && stream->write_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLOUT;
struct pollfd *pfd = janet_vm.fds + i + 1;
pfd->events = 0;
pfd->revents = 0;
JanetFiber *rf = stream->read_fiber;
JanetFiber *wf = stream->write_fiber;
if (rf && rf->ev_callback) pfd->events |= POLLIN;
if (wf && wf->ev_callback) pfd->events |= POLLOUT;
/* Hack to ignore a file descriptor - make file descriptor negative if we want to ignore */
if (!pfd->events) {
pfd->fd = -pfd->fd;
}
}
/* Poll for events */
@ -1843,6 +1905,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JANET_EXIT("failed to poll events");
}
/* Undo negative hack */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
struct pollfd *pfd = janet_vm.fds + i + 1;
if (pfd->fd < 0) {
pfd->fd = -pfd->fd;
}
}
/* Check selfpipe */
if (janet_vm.fds[0].revents & POLLIN) {
janet_vm.fds[0].revents = 0;
@ -2025,7 +2095,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
if (err) {
janet_free(init);
janet_panicf("%s", strerror(err));
janet_panicf("%s", janet_strerror(err));
}
#endif
@ -2134,7 +2204,7 @@ Janet janet_ev_lasterr(void) {
}
#else
Janet janet_ev_lasterr(void) {
return janet_cstringv(strerror(errno));
return janet_cstringv(janet_strerror(errno));
}
#endif

View File

@ -76,4 +76,6 @@
#define __BSD_VISIBLE 1
#endif
#define _FILE_OFFSET_BITS 64
#endif

View File

@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRId64, *((int64_t *)p));
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRIu64, *((uint64_t *)p));
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
janet_buffer_push_cstring(buffer, str);
}

View File

@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
#ifdef JANET_WINDOWS
#define ftell _ftelli64
#define fseek _fseeki64
#endif
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
@ -126,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
// XXX use mkostemp when we can to avoid CLOEXEC race.
FILE *tmp = tmpfile();
if (!tmp)
janet_panicf("unable to create temporary file - %s", strerror(errno));
janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
}
@ -168,7 +173,7 @@ JANET_CORE_FN(cfun_io_fopen,
}
}
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long int offset = 0;
int64_t offset = 0;
int whence = SEEK_CUR;
if (argc >= 2) {
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek,
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
}
if (argc == 3) {
offset = (long) janet_getinteger64(argv, 2);
offset = (int64_t) janet_getinteger64(argv, 2);
}
}
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long pos = ftell(iof->file);
int64_t pos = ftell(iof->file);
if (pos == -1) janet_panic("error getting position in file");
return janet_wrap_number((double)pos);
}

View File

@ -349,6 +349,26 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
return janet_wrap_number(janet_lcm(x, y));
}
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
"Returns a tuple of (mantissa, exponent) from number.") {
janet_fixarity(argc, 1);
double x = janet_getnumber(argv, 0);
int exp;
x = frexp(x, &exp);
Janet *result = janet_tuple_begin(2);
result[0] = janet_wrap_number(x);
result[1] = janet_wrap_number((double) exp);
return janet_wrap_tuple(janet_tuple_end(result));
}
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
"Creates a new number from a mantissa and an exponent.") {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
int32_t y = janet_getinteger(argv, 1);
return janet_wrap_number(ldexp(x, y));
}
/* Module entry point */
void janet_lib_math(JanetTable *env) {
JanetRegExt math_cfuns[] = {
@ -395,6 +415,8 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/next", janet_nextafter),
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, math_cfuns);

View File

@ -152,7 +152,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
janet_cancel(fiber, janet_cstringv(strerror(res)));
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
stream->flags |= JANET_STREAM_TOCLOSE;
}
} else {
@ -319,6 +319,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(state, 0, sizeof(NetStateAccept));
state->function = fun;
if (fun) janet_stream_level_triggered(stream);
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
@ -1034,7 +1035,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
if (r == -1) {
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
}
return janet_wrap_nil();

View File

@ -38,6 +38,7 @@
#include <string.h>
#include <sys/stat.h>
#include <signal.h>
#include <locale.h>
#ifdef JANET_BSD
#include <sys/sysctl.h>
@ -761,7 +762,7 @@ JANET_CORE_FN(os_proc_kill,
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
#endif
/* After killing process we wait on it. */
@ -1274,7 +1275,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
status = execv(cargv[0], cargv);
}
} while (status == -1 && errno == EINTR);
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
#endif
}
@ -1331,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
os_execute_cleanup(envp, child_argv);
if (status) {
/* correct for macos bug where errno is not set */
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
}
#endif
@ -1432,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
result = fork();
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
if (result) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
@ -1597,13 +1598,13 @@ JANET_CORE_FN(os_clock,
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
return janet_wrap_number(tv.tv_sec);
return janet_wrap_number((double)(tv.tv_sec));
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_integer(tv.tv_sec),
janet_wrap_integer(tv.tv_nsec)
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
janet_wrap_number((double)tv.tv_nsec)
};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
} else {
@ -1644,7 +1645,7 @@ JANET_CORE_FN(os_isatty,
return janet_wrap_boolean(_isatty(fd));
#else
int fd = fileno(f);
if (fd == -1) janet_panic(strerror(errno));
if (fd == -1) janet_panic(janet_strerror(errno));
return janet_wrap_boolean(isatty(fd));
#endif
}
@ -1879,7 +1880,7 @@ JANET_CORE_FN(os_mktime,
}
if (t == (time_t) -1) {
janet_panicf("%s", strerror(errno));
janet_panicf("%s", janet_strerror(errno));
}
return janet_wrap_number((double)t);
@ -1891,6 +1892,43 @@ JANET_CORE_FN(os_mktime,
#define j_symlink symlink
#endif
JANET_CORE_FN(os_setlocale,
"(os/setlocale &opt locale category)",
"Set the system locale, which affects how dates and numbers are formatted. "
"Passing nil to locale will return the current locale. Category can be one of:\n\n"
" * :all (default)\n"
" * :collate\n"
" * :ctype\n"
" * :monetary\n"
" * :numeric\n"
" * :time\n\n"
"Returns the new locale if set successfully, otherwise nil. Note that this will affect "
"other functions such as `os/strftime` and even `printf`.") {
janet_arity(argc, 0, 2);
const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
int category_int = LC_ALL;
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
if (janet_keyeq(argv[1], "all")) {
category_int = LC_ALL;
} else if (janet_keyeq(argv[1], "collate")) {
category_int = LC_COLLATE;
} else if (janet_keyeq(argv[1], "ctype")) {
category_int = LC_CTYPE;
} else if (janet_keyeq(argv[1], "monetary")) {
category_int = LC_MONETARY;
} else if (janet_keyeq(argv[1], "numeric")) {
category_int = LC_NUMERIC;
} else if (janet_keyeq(argv[1], "time")) {
category_int = LC_TIME;
} else {
janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
}
}
const char *old = setlocale(category_int, locale_name);
if (old == NULL) return janet_wrap_nil();
return janet_cstringv(old);
}
JANET_CORE_FN(os_link,
"(os/link oldpath newpath &opt symlink)",
"Create a link at newpath that points to oldpath and returns nil. "
@ -1908,7 +1946,7 @@ JANET_CORE_FN(os_link,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@ -1927,7 +1965,7 @@ JANET_CORE_FN(os_symlink,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = j_symlink(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@ -1949,7 +1987,7 @@ JANET_CORE_FN(os_mkdir,
#endif
if (res == 0) return janet_wrap_true();
if (errno == EEXIST) return janet_wrap_false();
janet_panicf("%s: %s", strerror(errno), path);
janet_panicf("%s: %s", janet_strerror(errno), path);
}
JANET_CORE_FN(os_rmdir,
@ -1963,7 +2001,7 @@ JANET_CORE_FN(os_rmdir,
#else
int res = rmdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@ -1978,7 +2016,7 @@ JANET_CORE_FN(os_cd,
#else
int res = chdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@ -2002,7 +2040,7 @@ JANET_CORE_FN(os_touch,
bufp = NULL;
}
int res = utime(path, bufp);
if (-1 == res) janet_panic(strerror(errno));
if (-1 == res) janet_panic(janet_strerror(errno));
return janet_wrap_nil();
}
@ -2012,7 +2050,7 @@ JANET_CORE_FN(os_remove,
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
int status = remove(path);
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@ -2031,7 +2069,7 @@ JANET_CORE_FN(os_readlink,
const char *path = janet_getcstring(argv, 0);
ssize_t len = readlink(path, buffer, sizeof buffer);
if (len < 0 || (size_t)len >= sizeof buffer)
janet_panicf("%s: %s", strerror(errno), path);
janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_stringv((const uint8_t *)buffer, len);
#endif
}
@ -2326,7 +2364,7 @@ JANET_CORE_FN(os_chmod,
#else
int res = chmod(path, os_getmode(argv, 1));
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@ -2362,7 +2400,7 @@ JANET_CORE_FN(os_dir,
janet_panicf("path too long: %s", dir);
sprintf(pattern, "%s/*", dir);
intptr_t res = _findfirst(pattern, &afile);
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
do {
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
janet_array_push(paths, janet_cstringv(afile.name));
@ -2373,8 +2411,18 @@ JANET_CORE_FN(os_dir,
/* Read directory items with opendir / readdir / closedir */
struct dirent *dp;
DIR *dfd = opendir(dir);
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
while ((dp = readdir(dfd)) != NULL) {
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
for (;;) {
errno = 0;
dp = readdir(dfd);
if (dp == NULL) {
if (errno) {
int olderr = errno;
closedir(dfd);
janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
}
break;
}
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
continue;
}
@ -2394,7 +2442,7 @@ JANET_CORE_FN(os_rename,
const char *dest = janet_getcstring(argv, 1);
int status = rename(src, dest);
if (status) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
return janet_wrap_nil();
}
@ -2414,7 +2462,7 @@ JANET_CORE_FN(os_realpath,
#else
char *dest = realpath(src, NULL);
#endif
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
Janet ret = janet_cstringv(dest);
janet_free(dest);
return ret;
@ -2688,6 +2736,7 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/strftime", os_strftime),
JANET_CORE_REG("os/sleep", os_sleep),
JANET_CORE_REG("os/isatty", os_isatty),
JANET_CORE_REG("os/setlocale", os_setlocale),
/* env functions */
JANET_CORE_REG("os/environ", os_environ),

View File

@ -379,8 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
double num = janet_unwrap_number(x);
if (isnan(num)) return 1;
if (isinf(num)) return 1;
janet_buffer_dtostr(S->buffer, num);
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
@ -830,7 +832,7 @@ static const char *scanformat(
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
strcpy(form, mapping);
memcpy(form, mapping, len);
form += len;
} else {
*(form++) = *(p2++);

View File

@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
int structarg = 0;
int allow_extra = 0;
int selfref = 0;
int hasname = 0;
int seenamp = 0;
int seenopt = 0;
int namedargs = 0;
@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
head = argv[0];
if (janet_checktype(head, JANET_SYMBOL)) {
selfref = 1;
hasname = 1;
parami = 1;
} else if (janet_checktype(head, JANET_KEYWORD)) {
hasname = 1;
parami = 1;
}
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (selfref) def->name = janet_unwrap_symbol(head);
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);

View File

@ -149,6 +149,11 @@ struct JanetVM {
JanetTraversalNode *traversal_top;
JanetTraversalNode *traversal_base;
/* Thread safe strerror error buffer - for janet_strerror */
#ifndef JANET_WINDOWS
char strerror_buf[256];
#endif
/* Event loop and scheduler globals */
#ifdef JANET_EV
size_t tq_count;

View File

@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
}
#endif
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
#define BUFSIZE 32
janet_buffer_extra(buffer, BUFSIZE);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
#undef BUFSIZE
/* fix locale issues with commas */
for (int i = 0; i < count; i++) {
char c = buffer->data[buffer->count + i];
if (c == ',') {
buffer->data[buffer->count + i] = '.';
}
}
buffer->count += count;
}

View File

@ -953,6 +953,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
#endif
#endif
/* Better strerror (thread-safe if available) */
const char *janet_strerror(int e) {
#ifdef JANET_WINDOWS
/* Microsoft strerror seems sane here and is thread safe by default */
return strerror(e);
#elif defined(_GNU_SOURCE)
/* See https://linux.die.net/man/3/strerror_r */
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
#else
strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
return janet_vm.strerror_buf;
#endif
}
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)

View File

@ -80,6 +80,8 @@ void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
const char *janet_strerror(int e);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,

View File

@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
Janet lr = janet_method_lookup(rhs, rmethod);
Janet argv[2] = { rhs, lhs };
if (janet_checktype(lr, JANET_NIL)) {
janet_panicf("could not find method :%s for %v, or :%s for %v",
janet_panicf("could not find method :%s for %v or :%s for %v",
lmethod, lhs,
rmethod, rhs);
}

View File

@ -112,7 +112,8 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|| defined(__loongarch64) /* LoongArch64 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@ -636,6 +637,12 @@ JANET_API void janet_async_end(JanetFiber *fiber);
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
JANET_API void janet_async_in_flight(JanetFiber *fiber);
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
* depending on expected service. */
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
JANET_API void janet_stream_level_triggered(JanetStream *stream);
#endif
/* Janet uses atomic integers in several places for synchronization between threads and

View File

@ -976,4 +976,7 @@
(assert (= () '() (macex '())) "macex ()")
(assert (= '[] (macex '[])) "macex []")
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(end-suite)

View File

@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2024 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@ -162,5 +162,20 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# buffer/format-at
(def start-buf (buffer/new-filled 100 (chr "x")))
(buffer/format-at start-buf 50 "aa%dbb" 32)
(assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb" (string/repeat "x" 44)))
"buffer/format-at 1")
(assert
(deep=
(buffer/format @"" "%j" [1 2 3 :a :b :c])
(buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c]))
"buffer/format-at empty buffer")
(def buf @"xxxyyy")
(buffer/format-at buf -4 "xxx")
(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"))
(end-suite)

View File

@ -42,7 +42,7 @@
(defn buffer-factory
[]
@"im am a buffer")
@"i am a buffer")
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")