mirror of
https://github.com/janet-lang/janet
synced 2025-11-13 22:07:13 +00:00
Compare commits
154 Commits
sync-primi
...
v1.25.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
54b52bbeb5 | ||
|
|
1174c68d9a | ||
|
|
448ea7167f | ||
|
|
6b27008c99 | ||
|
|
725c785882 | ||
|
|
ab068cff67 | ||
|
|
9dc03adfda | ||
|
|
49f9e4eddf | ||
|
|
43c47ac44c | ||
|
|
1cebe64664 | ||
|
|
f33c381043 | ||
|
|
3479841c77 | ||
|
|
6a899968a9 | ||
|
|
bb8405a36e | ||
|
|
c7bc711f63 | ||
|
|
e326071c35 | ||
|
|
ad6a669381 | ||
|
|
e4c9dafc9a | ||
|
|
dfc0aefd87 | ||
|
|
356b39c6f5 | ||
|
|
8da7bb6b68 | ||
|
|
9341081a4d | ||
|
|
324a086eb4 | ||
|
|
ed595f52c2 | ||
|
|
64ad0023bb | ||
|
|
fe5f661d15 | ||
|
|
ff26e3a8ba | ||
|
|
14657a762c | ||
|
|
4754fa3902 | ||
|
|
f302f87337 | ||
|
|
94dbcde292 | ||
|
|
4336a174b1 | ||
|
|
0adb13ed71 | ||
|
|
03ba1f7021 | ||
|
|
1f7f20788c | ||
|
|
c59dd29190 | ||
|
|
99f63a41a3 | ||
|
|
a575f5df36 | ||
|
|
0817e627ee | ||
|
|
14d90239a7 | ||
|
|
f5d11dc656 | ||
|
|
6dcf5bf077 | ||
|
|
ac2082e9b3 | ||
|
|
dbac495bee | ||
|
|
fe5ccb163e | ||
|
|
1aea5ee007 | ||
|
|
13cd9f8067 | ||
|
|
34496ecaf0 | ||
|
|
c043b1d949 | ||
|
|
9a6d2a7b32 | ||
|
|
f8a9efa8e4 | ||
|
|
5b2169e0d1 | ||
|
|
2c927ea768 | ||
|
|
f4bbcdcbc8 | ||
|
|
79c375b1af | ||
|
|
f443a3b3a1 | ||
|
|
684d2d63f4 | ||
|
|
1900d8f843 | ||
|
|
3c2af95d21 | ||
|
|
b35414ea0f | ||
|
|
fb5b056f7b | ||
|
|
7248c1dfdb | ||
|
|
4c7ea9e893 | ||
|
|
c7801ce277 | ||
|
|
f741a8e3ff | ||
|
|
6a92e8b609 | ||
|
|
9da91a8217 | ||
|
|
69853c8e5c | ||
|
|
1f41b6c138 | ||
|
|
e001efa9fd | ||
|
|
435e64d4cf | ||
|
|
f296c8f5fb | ||
|
|
8d0e6ed32f | ||
|
|
b6a36afffe | ||
|
|
e422abc269 | ||
|
|
221d71d07b | ||
|
|
9f35f0837e | ||
|
|
515891b035 | ||
|
|
94a506876f | ||
|
|
9bde57854a | ||
|
|
f456369941 | ||
|
|
8f0a1ffe5d | ||
|
|
e4bafc621a | ||
|
|
cfa39ab3b0 | ||
|
|
47e91bfd89 | ||
|
|
eecc388ebd | ||
|
|
0a15a5ee56 | ||
|
|
cfaae47cea | ||
|
|
c1a0352592 | ||
|
|
965f45aa3f | ||
|
|
6ea27fe836 | ||
|
|
0dccc22b38 | ||
|
|
cbe833962b | ||
|
|
b5720f6f10 | ||
|
|
56b4e0b0ec | ||
|
|
e316ccb1e0 | ||
|
|
a6f93efd39 | ||
|
|
20511cf608 | ||
|
|
1a1dd39367 | ||
|
|
589981bdcb | ||
|
|
89546776b2 | ||
|
|
f0d7b3cd12 | ||
|
|
e37be627e0 | ||
|
|
d803561582 | ||
|
|
a1aab4008f | ||
|
|
a1172529bf | ||
|
|
1d905bf07f | ||
|
|
eed678a14b | ||
|
|
b1bdffbc34 | ||
|
|
cff718f37d | ||
|
|
40e9430278 | ||
|
|
62fc55fc74 | ||
|
|
80729353c8 | ||
|
|
105ba5e124 | ||
|
|
ad1b50d1f5 | ||
|
|
1905437abe | ||
|
|
87fc339c45 | ||
|
|
3af7d61d3e | ||
|
|
a45ef7a856 | ||
|
|
299998055d | ||
|
|
c9586d39ed | ||
|
|
2e9f67f4e4 | ||
|
|
e318170fea | ||
|
|
73c4289792 | ||
|
|
ea45d7ee47 | ||
|
|
6d970725e7 | ||
|
|
458c2c6d88 | ||
|
|
0cc53a8964 | ||
|
|
0bc96304a9 | ||
|
|
c75b088ff8 | ||
|
|
181f0341f5 | ||
|
|
33bb08d53b | ||
|
|
6d188f6e44 | ||
|
|
c3648331f1 | ||
|
|
a5b66029d3 | ||
|
|
49bfe80191 | ||
|
|
a5def77bfe | ||
|
|
9ecb5b4791 | ||
|
|
1cc48a370a | ||
|
|
f1ec8d1e11 | ||
|
|
55c34cd84f | ||
|
|
aca52d1e36 | ||
|
|
6f90df26a5 | ||
|
|
9d9cb378ff | ||
|
|
f92aac14aa | ||
|
|
3f27d78ab5 | ||
|
|
282d1ba22f | ||
|
|
94c19575b1 | ||
|
|
e3e485285b | ||
|
|
986e36720e | ||
|
|
74348ab6c2 | ||
|
|
8d1ad99f42 | ||
|
|
e69bbff195 | ||
|
|
e0b7533c39 |
@@ -13,7 +13,7 @@ tasks:
|
|||||||
gmake test-install
|
gmake test-install
|
||||||
- meson_min: |
|
- meson_min: |
|
||||||
cd janet
|
cd janet
|
||||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
|
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
||||||
cd build_meson_min
|
cd build_meson_min
|
||||||
ninja
|
ninja
|
||||||
- meson_prf: |
|
- meson_prf: |
|
||||||
|
|||||||
1
.gitattributes
vendored
1
.gitattributes
vendored
@@ -1,3 +1,4 @@
|
|||||||
|
*.janet linguist-language=Janet
|
||||||
*.janet text eol=lf
|
*.janet text eol=lf
|
||||||
*.c text eol=lf
|
*.c text eol=lf
|
||||||
*.h text eol=lf
|
*.h text eol=lf
|
||||||
|
|||||||
38
CHANGELOG.md
38
CHANGELOG.md
@@ -1,7 +1,43 @@
|
|||||||
# Changelog
|
# Changelog
|
||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## Unreleased - ???
|
## 1.25.0 - 2022-10-10
|
||||||
|
- Windows FFI fixes.
|
||||||
|
- Fix PEG `if-not` combinator with captures in the condition
|
||||||
|
- Fix bug with `os/date` with nil first argument
|
||||||
|
- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
|
||||||
|
- Reduce number of hash collisiions from pointer hashing
|
||||||
|
- Add optional parameter to `marshal` to skip cycle checking code
|
||||||
|
|
||||||
|
## 1.24.1 - 2022-08-24
|
||||||
|
- Fix FFI bug on Linux/Posix
|
||||||
|
- Improve parse error messages for bad delimiters.
|
||||||
|
- Add optional `name` parameter to the `short-fn` macro.
|
||||||
|
|
||||||
|
## 1.24.0 - 2022-08-14
|
||||||
|
- Add FFI support to 64-bit windows compiled with MSVC
|
||||||
|
- Don't process shared object names passed to dlopen.
|
||||||
|
- Add better support for windows console in the default shell.c for auto-completion and
|
||||||
|
other shell-like input features.
|
||||||
|
- Improve default error message from `assert`.
|
||||||
|
- Add the `tabseq` macro for simpler table comprehensions.
|
||||||
|
- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
|
||||||
|
this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
|
||||||
|
|
||||||
|
## 1.23.0 - 2022-06-20
|
||||||
|
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
|
||||||
|
on 64 bit linux, mac, and bsd systems.
|
||||||
|
- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic
|
||||||
|
variant of `&keys` that isn't as redundant, more self documenting, and allows extension to
|
||||||
|
things like default arguments.
|
||||||
|
- Add `delay` macro for lazy evaluate-and-save thunks.
|
||||||
|
- Remove pthread.h from janet.h for easier includes.
|
||||||
|
- Add `debugger` - an easy to use debugger function that just takes a fiber.
|
||||||
|
- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
|
||||||
|
- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
|
||||||
|
abnormal fiber signals.
|
||||||
|
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
|
||||||
|
- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
|
||||||
- Add `parse-all` as a generalization of the `parse` function.
|
- Add `parse-all` as a generalization of the `parse` function.
|
||||||
- Add `os/cpu-count` to get the number of available processors on a machine
|
- Add `os/cpu-count` to get the number of available processors on a machine
|
||||||
|
|
||||||
|
|||||||
@@ -64,6 +64,23 @@ ensure a consistent code style for C.
|
|||||||
All janet code in the project should be formatted similar to the code in core.janet.
|
All janet code in the project should be formatted similar to the code in core.janet.
|
||||||
The auto formatting from janet.vim will work well.
|
The auto formatting from janet.vim will work well.
|
||||||
|
|
||||||
|
## Typo Fixing and One-Line changes
|
||||||
|
|
||||||
|
Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
|
||||||
|
individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
|
||||||
|
CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
|
||||||
|
specific changes, these can be addressed in the review process before the final merge, if the changes
|
||||||
|
are accepted.
|
||||||
|
|
||||||
|
Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
|
||||||
|
immediately without response.
|
||||||
|
|
||||||
|
## Contributions from Automated Tools
|
||||||
|
|
||||||
|
People making changes found or generated by automated tools MUST note this when opening an issue
|
||||||
|
or creating a pull request. This can help give context to developers if the change/issue is
|
||||||
|
confusing or nonsensical.
|
||||||
|
|
||||||
## Suggesting Changes
|
## Suggesting Changes
|
||||||
|
|
||||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||||
|
|||||||
11
Makefile
11
Makefile
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2021 Calvin Rose
|
# Copyright (c) 2022 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
@@ -108,6 +108,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
|||||||
src/core/debug.c \
|
src/core/debug.c \
|
||||||
src/core/emit.c \
|
src/core/emit.c \
|
||||||
src/core/ev.c \
|
src/core/ev.c \
|
||||||
|
src/core/ffi.c \
|
||||||
src/core/fiber.c \
|
src/core/fiber.c \
|
||||||
src/core/gc.c \
|
src/core/gc.c \
|
||||||
src/core/inttypes.c \
|
src/core/inttypes.c \
|
||||||
@@ -167,9 +168,9 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
|||||||
########################
|
########################
|
||||||
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
SONAME=libjanet.1.22.dylib
|
SONAME=libjanet.1.25.dylib
|
||||||
else
|
else
|
||||||
SONAME=libjanet.so.1.22
|
SONAME=libjanet.so.1.25
|
||||||
endif
|
endif
|
||||||
|
|
||||||
build/c/shell.c: src/mainclient/shell.c
|
build/c/shell.c: src/mainclient/shell.c
|
||||||
@@ -282,7 +283,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
|||||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
ln -sf '$(DESTDIR)$(INCLUDEDIR)/janet/janet.h' '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
|
||||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||||
if test $(UNAME) = Darwin ; then \
|
if test $(UNAME) = Darwin ; then \
|
||||||
@@ -299,7 +300,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
|||||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||||
|
|
||||||
install-jpm-git: $(JANET_TARGET)
|
install-jpm-git: $(JANET_TARGET)
|
||||||
mkdir -p build
|
mkdir -p build
|
||||||
|
|||||||
@@ -89,6 +89,8 @@ cd somewhere/my/projects/janet
|
|||||||
make
|
make
|
||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
|
make install
|
||||||
|
make install-jpm-git
|
||||||
```
|
```
|
||||||
|
|
||||||
Find out more about the available make targets by running `make help`.
|
Find out more about the available make targets by running `make help`.
|
||||||
@@ -103,6 +105,8 @@ cd somewhere/my/projects/janet
|
|||||||
make CC=gcc-x86
|
make CC=gcc-x86
|
||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
|
make install
|
||||||
|
make install-jpm-git
|
||||||
```
|
```
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
@@ -116,6 +120,8 @@ cd somewhere/my/projects/janet
|
|||||||
gmake
|
gmake
|
||||||
gmake test
|
gmake test
|
||||||
gmake repl
|
gmake repl
|
||||||
|
gmake install
|
||||||
|
gmake install-jpm-git
|
||||||
```
|
```
|
||||||
|
|
||||||
### NetBSD
|
### NetBSD
|
||||||
|
|||||||
71
examples/ffi/gtk.janet
Normal file
71
examples/ffi/gtk.janet
Normal file
@@ -0,0 +1,71 @@
|
|||||||
|
# :lazy true needed for jpm quickbin
|
||||||
|
# lazily loads library on first function use
|
||||||
|
# so the `main` function
|
||||||
|
# can be marshalled.
|
||||||
|
(ffi/context "/usr/lib/libgtk-3.so" :lazy true)
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-application-new :ptr
|
||||||
|
"Add docstrings as needed."
|
||||||
|
[title :string flags :uint])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
g-signal-connect-data :ulong
|
||||||
|
[a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
g-application-run :int
|
||||||
|
[app :ptr argc :int argv :ptr])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-application-window-new :ptr
|
||||||
|
[a :ptr])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-button-new-with-label :ptr
|
||||||
|
[a :ptr])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-container-add :void
|
||||||
|
[a :ptr b :ptr])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-widget-show-all :void
|
||||||
|
[a :ptr])
|
||||||
|
|
||||||
|
(ffi/defbind
|
||||||
|
gtk-button-set-label :void
|
||||||
|
[a :ptr b :ptr])
|
||||||
|
|
||||||
|
(def cb (delay (ffi/trampoline :default)))
|
||||||
|
|
||||||
|
(defn ffi/array
|
||||||
|
``Convert a janet array to a buffer that can be passed to FFI functions.
|
||||||
|
For example, to create an array of type `char *` (array of c strings), one
|
||||||
|
could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
|
||||||
|
array elements are not garbage collected though - the GC can't follow references
|
||||||
|
inside an arbitrary byte buffer.``
|
||||||
|
[arr ctype &opt buf]
|
||||||
|
(default buf @"")
|
||||||
|
(each el arr
|
||||||
|
(ffi/write ctype el buf))
|
||||||
|
buf)
|
||||||
|
|
||||||
|
(defn on-active
|
||||||
|
[app]
|
||||||
|
(def window (gtk-application-window-new app))
|
||||||
|
(def btn (gtk-button-new-with-label "Click Me!"))
|
||||||
|
(g-signal-connect-data btn "clicked" (cb)
|
||||||
|
(fn [btn] (gtk-button-set-label btn "Hello World"))
|
||||||
|
nil 1)
|
||||||
|
(gtk-container-add window btn)
|
||||||
|
(gtk-widget-show-all window))
|
||||||
|
|
||||||
|
(defn main
|
||||||
|
[&]
|
||||||
|
(def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
|
||||||
|
(g-signal-connect-data app "activate" (cb) on-active nil 1)
|
||||||
|
# manually build an array with ffi/write
|
||||||
|
# - we are responsible for preventing gc when the arg array is used
|
||||||
|
(def argv (ffi/array (dyn *args*) :string))
|
||||||
|
(g-application-run app (length (dyn *args*)) argv))
|
||||||
208
examples/ffi/so.c
Normal file
208
examples/ffi/so.c
Normal file
@@ -0,0 +1,208 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <stdint.h>
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
|
#ifdef _WIN32
|
||||||
|
#define EXPORTER __declspec(dllexport)
|
||||||
|
#else
|
||||||
|
#define EXPORTER
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Structs */
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
int a, b;
|
||||||
|
float c, d;
|
||||||
|
} Split;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
float c, d;
|
||||||
|
int a, b;
|
||||||
|
} SplitFlip;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
int u, v, w, x, y, z;
|
||||||
|
} SixInts;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
int a;
|
||||||
|
int b;
|
||||||
|
} intint;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
int a;
|
||||||
|
int b;
|
||||||
|
int c;
|
||||||
|
} intintint;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
int64_t a;
|
||||||
|
int64_t b;
|
||||||
|
int64_t c;
|
||||||
|
} big;
|
||||||
|
|
||||||
|
/* Functions */
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int int_fn(int a, int b) {
|
||||||
|
return (a << 2) + b;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double my_fn(int64_t a, int64_t b, const char *x) {
|
||||||
|
return (double)(a + b) + 0.5 + strlen(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double double_fn(double x, double y, double z) {
|
||||||
|
return (x + y) * z * 3;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double double_many(double x, double y, double z, double w, double a, double b) {
|
||||||
|
return x + y + z + w + a + b;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double double_lots(
|
||||||
|
double a,
|
||||||
|
double b,
|
||||||
|
double c,
|
||||||
|
double d,
|
||||||
|
double e,
|
||||||
|
double f,
|
||||||
|
double g,
|
||||||
|
double h,
|
||||||
|
double i,
|
||||||
|
double j) {
|
||||||
|
return i + j;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double double_lots_2(
|
||||||
|
double a,
|
||||||
|
double b,
|
||||||
|
double c,
|
||||||
|
double d,
|
||||||
|
double e,
|
||||||
|
double f,
|
||||||
|
double g,
|
||||||
|
double h,
|
||||||
|
double i,
|
||||||
|
double j) {
|
||||||
|
return a +
|
||||||
|
10.0 * b +
|
||||||
|
100.0 * c +
|
||||||
|
1000.0 * d +
|
||||||
|
10000.0 * e +
|
||||||
|
100000.0 * f +
|
||||||
|
1000000.0 * g +
|
||||||
|
10000000.0 * h +
|
||||||
|
100000000.0 * i +
|
||||||
|
1000000000.0 * j;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
double float_fn(float x, float y, float z) {
|
||||||
|
return (x + y) * z;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int intint_fn(double x, intint ii) {
|
||||||
|
printf("double: %g\n", x);
|
||||||
|
return ii.a + ii.b;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int intintint_fn(double x, intintint iii) {
|
||||||
|
printf("double: %g\n", x);
|
||||||
|
return iii.a + iii.b + iii.c;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
intint return_struct(int i) {
|
||||||
|
intint ret;
|
||||||
|
ret.a = i;
|
||||||
|
ret.b = i * i;
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
big struct_big(int i, double d) {
|
||||||
|
big ret;
|
||||||
|
ret.a = i;
|
||||||
|
ret.b = (int64_t) d;
|
||||||
|
ret.c = ret.a + ret.b + 1000;
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
void void_fn(void) {
|
||||||
|
printf("void fn ran\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
void void_fn_2(double y) {
|
||||||
|
printf("y = %f\n", y);
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
void void_ret_fn(int x) {
|
||||||
|
printf("void fn ran: %d\n", x);
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int intintint_fn_2(intintint iii, int i) {
|
||||||
|
fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
|
||||||
|
return i * (iii.a + iii.b + iii.c);
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
float split_fn(Split s) {
|
||||||
|
return s.a * s.c + s.b * s.d;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
float split_flip_fn(SplitFlip s) {
|
||||||
|
return s.a * s.c + s.b * s.d;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
Split split_ret_fn(int x, float y) {
|
||||||
|
Split ret;
|
||||||
|
ret.a = x;
|
||||||
|
ret.b = x;
|
||||||
|
ret.c = y;
|
||||||
|
ret.d = y;
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
SplitFlip split_flip_ret_fn(int x, float y) {
|
||||||
|
SplitFlip ret;
|
||||||
|
ret.a = x;
|
||||||
|
ret.b = x;
|
||||||
|
ret.c = y;
|
||||||
|
ret.d = y;
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
SixInts sixints_fn(void) {
|
||||||
|
return (SixInts) {
|
||||||
|
6666, 1111, 2222, 3333, 4444, 5555
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int sixints_fn_2(int x, SixInts s) {
|
||||||
|
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||||
|
}
|
||||||
|
|
||||||
|
EXPORTER
|
||||||
|
int sixints_fn_3(SixInts s, int x) {
|
||||||
|
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
134
examples/ffi/test.janet
Normal file
134
examples/ffi/test.janet
Normal file
@@ -0,0 +1,134 @@
|
|||||||
|
#
|
||||||
|
# Simple FFI test script that tests against a simple shared object
|
||||||
|
#
|
||||||
|
|
||||||
|
(def is-windows (= :windows (os/which)))
|
||||||
|
(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
|
||||||
|
(def ffi/source-loc "examples/ffi/so.c")
|
||||||
|
|
||||||
|
(if is-windows
|
||||||
|
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
|
||||||
|
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
|
||||||
|
|
||||||
|
(ffi/context ffi/loc)
|
||||||
|
|
||||||
|
(def intintint (ffi/struct :int :int :int))
|
||||||
|
(def big (ffi/struct :s64 :s64 :s64))
|
||||||
|
(def split (ffi/struct :int :int :float :float))
|
||||||
|
(def split-flip (ffi/struct :float :float :int :int))
|
||||||
|
(def six-ints (ffi/struct :int :int :int :int :int :int))
|
||||||
|
|
||||||
|
(ffi/defbind int-fn :int [a :int b :int])
|
||||||
|
(ffi/defbind double-fn :double [a :double b :double c :double])
|
||||||
|
(ffi/defbind double-many :double
|
||||||
|
[x :double y :double z :double w :double a :double b :double])
|
||||||
|
(ffi/defbind double-lots :double
|
||||||
|
[a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
|
||||||
|
(ffi/defbind float-fn :double
|
||||||
|
[x :float y :float z :float])
|
||||||
|
(ffi/defbind intint-fn :int
|
||||||
|
[x :double ii [:int :int]])
|
||||||
|
(ffi/defbind return-struct [:int :int]
|
||||||
|
[i :int])
|
||||||
|
(ffi/defbind intintint-fn :int
|
||||||
|
[x :double iii intintint])
|
||||||
|
(ffi/defbind struct-big big
|
||||||
|
[i :int d :double])
|
||||||
|
(ffi/defbind void-fn :void [])
|
||||||
|
(ffi/defbind double-lots-2 :double
|
||||||
|
[a :double
|
||||||
|
b :double
|
||||||
|
c :double
|
||||||
|
d :double
|
||||||
|
e :double
|
||||||
|
f :double
|
||||||
|
g :double
|
||||||
|
h :double
|
||||||
|
i :double
|
||||||
|
j :double])
|
||||||
|
(ffi/defbind void-fn-2 :void [y :double])
|
||||||
|
(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
|
||||||
|
(ffi/defbind split-fn :float [s split])
|
||||||
|
(ffi/defbind split-flip-fn :float [s split-flip])
|
||||||
|
(ffi/defbind split-ret-fn split [x :int y :float])
|
||||||
|
(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
|
||||||
|
(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])
|
||||||
|
|
||||||
|
#
|
||||||
|
# Struct reading and writing
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn check-round-trip
|
||||||
|
[t value]
|
||||||
|
(def buf (ffi/write t value))
|
||||||
|
(def same-value (ffi/read t buf))
|
||||||
|
(assert (deep= value same-value)
|
||||||
|
(string/format "round trip %j (got %j)" value same-value)))
|
||||||
|
|
||||||
|
(check-round-trip :bool true)
|
||||||
|
(check-round-trip :bool false)
|
||||||
|
(check-round-trip :void nil)
|
||||||
|
(check-round-trip :void nil)
|
||||||
|
(check-round-trip :s8 10)
|
||||||
|
(check-round-trip :s8 0)
|
||||||
|
(check-round-trip :s8 -10)
|
||||||
|
(check-round-trip :u8 10)
|
||||||
|
(check-round-trip :u8 0)
|
||||||
|
(check-round-trip :s16 10)
|
||||||
|
(check-round-trip :s16 0)
|
||||||
|
(check-round-trip :s16 -12312)
|
||||||
|
(check-round-trip :u16 10)
|
||||||
|
(check-round-trip :u16 0)
|
||||||
|
(check-round-trip :u32 0)
|
||||||
|
(check-round-trip :u32 10)
|
||||||
|
(check-round-trip :u32 0xFFFF7777)
|
||||||
|
(check-round-trip :s32 0x7FFF7777)
|
||||||
|
(check-round-trip :s32 0)
|
||||||
|
(check-round-trip :s32 -1234567)
|
||||||
|
|
||||||
|
(def s (ffi/struct :s8 :s8 :s8 :float))
|
||||||
|
(check-round-trip s [1 3 5 123.5])
|
||||||
|
(check-round-trip s [-1 -3 -5 -123.5])
|
||||||
|
|
||||||
|
#
|
||||||
|
# Call functions
|
||||||
|
#
|
||||||
|
|
||||||
|
(tracev (sixints-fn))
|
||||||
|
(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
|
||||||
|
(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
|
||||||
|
(tracev (split-ret-fn 10 12))
|
||||||
|
(tracev (split-flip-ret-fn 10 12))
|
||||||
|
(tracev (split-flip-ret-fn 12 10))
|
||||||
|
(tracev (intintint-fn-2 [10 20 30] 3))
|
||||||
|
(tracev (split-fn [5 6 1.2 3.4]))
|
||||||
|
(tracev (void-fn-2 10.3))
|
||||||
|
(tracev (double-many 1 2 3 4 5 6))
|
||||||
|
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
|
||||||
|
(tracev (type (double-many 1 2 3 4 5 6)))
|
||||||
|
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
|
||||||
|
(tracev (void-fn))
|
||||||
|
(tracev (int-fn 10 20))
|
||||||
|
(tracev (double-fn 1.5 2.5 3.5))
|
||||||
|
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
|
||||||
|
(tracev (float-fn 8 4 17))
|
||||||
|
(tracev (intint-fn 123.456 [10 20]))
|
||||||
|
(tracev (intintint-fn 123.456 [10 20 30]))
|
||||||
|
(tracev (return-struct 42))
|
||||||
|
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
||||||
|
(tracev (struct-big 11 99.5))
|
||||||
|
|
||||||
|
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
||||||
|
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
||||||
|
(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
|
||||||
|
(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
|
||||||
|
(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
|
||||||
|
(assert (= 60 (int-fn 10 20)))
|
||||||
|
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
||||||
|
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
|
||||||
|
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
||||||
|
(assert (= 204 (float-fn 8 4 17)))
|
||||||
|
|
||||||
|
(print "Done.")
|
||||||
7
examples/ffi/win32.janet
Normal file
7
examples/ffi/win32.janet
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
(ffi/context "user32.dll")
|
||||||
|
|
||||||
|
(ffi/defbind MessageBoxA :int
|
||||||
|
[w :ptr text :string cap :string typ :int])
|
||||||
|
|
||||||
|
(MessageBoxA nil "Hello, World!" "Test" 0)
|
||||||
|
|
||||||
2
examples/lineloop.janet
Normal file
2
examples/lineloop.janet
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
(while (not (empty? (def line (getline))))
|
||||||
|
(prin "line: " line))
|
||||||
30
examples/marshal-stress.janet
Normal file
30
examples/marshal-stress.janet
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
(defn init-db [c]
|
||||||
|
(def res @{:clients @{}})
|
||||||
|
(var i 0)
|
||||||
|
(repeat c
|
||||||
|
(def n (string "client" i))
|
||||||
|
(put-in res [:clients n] @{:name n :projects @{}})
|
||||||
|
(++ i)
|
||||||
|
(repeat c
|
||||||
|
(def pn (string "project" i))
|
||||||
|
(put-in res [:clients n :projects pn] @{:name pn})
|
||||||
|
(++ i)
|
||||||
|
(repeat c
|
||||||
|
(def tn (string "task" i))
|
||||||
|
(put-in res [:clients n :projects pn :tasks tn] @{:name pn})
|
||||||
|
(++ i))))
|
||||||
|
res)
|
||||||
|
|
||||||
|
(loop [c :range [30 80 1]]
|
||||||
|
(var s (os/clock))
|
||||||
|
(print "Marshal DB with " c " clients, "
|
||||||
|
(* c c) " projects and "
|
||||||
|
(* c c c) " tasks. "
|
||||||
|
"Total " (+ (* c c c) (* c c) c) " tables")
|
||||||
|
(def buf (marshal (init-db c) @{} @""))
|
||||||
|
(print "Buffer is " (length buf) " bytes")
|
||||||
|
(print "Duration " (- (os/clock) s))
|
||||||
|
(set s (os/clock))
|
||||||
|
(gccollect)
|
||||||
|
(print "Collected garbage in " (- (os/clock) s)))
|
||||||
|
|
||||||
7
janet.1
7
janet.1
@@ -164,10 +164,15 @@ Execute a string of Janet source. Source code is executed in the order it is enc
|
|||||||
arguments are executed before later ones.
|
arguments are executed before later ones.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-E\ code arguments
|
.BR \-E\ code\ arguments...
|
||||||
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
||||||
more concise one-liners with command line arguments.
|
more concise one-liners with command line arguments.
|
||||||
|
|
||||||
|
Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
|
||||||
|
`((fn [k] (print k)) 12)`
|
||||||
|
|
||||||
|
See docs for the `short-fn` function for more details.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-d
|
.BR \-d
|
||||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
|
|
||||||
project('janet', 'c',
|
project('janet', 'c',
|
||||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||||
version : '1.22.1')
|
version : '1.25.0')
|
||||||
|
|
||||||
# Global settings
|
# Global settings
|
||||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||||
@@ -76,6 +76,7 @@ conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
|||||||
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
||||||
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
||||||
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
||||||
|
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
||||||
if get_option('os_name') != ''
|
if get_option('os_name') != ''
|
||||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||||
endif
|
endif
|
||||||
@@ -116,6 +117,7 @@ core_src = [
|
|||||||
'src/core/debug.c',
|
'src/core/debug.c',
|
||||||
'src/core/emit.c',
|
'src/core/emit.c',
|
||||||
'src/core/ev.c',
|
'src/core/ev.c',
|
||||||
|
'src/core/ffi.c',
|
||||||
'src/core/fiber.c',
|
'src/core/fiber.c',
|
||||||
'src/core/gc.c',
|
'src/core/gc.c',
|
||||||
'src/core/inttypes.c',
|
'src/core/inttypes.c',
|
||||||
|
|||||||
@@ -19,6 +19,7 @@ option('simple_getline', type : 'boolean', value : false)
|
|||||||
option('epoll', type : 'boolean', value : false)
|
option('epoll', type : 'boolean', value : false)
|
||||||
option('kqueue', type : 'boolean', value : false)
|
option('kqueue', type : 'boolean', value : false)
|
||||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||||
|
option('ffi', type : 'boolean', value : true)
|
||||||
|
|
||||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
# The core janet library
|
# The core janet library
|
||||||
# Copyright 2021 © Calvin Rose
|
# Copyright 2022 © Calvin Rose
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@@ -45,6 +45,7 @@
|
|||||||
(defn defmacro :macro
|
(defn defmacro :macro
|
||||||
"Define a macro."
|
"Define a macro."
|
||||||
[name & more]
|
[name & more]
|
||||||
|
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
||||||
(apply defn name :macro more))
|
(apply defn name :macro more))
|
||||||
|
|
||||||
(defmacro as-macro
|
(defmacro as-macro
|
||||||
@@ -75,6 +76,11 @@
|
|||||||
[name & more]
|
[name & more]
|
||||||
~(var ,name :private ,;more))
|
~(var ,name :private ,;more))
|
||||||
|
|
||||||
|
(defmacro toggle
|
||||||
|
"Set a value to its boolean inverse. Same as `(set value (not value))`."
|
||||||
|
[value]
|
||||||
|
~(set ,value (,not ,value)))
|
||||||
|
|
||||||
(defn defglobal
|
(defn defglobal
|
||||||
"Dynamically create a global def."
|
"Dynamically create a global def."
|
||||||
[name value]
|
[name value]
|
||||||
@@ -157,7 +163,7 @@
|
|||||||
(def ,v ,x)
|
(def ,v ,x)
|
||||||
(if ,v
|
(if ,v
|
||||||
,v
|
,v
|
||||||
(,error ,(if err err "assert failure")))))
|
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
||||||
|
|
||||||
(defn errorf
|
(defn errorf
|
||||||
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
|
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
|
||||||
@@ -605,13 +611,20 @@
|
|||||||
See `loop` for details.``
|
See `loop` for details.``
|
||||||
[head & body]
|
[head & body]
|
||||||
(def $accum (gensym))
|
(def $accum (gensym))
|
||||||
~(do (def ,$accum @[]) (loop ,head (array/push ,$accum (do ,;body))) ,$accum))
|
~(do (def ,$accum @[]) (loop ,head (,array/push ,$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))
|
||||||
|
|
||||||
(defmacro generate
|
(defmacro generate
|
||||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||||
that yields all values inside the loop in order. See `loop` for details.``
|
that yields all values inside the loop in order. See `loop` for details.``
|
||||||
[head & body]
|
[head & body]
|
||||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||||
|
|
||||||
(defmacro coro
|
(defmacro coro
|
||||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||||
@@ -948,12 +961,12 @@
|
|||||||
(def call-buffer @[])
|
(def call-buffer @[])
|
||||||
(while true
|
(while true
|
||||||
(forv i 0 ninds
|
(forv i 0 ninds
|
||||||
(let [old-key (in iterkeys i)
|
(let [old-key (in iterkeys i)
|
||||||
ii (in inds i)
|
ii (in inds i)
|
||||||
new-key (next ii old-key)]
|
new-key (next ii old-key)]
|
||||||
(if (= nil new-key)
|
(if (= nil new-key)
|
||||||
(do (set done true) (break))
|
(do (set done true) (break))
|
||||||
(do (set (iterkeys i) new-key) (array/push call-buffer (in ii new-key))))))
|
(do (set (iterkeys i) new-key) (array/push call-buffer (in ii new-key))))))
|
||||||
(if done (break))
|
(if done (break))
|
||||||
(array/push res (f ;call-buffer))
|
(array/push res (f ;call-buffer))
|
||||||
(array/clear call-buffer))))
|
(array/clear call-buffer))))
|
||||||
@@ -1591,8 +1604,8 @@
|
|||||||
(each x ind
|
(each x ind
|
||||||
(def y (f x))
|
(def y (f x))
|
||||||
(cond
|
(cond
|
||||||
is-new (do (set is-new false) (set category y) (set span @[x]) (array/push ret span))
|
is-new (do (set is-new false) (set category y) (set span @[x]) (array/push ret span))
|
||||||
(= y category) (array/push span x)
|
(= y category) (array/push span x)
|
||||||
(do (set category y) (set span @[x]) (array/push ret span))))
|
(do (set category y) (set span @[x]) (array/push ret span))))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
@@ -1736,7 +1749,7 @@
|
|||||||
* tuple -- a tuple pattern will match if its first element matches, and the
|
* tuple -- a tuple pattern will match if its first element matches, and the
|
||||||
following elements are treated as predicates and are true.
|
following elements are treated as predicates and are true.
|
||||||
|
|
||||||
* `\_` symbol -- the last special case is the `\_` symbol, which is a wildcard
|
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
|
||||||
that will match any value without creating a binding.
|
that will match any value without creating a binding.
|
||||||
|
|
||||||
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
|
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
|
||||||
@@ -1842,7 +1855,7 @@
|
|||||||
(when isarr
|
(when isarr
|
||||||
(array/push anda (get-length-sym s))
|
(array/push anda (get-length-sym s))
|
||||||
(def pattern-len
|
(def pattern-len
|
||||||
(if-let [ rest-idx (find-index (fn [x] (= x '&)) pattern) ]
|
(if-let [rest-idx (find-index (fn [x] (= x '&)) pattern)]
|
||||||
rest-idx
|
rest-idx
|
||||||
(length pattern)))
|
(length pattern)))
|
||||||
(array/push anda [<= pattern-len (get-length-sym s)]))
|
(array/push anda [<= pattern-len (get-length-sym s)]))
|
||||||
@@ -2164,7 +2177,7 @@
|
|||||||
|(+ $ $) # use pipe reader macro for terse function literals.
|
|(+ $ $) # use pipe reader macro for terse function literals.
|
||||||
|(+ $&) # variadic functions
|
|(+ $&) # variadic functions
|
||||||
```
|
```
|
||||||
[arg]
|
[arg &opt name]
|
||||||
(var max-param-seen -1)
|
(var max-param-seen -1)
|
||||||
(var vararg false)
|
(var vararg false)
|
||||||
(defn saw-special-arg
|
(defn saw-special-arg
|
||||||
@@ -2190,8 +2203,9 @@
|
|||||||
x))
|
x))
|
||||||
x))
|
x))
|
||||||
(def expanded (macex arg on-binding))
|
(def expanded (macex arg on-binding))
|
||||||
|
(def name-splice (if name [name] []))
|
||||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@@ -2282,9 +2296,9 @@
|
|||||||
(def source-code (file/read f :all))
|
(def source-code (file/read f :all))
|
||||||
(var index 0)
|
(var index 0)
|
||||||
(repeat (dec line)
|
(repeat (dec line)
|
||||||
(if-not index (break))
|
(if-not index (break))
|
||||||
(set index (string/find "\n" source-code index))
|
(set index (string/find "\n" source-code index))
|
||||||
(if index (++ index)))
|
(if index (++ index)))
|
||||||
(when index
|
(when index
|
||||||
(def line-end (string/find "\n" source-code index))
|
(def line-end (string/find "\n" source-code index))
|
||||||
(eprint " " (string/slice source-code index line-end))
|
(eprint " " (string/slice source-code index line-end))
|
||||||
@@ -2586,8 +2600,8 @@
|
|||||||
(while (parser/has-more p)
|
(while (parser/has-more p)
|
||||||
(array/push ret (parser/produce p)))
|
(array/push ret (parser/produce p)))
|
||||||
(if (= :error (parser/status p))
|
(if (= :error (parser/status p))
|
||||||
(error (parser/error p))
|
(error (parser/error p))
|
||||||
ret)))
|
ret)))
|
||||||
|
|
||||||
(def load-image-dict
|
(def load-image-dict
|
||||||
``A table used in combination with `unmarshal` to unmarshal byte sequences created
|
``A table used in combination with `unmarshal` to unmarshal byte sequences created
|
||||||
@@ -2746,19 +2760,64 @@
|
|||||||
(get r 0)
|
(get r 0)
|
||||||
v))))
|
v))))
|
||||||
|
|
||||||
|
(def debugger-env
|
||||||
|
"An environment that contains dot prefixed functions for debugging."
|
||||||
|
@{})
|
||||||
|
|
||||||
|
(var- debugger-on-status-var nil)
|
||||||
|
|
||||||
|
(defn debugger
|
||||||
|
"Run a repl-based debugger on a fiber. Optionally pass in a level
|
||||||
|
to differentiate nested debuggers."
|
||||||
|
[fiber &opt level]
|
||||||
|
(default level 1)
|
||||||
|
(def nextenv (make-env (fiber/getenv fiber)))
|
||||||
|
(put nextenv :fiber fiber)
|
||||||
|
(put nextenv :debug-level level)
|
||||||
|
(put nextenv :signal (fiber/last-value fiber))
|
||||||
|
(merge-into nextenv debugger-env)
|
||||||
|
(defn debugger-chunks [buf p]
|
||||||
|
(def status (:state p :delimiters))
|
||||||
|
(def c ((:where p) 0))
|
||||||
|
(def prpt (string "debug[" level "]:" c ":" status "> "))
|
||||||
|
(getline prpt buf nextenv))
|
||||||
|
(eprint "entering debug[" level "] - (quit) to exit")
|
||||||
|
(flush)
|
||||||
|
(run-context
|
||||||
|
{:chunks debugger-chunks
|
||||||
|
:on-status (debugger-on-status-var nextenv (+ 1 level) true)
|
||||||
|
:env nextenv})
|
||||||
|
(eprint "exiting debug[" level "]")
|
||||||
|
(flush)
|
||||||
|
(nextenv :resume-value))
|
||||||
|
|
||||||
|
(defn debugger-on-status
|
||||||
|
"Create a function that can be passed to `run-context`'s `:on-status`
|
||||||
|
argument that will drop into a debugger on errors. The debugger will
|
||||||
|
only start on abnormal signals if the env table has the `:debug` dyn
|
||||||
|
set to a truthy value."
|
||||||
|
[env &opt level is-repl]
|
||||||
|
(default level 1)
|
||||||
|
(fn [f x]
|
||||||
|
(def fs (fiber/status f))
|
||||||
|
(if (= :dead fs)
|
||||||
|
(when is-repl
|
||||||
|
(put env '_ @{:value x})
|
||||||
|
(printf (get env :pretty-format "%q") x)
|
||||||
|
(flush))
|
||||||
|
(do
|
||||||
|
(debug/stacktrace f x "")
|
||||||
|
(eflush)
|
||||||
|
(if (get env :debug) (debugger f level))))))
|
||||||
|
|
||||||
|
(set debugger-on-status-var debugger-on-status)
|
||||||
|
|
||||||
(defn dofile
|
(defn dofile
|
||||||
``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
|
``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
|
||||||
:source, :evaluator, :read, and :parser are passed through to the underlying
|
:source, :evaluator, :read, and :parser are passed through to the underlying
|
||||||
`run-context` call. If `exit` is true, any top level errors will trigger a
|
`run-context` call. If `exit` is true, any top level errors will trigger a
|
||||||
call to `(os/exit 1)` after printing the error.``
|
call to `(os/exit 1)` after printing the error.``
|
||||||
[path &keys
|
[path &named exit env source expander evaluator read parser]
|
||||||
{:exit exit
|
|
||||||
:env env
|
|
||||||
:source src
|
|
||||||
:expander expander
|
|
||||||
:evaluator evaluator
|
|
||||||
:read read
|
|
||||||
:parser parser}]
|
|
||||||
(def f (case (type path)
|
(def f (case (type path)
|
||||||
:core/file path
|
:core/file path
|
||||||
:core/stream path
|
:core/stream path
|
||||||
@@ -2766,7 +2825,7 @@
|
|||||||
(def path-is-file (= f path))
|
(def path-is-file (= f path))
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(def spath (string path))
|
(def spath (string path))
|
||||||
(put env :source (or src (if-not path-is-file spath path)))
|
(put env :source (or source (if-not path-is-file spath path)))
|
||||||
(var exit-error nil)
|
(var exit-error nil)
|
||||||
(var exit-fiber nil)
|
(var exit-fiber nil)
|
||||||
(defn chunks [buf _] (:read f 4096 buf))
|
(defn chunks [buf _] (:read f 4096 buf))
|
||||||
@@ -2802,14 +2861,17 @@
|
|||||||
(debug/stacktrace f x "")
|
(debug/stacktrace f x "")
|
||||||
(eflush)
|
(eflush)
|
||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
(put env :exit true)
|
(if (get env :debug)
|
||||||
(set exit-error x)
|
((debugger-on-status env) f x)
|
||||||
(set exit-fiber f)))
|
(do
|
||||||
|
(put env :exit true)
|
||||||
|
(set exit-error x)
|
||||||
|
(set exit-fiber f)))))
|
||||||
:evaluator evaluator
|
:evaluator evaluator
|
||||||
:expander expander
|
:expander expander
|
||||||
:read read
|
:read read
|
||||||
:parser parser
|
:parser parser
|
||||||
:source (or src (if path-is-file :<anonymous> spath))}))
|
:source (or source (if path-is-file :<anonymous> spath))}))
|
||||||
(if-not path-is-file (:close f))
|
(if-not path-is-file (:close f))
|
||||||
(when exit-error
|
(when exit-error
|
||||||
(if exit-fiber
|
(if exit-fiber
|
||||||
@@ -2964,7 +3026,7 @@
|
|||||||
:italics ["*" "*"]
|
:italics ["*" "*"]
|
||||||
:bold ["**" "**"]}))
|
:bold ["**" "**"]}))
|
||||||
(def modes @{})
|
(def modes @{})
|
||||||
(defn toggle [mode]
|
(defn toggle-mode [mode]
|
||||||
(def active (get modes mode))
|
(def active (get modes mode))
|
||||||
(def delims (get delimiters mode))
|
(def delims (get delimiters mode))
|
||||||
(put modes mode (not active))
|
(put modes mode (not active))
|
||||||
@@ -2972,7 +3034,7 @@
|
|||||||
|
|
||||||
# Parse state
|
# Parse state
|
||||||
(var cursor 0) # indexes into string for parsing
|
(var cursor 0) # indexes into string for parsing
|
||||||
(var stack @[]) # return value for this block.
|
(var stack @[]) # return value for this block.
|
||||||
|
|
||||||
# Traversal helpers
|
# Traversal helpers
|
||||||
(defn c [] (get str cursor))
|
(defn c [] (get str cursor))
|
||||||
@@ -3074,7 +3136,7 @@
|
|||||||
(def token @"")
|
(def token @"")
|
||||||
(var token-length 0)
|
(var token-length 0)
|
||||||
(defn delim [mode]
|
(defn delim [mode]
|
||||||
(def d (toggle mode))
|
(def d (toggle-mode mode))
|
||||||
(if-not has-color (+= token-length (length d)))
|
(if-not has-color (+= token-length (length d)))
|
||||||
(buffer/push token d))
|
(buffer/push token d))
|
||||||
(defn endtoken []
|
(defn endtoken []
|
||||||
@@ -3085,44 +3147,48 @@
|
|||||||
(def b (get line i))
|
(def b (get line i))
|
||||||
(cond
|
(cond
|
||||||
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
|
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
|
||||||
(= b (chr `\`)) (do
|
|
||||||
(++ token-length)
|
|
||||||
(buffer/push token (get line (++ i))))
|
|
||||||
(= b (chr "_")) (delim :underline)
|
|
||||||
(= b (chr "`")) (delim :code)
|
(= b (chr "`")) (delim :code)
|
||||||
(= b (chr "*"))
|
(not (modes :code)) (cond
|
||||||
(if (= (chr "*") (get line (+ i 1)))
|
(= b (chr `\`)) (do
|
||||||
(do (++ i)
|
(++ token-length)
|
||||||
(delim :bold))
|
(buffer/push token (get line (++ i))))
|
||||||
(delim :italics))
|
(= b (chr "_")) (delim :underline)
|
||||||
|
(= b (chr "*"))
|
||||||
|
(if (= (chr "*") (get line (+ i 1)))
|
||||||
|
(do (++ i)
|
||||||
|
(delim :bold))
|
||||||
|
(delim :italics))
|
||||||
|
(do (++ token-length) (buffer/push token b)))
|
||||||
(do (++ token-length) (buffer/push token b))))
|
(do (++ token-length) (buffer/push token b))))
|
||||||
(endtoken)
|
(endtoken)
|
||||||
(tuple/slice tokens))
|
(tuple/slice tokens))
|
||||||
|
|
||||||
(set parse-blocks (fn parse-blocks [indent]
|
(set
|
||||||
(var new-indent indent)
|
parse-blocks
|
||||||
(var p-start nil)
|
(fn parse-blocks [indent]
|
||||||
(var p-end nil)
|
(var new-indent indent)
|
||||||
(defn p-line []
|
(var p-start nil)
|
||||||
(unless p-start
|
(var p-end nil)
|
||||||
(set p-start cursor))
|
(defn p-line []
|
||||||
(skipline)
|
(unless p-start
|
||||||
(set p-end cursor)
|
(set p-start cursor))
|
||||||
(set new-indent (skipwhite)))
|
(skipline)
|
||||||
(defn finish-p []
|
(set p-end cursor)
|
||||||
(when (and p-start (> p-end p-start))
|
(set new-indent (skipwhite)))
|
||||||
(push (tokenize-line (getslice p-start p-end)))
|
(defn finish-p []
|
||||||
(set p-start nil)))
|
(when (and p-start (> p-end p-start))
|
||||||
(while (and (c) (>= new-indent indent))
|
(push (tokenize-line (getslice p-start p-end)))
|
||||||
(cond
|
(set p-start nil)))
|
||||||
(nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
|
(while (and (c) (>= new-indent indent))
|
||||||
(ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
|
(cond
|
||||||
(ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
|
(nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
|
||||||
(fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
|
(ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
|
||||||
(>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
|
(ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
|
||||||
(p-line)))
|
(fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
|
||||||
(finish-p)
|
(>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
|
||||||
new-indent))
|
(p-line)))
|
||||||
|
(finish-p)
|
||||||
|
new-indent))
|
||||||
|
|
||||||
# Handle first line specially for defn, defmacro, etc.
|
# Handle first line specially for defn, defmacro, etc.
|
||||||
(when (= (chr "(") (in str 0))
|
(when (= (chr "(") (in str 0))
|
||||||
@@ -3259,10 +3325,10 @@
|
|||||||
(do
|
(do
|
||||||
(def [fullpath mod-kind] (module/find (string sym)))
|
(def [fullpath mod-kind] (module/find (string sym)))
|
||||||
(if-let [mod-env (in module/cache fullpath)]
|
(if-let [mod-env (in module/cache fullpath)]
|
||||||
(print-module-entry {:module true
|
(print-module-entry {:module true
|
||||||
:kind mod-kind
|
:kind mod-kind
|
||||||
:source-map [fullpath nil nil]
|
:source-map [fullpath nil nil]
|
||||||
:doc (in mod-env :doc)})
|
:doc (in mod-env :doc)})
|
||||||
(print "symbol " sym " not found."))))
|
(print "symbol " sym " not found."))))
|
||||||
(print-module-entry x)))
|
(print-module-entry x)))
|
||||||
|
|
||||||
@@ -3362,25 +3428,26 @@
|
|||||||
(def pc (frame :pc))
|
(def pc (frame :pc))
|
||||||
(def sourcemap (in dasm :sourcemap))
|
(def sourcemap (in dasm :sourcemap))
|
||||||
(var last-loc [-2 -2])
|
(var last-loc [-2 -2])
|
||||||
(print "\n signal: " (.signal))
|
(eprint "\n signal: " (.signal))
|
||||||
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
|
(eprint " status: " (fiber/status (.fiber)))
|
||||||
|
(eprint " function: " (get dasm :name "<anonymous>") " [" (in dasm :source "") "]")
|
||||||
(when-let [constants (dasm :constants)]
|
(when-let [constants (dasm :constants)]
|
||||||
(printf " constants: %.4q" constants))
|
(eprintf " constants: %.4q" constants))
|
||||||
(printf " slots: %.4q\n" (frame :slots))
|
(eprintf " slots: %.4q\n" (frame :slots))
|
||||||
(def padding (string/repeat " " 20))
|
(def padding (string/repeat " " 20))
|
||||||
(loop [i :range [0 (length bytecode)]
|
(loop [i :range [0 (length bytecode)]
|
||||||
:let [instr (bytecode i)]]
|
:let [instr (bytecode i)]]
|
||||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
(eprin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||||
(prin (if (= i pc) "> " " "))
|
(eprin (if (= i pc) "> " " "))
|
||||||
(prinf "%.20s" (string (string/join (map string instr) " ") padding))
|
(eprinf "%.20s" (string (string/join (map string instr) " ") padding))
|
||||||
(when sourcemap
|
(when sourcemap
|
||||||
(let [[sl sc] (sourcemap i)
|
(let [[sl sc] (sourcemap i)
|
||||||
loc [sl sc]]
|
loc [sl sc]]
|
||||||
(when (not= loc last-loc)
|
(when (not= loc last-loc)
|
||||||
(set last-loc loc)
|
(set last-loc loc)
|
||||||
(prin " # line " sl ", column " sc))))
|
(eprin " # line " sl ", column " sc))))
|
||||||
(print))
|
(eprint))
|
||||||
(print))
|
(eprint))
|
||||||
|
|
||||||
(defn .breakall
|
(defn .breakall
|
||||||
"Set breakpoints on all instructions in the current function."
|
"Set breakpoints on all instructions in the current function."
|
||||||
@@ -3389,7 +3456,7 @@
|
|||||||
(def bytecode (.bytecode n))
|
(def bytecode (.bytecode n))
|
||||||
(forv i 0 (length bytecode)
|
(forv i 0 (length bytecode)
|
||||||
(debug/fbreak fun i))
|
(debug/fbreak fun i))
|
||||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
(eprint "set " (length bytecode) " breakpoints in " fun))
|
||||||
|
|
||||||
(defn .clearall
|
(defn .clearall
|
||||||
"Clear all breakpoints on the current function."
|
"Clear all breakpoints on the current function."
|
||||||
@@ -3398,7 +3465,7 @@
|
|||||||
(def bytecode (.bytecode n))
|
(def bytecode (.bytecode n))
|
||||||
(forv i 0 (length bytecode)
|
(forv i 0 (length bytecode)
|
||||||
(debug/unfbreak fun i))
|
(debug/unfbreak fun i))
|
||||||
(print "Cleared " (length bytecode) " breakpoints in " fun)))
|
(eprint "cleared " (length bytecode) " breakpoints in " fun)))
|
||||||
|
|
||||||
(defn .source
|
(defn .source
|
||||||
"Show the source code for the function being debugged."
|
"Show the source code for the function being debugged."
|
||||||
@@ -3406,7 +3473,7 @@
|
|||||||
(def frame (.frame n))
|
(def frame (.frame n))
|
||||||
(def s (frame :source))
|
(def s (frame :source))
|
||||||
(def all-source (slurp s))
|
(def all-source (slurp s))
|
||||||
(print "\n" all-source "\n"))
|
(eprint "\n" all-source "\n"))
|
||||||
|
|
||||||
(defn .break
|
(defn .break
|
||||||
"Set breakpoint at the current pc."
|
"Set breakpoint at the current pc."
|
||||||
@@ -3415,7 +3482,7 @@
|
|||||||
(def fun (frame :function))
|
(def fun (frame :function))
|
||||||
(def pc (frame :pc))
|
(def pc (frame :pc))
|
||||||
(debug/fbreak fun pc)
|
(debug/fbreak fun pc)
|
||||||
(print "Set breakpoint in " fun " at pc=" pc))
|
(eprint "set breakpoint in " fun " at pc=" pc))
|
||||||
|
|
||||||
(defn .clear
|
(defn .clear
|
||||||
"Clear the current breakpoint."
|
"Clear the current breakpoint."
|
||||||
@@ -3424,7 +3491,7 @@
|
|||||||
(def fun (frame :function))
|
(def fun (frame :function))
|
||||||
(def pc (frame :pc))
|
(def pc (frame :pc))
|
||||||
(debug/unfbreak fun pc)
|
(debug/unfbreak fun pc)
|
||||||
(print "Cleared breakpoint in " fun " at pc=" pc))
|
(eprint "cleared breakpoint in " fun " at pc=" pc))
|
||||||
|
|
||||||
(defn .next
|
(defn .next
|
||||||
"Go to the next breakpoint."
|
"Go to the next breakpoint."
|
||||||
@@ -3448,10 +3515,6 @@
|
|||||||
(set res (debug/step (.fiber))))
|
(set res (debug/step (.fiber))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(def debugger-env
|
|
||||||
"An environment that contains dot prefixed functions for debugging."
|
|
||||||
@{})
|
|
||||||
|
|
||||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
|
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
|
||||||
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
|
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
|
||||||
|
|
||||||
@@ -3479,43 +3542,9 @@
|
|||||||
":"
|
":"
|
||||||
(:state p :delimiters) "> ")
|
(:state p :delimiters) "> ")
|
||||||
buf env)))
|
buf env)))
|
||||||
(defn make-onsignal
|
|
||||||
[e level]
|
|
||||||
|
|
||||||
(defn enter-debugger
|
|
||||||
[f x]
|
|
||||||
(def nextenv (make-env env))
|
|
||||||
(put nextenv :fiber f)
|
|
||||||
(put nextenv :debug-level level)
|
|
||||||
(put nextenv :signal x)
|
|
||||||
(merge-into nextenv debugger-env)
|
|
||||||
(defn debugger-chunks [buf p]
|
|
||||||
(def status (:state p :delimiters))
|
|
||||||
(def c ((:where p) 0))
|
|
||||||
(def prpt (string "debug[" level "]:" c ":" status "> "))
|
|
||||||
(getline prpt buf nextenv))
|
|
||||||
(print "entering debug[" level "] - (quit) to exit")
|
|
||||||
(flush)
|
|
||||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
|
||||||
(print "exiting debug[" level "]")
|
|
||||||
(flush)
|
|
||||||
(nextenv :resume-value))
|
|
||||||
|
|
||||||
(fn [f x]
|
|
||||||
(def fs (fiber/status f))
|
|
||||||
(if (= :dead fs)
|
|
||||||
(do
|
|
||||||
(put e '_ @{:value x})
|
|
||||||
(printf (get e :pretty-format "%q") x)
|
|
||||||
(flush))
|
|
||||||
(do
|
|
||||||
(debug/stacktrace f x "")
|
|
||||||
(eflush)
|
|
||||||
(if (e :debug) (enter-debugger f x))))))
|
|
||||||
|
|
||||||
(run-context {:env env
|
(run-context {:env env
|
||||||
:chunks chunks
|
:chunks chunks
|
||||||
:on-status (or onsignal (make-onsignal env 1))
|
:on-status (or onsignal (debugger-on-status env 1 true))
|
||||||
:parser parser
|
:parser parser
|
||||||
:read read
|
:read read
|
||||||
:source :repl}))
|
:source :repl}))
|
||||||
@@ -3539,7 +3568,7 @@
|
|||||||
(ev/go (fn _call [&] (f ;args))))
|
(ev/go (fn _call [&] (f ;args))))
|
||||||
|
|
||||||
(defmacro ev/spawn
|
(defmacro ev/spawn
|
||||||
"Run some code in a new fiber. This is shorthand for `(ev/call (fn [] ;body))`."
|
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/go (fn _spawn [&] ,;body)))
|
~(,ev/go (fn _spawn [&] ,;body)))
|
||||||
|
|
||||||
@@ -3582,8 +3611,8 @@
|
|||||||
(def ,chan (,ev/chan))
|
(def ,chan (,ev/chan))
|
||||||
(def ,res @[])
|
(def ,res @[])
|
||||||
(,wait-for-fibers ,chan
|
(,wait-for-fibers ,chan
|
||||||
,(seq [[i body] :pairs bodies]
|
,(seq [[i body] :pairs bodies]
|
||||||
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
|
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
|
||||||
,res))))
|
,res))))
|
||||||
|
|
||||||
(compwhen (dyn 'net/listen)
|
(compwhen (dyn 'net/listen)
|
||||||
@@ -3595,6 +3624,75 @@
|
|||||||
(ev/call (fn [] (net/accept-loop s handler))))
|
(ev/call (fn [] (net/accept-loop s handler))))
|
||||||
s))
|
s))
|
||||||
|
|
||||||
|
###
|
||||||
|
###
|
||||||
|
### FFI Extra
|
||||||
|
###
|
||||||
|
###
|
||||||
|
|
||||||
|
(defmacro delay
|
||||||
|
"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."
|
||||||
|
[& forms]
|
||||||
|
(def state (gensym))
|
||||||
|
(def loaded (gensym))
|
||||||
|
~((fn []
|
||||||
|
(var ,state nil)
|
||||||
|
(var ,loaded nil)
|
||||||
|
(fn []
|
||||||
|
(if ,loaded
|
||||||
|
,state
|
||||||
|
(do
|
||||||
|
(set ,loaded true)
|
||||||
|
(set ,state (do ,;forms))))))))
|
||||||
|
|
||||||
|
(compwhen (dyn 'ffi/native)
|
||||||
|
|
||||||
|
(defdyn *ffi-context* " Current native library for ffi/bind and other settings")
|
||||||
|
|
||||||
|
(defn- default-mangle
|
||||||
|
[name &]
|
||||||
|
(string/replace-all "-" "_" name))
|
||||||
|
|
||||||
|
(defn ffi/context
|
||||||
|
"Set the path of the dynamic library to implictly bind, as well
|
||||||
|
as other global state for ease of creating native bindings."
|
||||||
|
[&opt native-path &named map-symbols lazy]
|
||||||
|
(default map-symbols default-mangle)
|
||||||
|
(def lib (if lazy nil (ffi/native native-path)))
|
||||||
|
(def lazy-lib (if lazy (delay (ffi/native native-path))))
|
||||||
|
(setdyn *ffi-context*
|
||||||
|
@{:native-path native-path
|
||||||
|
:native lib
|
||||||
|
:native-lazy lazy-lib
|
||||||
|
:lazy lazy
|
||||||
|
:map-symbols map-symbols}))
|
||||||
|
|
||||||
|
(defmacro ffi/defbind
|
||||||
|
"Generate bindings for native functions in a convenient manner."
|
||||||
|
[name ret-type & body]
|
||||||
|
(def real-ret-type (eval ret-type))
|
||||||
|
(def meta (slice body 0 -2))
|
||||||
|
(def arg-pairs (partition 2 (last body)))
|
||||||
|
(def formal-args (map 0 arg-pairs))
|
||||||
|
(def type-args (map 1 arg-pairs))
|
||||||
|
(def computed-type-args (eval ~[,;type-args]))
|
||||||
|
(def {:native lib
|
||||||
|
:lazy lazy
|
||||||
|
:native-lazy llib
|
||||||
|
:map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found"))
|
||||||
|
(def raw-symbol (ms name))
|
||||||
|
(defn make-sig []
|
||||||
|
(ffi/signature :default real-ret-type ;computed-type-args))
|
||||||
|
(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]
|
||||||
|
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||||
|
~(defn ,name ,;meta [,;formal-args]
|
||||||
|
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### Flychecking
|
### Flychecking
|
||||||
@@ -3665,7 +3763,7 @@
|
|||||||
(try
|
(try
|
||||||
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
|
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
|
||||||
([e f]
|
([e f]
|
||||||
(debug/stacktrace f e "")))
|
(debug/stacktrace f e "")))
|
||||||
(table/clear module/cache)
|
(table/clear module/cache)
|
||||||
(merge-into module/cache old-modcache)
|
(merge-into module/cache old-modcache)
|
||||||
nil)
|
nil)
|
||||||
@@ -3682,10 +3780,18 @@
|
|||||||
|
|
||||||
(defn- run-main
|
(defn- run-main
|
||||||
[env subargs arg]
|
[env subargs arg]
|
||||||
(if-let [entry (in env 'main)
|
(when-let [entry (in env 'main)
|
||||||
main (or (get entry :value) (in (get entry :ref) 0))]
|
main (or (get entry :value) (in (get entry :ref) 0))]
|
||||||
(let [thunk (compile [main ;subargs] env arg)]
|
(def guard (if (get env :debug) :ydt :y))
|
||||||
(if (function? thunk) (thunk) (error (thunk :error))))))
|
(defn wrap-main [&]
|
||||||
|
(main ;subargs))
|
||||||
|
(def f (fiber/new wrap-main guard))
|
||||||
|
(fiber/setenv f env)
|
||||||
|
(var res nil)
|
||||||
|
(while (fiber/can-resume? f)
|
||||||
|
(set res (resume f res))
|
||||||
|
(when (not= :dead (fiber/status f))
|
||||||
|
((debugger-on-status env) f res)))))
|
||||||
|
|
||||||
(defdyn *args*
|
(defdyn *args*
|
||||||
"Dynamic bindings that will contain command line arguments at program start.")
|
"Dynamic bindings that will contain command line arguments at program start.")
|
||||||
@@ -3781,7 +3887,7 @@
|
|||||||
"E" (fn E-switch [i &]
|
"E" (fn E-switch [i &]
|
||||||
(set no-file false)
|
(set no-file false)
|
||||||
(def subargs (array/slice args (+ i 2)))
|
(def subargs (array/slice args (+ i 2)))
|
||||||
(def src ~|,(parse (in args (+ i 1))))
|
(def src ~(short-fn ,(parse (in args (+ i 1))) E-expression))
|
||||||
(def thunk (compile src))
|
(def thunk (compile src))
|
||||||
(if (function? thunk)
|
(if (function? thunk)
|
||||||
((thunk) ;subargs)
|
((thunk) ;subargs)
|
||||||
@@ -3847,8 +3953,8 @@
|
|||||||
(file/read stdin :line buf))
|
(file/read stdin :line buf))
|
||||||
(def env (make-env))
|
(def env (make-env))
|
||||||
(when-let [profile.janet (dyn *profilepath*)]
|
(when-let [profile.janet (dyn *profilepath*)]
|
||||||
(def new-env (dofile profile.janet :exit true))
|
(def new-env (dofile profile.janet :exit true))
|
||||||
(merge-module env new-env "" false))
|
(merge-module env new-env "" false))
|
||||||
(when debug-flag
|
(when debug-flag
|
||||||
(put env *debug* true)
|
(put env *debug* true)
|
||||||
(put env *redef* true))
|
(put env *redef* true))
|
||||||
@@ -3870,10 +3976,6 @@
|
|||||||
|
|
||||||
(do
|
(do
|
||||||
|
|
||||||
# Deprecate file/popen
|
|
||||||
(when-let [v (get root-env 'file/popen)]
|
|
||||||
(put v :deprecated true))
|
|
||||||
|
|
||||||
# Modify root-env to remove private symbols and
|
# Modify root-env to remove private symbols and
|
||||||
# flatten nested tables.
|
# flatten nested tables.
|
||||||
(loop [[k v] :in (pairs root-env)
|
(loop [[k v] :in (pairs root-env)
|
||||||
@@ -3938,6 +4040,7 @@
|
|||||||
"src/core/debug.c"
|
"src/core/debug.c"
|
||||||
"src/core/emit.c"
|
"src/core/emit.c"
|
||||||
"src/core/ev.c"
|
"src/core/ev.c"
|
||||||
|
"src/core/ffi.c"
|
||||||
"src/core/fiber.c"
|
"src/core/fiber.c"
|
||||||
"src/core/gc.c"
|
"src/core/gc.c"
|
||||||
"src/core/inttypes.c"
|
"src/core/inttypes.c"
|
||||||
|
|||||||
@@ -4,10 +4,10 @@
|
|||||||
#define JANETCONF_H
|
#define JANETCONF_H
|
||||||
|
|
||||||
#define JANET_VERSION_MAJOR 1
|
#define JANET_VERSION_MAJOR 1
|
||||||
#define JANET_VERSION_MINOR 22
|
#define JANET_VERSION_MINOR 25
|
||||||
#define JANET_VERSION_PATCH 1
|
#define JANET_VERSION_PATCH 0
|
||||||
#define JANET_VERSION_EXTRA "-dev"
|
#define JANET_VERSION_EXTRA ""
|
||||||
#define JANET_VERSION "1.22.1-dev"
|
#define JANET_VERSION "1.25.0"
|
||||||
|
|
||||||
/* #define JANET_BUILD "local" */
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
|
|||||||
@@ -23,14 +23,16 @@
|
|||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include "features.h"
|
#include "features.h"
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
||||||
@@ -85,6 +87,14 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
|||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
|
||||||
|
size_t janet_os_mutex_size(void) {
|
||||||
|
return sizeof(CRITICAL_SECTION);
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t janet_os_rwlock_size(void) {
|
||||||
|
return sizeof(void *);
|
||||||
|
}
|
||||||
|
|
||||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||||
}
|
}
|
||||||
@@ -137,6 +147,14 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
|||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
|
size_t janet_os_mutex_size(void) {
|
||||||
|
return sizeof(pthread_mutex_t);
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t janet_os_rwlock_size(void) {
|
||||||
|
return sizeof(pthread_rwlock_t);
|
||||||
|
}
|
||||||
|
|
||||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||||
}
|
}
|
||||||
@@ -149,44 +167,44 @@ void janet_os_mutex_init(JanetOSMutex *mutex) {
|
|||||||
pthread_mutexattr_t attr;
|
pthread_mutexattr_t attr;
|
||||||
pthread_mutexattr_init(&attr);
|
pthread_mutexattr_init(&attr);
|
||||||
pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
||||||
pthread_mutex_init(mutex, &attr);
|
pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
||||||
pthread_mutex_destroy(mutex);
|
pthread_mutex_destroy((pthread_mutex_t *) mutex);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||||
pthread_mutex_lock(mutex);
|
pthread_mutex_lock((pthread_mutex_t *) mutex);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||||
int ret = pthread_mutex_unlock(mutex);
|
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
||||||
if (ret) janet_panic("cannot release lock");
|
if (ret) janet_panic("cannot release lock");
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_init(rwlock, NULL);
|
pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_destroy(rwlock);
|
pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_rdlock(rwlock);
|
pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_wrlock(rwlock);
|
pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_unlock(rwlock);
|
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
||||||
pthread_rwlock_unlock(rwlock);
|
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -553,6 +553,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
|
||||||
|
/* Check structarg */
|
||||||
|
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||||
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get1(s, janet_ckeywordv("source"));
|
x = janet_get1(s, janet_ckeywordv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
@@ -884,6 +888,10 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
|||||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet janet_disasm_structarg(JanetFuncDef *def) {
|
||||||
|
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
||||||
|
}
|
||||||
|
|
||||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||||
JanetArray *constants = janet_array(def->constants_length);
|
JanetArray *constants = janet_array(def->constants_length);
|
||||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||||
@@ -933,6 +941,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||||
|
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||||
@@ -986,6 +995,7 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
||||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||||
|
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
||||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||||
|
|||||||
@@ -260,11 +260,27 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
return janet_unwrap_s64(argv[n]);
|
||||||
|
#else
|
||||||
Janet x = argv[n];
|
Janet x = argv[n];
|
||||||
if (!janet_checkint64(x)) {
|
if (!janet_checkint64(x)) {
|
||||||
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
||||||
}
|
}
|
||||||
return (int64_t) janet_unwrap_number(x);
|
return (int64_t) janet_unwrap_number(x);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
return janet_unwrap_u64(argv[n]);
|
||||||
|
#else
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checkint64(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
||||||
|
}
|
||||||
|
return (uint64_t) janet_unwrap_number(x);
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
size_t janet_getsize(const Janet *argv, int32_t n) {
|
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||||
|
|||||||
@@ -996,7 +996,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* C Function for compiling */
|
/* C Function for compiling */
|
||||||
JANET_CORE_FN(cfun,
|
JANET_CORE_FN(cfun_compile,
|
||||||
"(compile ast &opt env source lints)",
|
"(compile ast &opt env source lints)",
|
||||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||||
"Pair the compile function with parsing functionality to implement "
|
"Pair the compile function with parsing functionality to implement "
|
||||||
@@ -1043,7 +1043,7 @@ JANET_CORE_FN(cfun,
|
|||||||
|
|
||||||
void janet_lib_compile(JanetTable *env) {
|
void janet_lib_compile(JanetTable *env) {
|
||||||
JanetRegExt cfuns[] = {
|
JanetRegExt cfuns[] = {
|
||||||
JANET_CORE_REG("compile", cfun),
|
JANET_CORE_REG("compile", cfun_compile),
|
||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||||
|
|||||||
@@ -42,51 +42,6 @@ extern size_t janet_core_image_size;
|
|||||||
#define JDOC(x) NULL
|
#define JDOC(x) NULL
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
|
||||||
* with native code. */
|
|
||||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
|
||||||
typedef int Clib;
|
|
||||||
#define load_clib(name) ((void) name, 0)
|
|
||||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
|
||||||
#define error_clib() "dynamic libraries not supported"
|
|
||||||
#elif defined(JANET_WINDOWS)
|
|
||||||
#include <windows.h>
|
|
||||||
typedef HINSTANCE Clib;
|
|
||||||
#define load_clib(name) LoadLibrary((name))
|
|
||||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
|
||||||
static char error_clib_buf[256];
|
|
||||||
static char *error_clib(void) {
|
|
||||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
|
||||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
|
||||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
|
||||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
|
||||||
return error_clib_buf;
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
#include <dlfcn.h>
|
|
||||||
typedef void *Clib;
|
|
||||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
|
||||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
|
||||||
#define error_clib() dlerror()
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static char *get_processed_name(const char *name) {
|
|
||||||
if (name[0] == '.') return (char *) name;
|
|
||||||
const char *c;
|
|
||||||
for (c = name; *c; c++) {
|
|
||||||
if (*c == '/') return (char *) name;
|
|
||||||
}
|
|
||||||
size_t l = (size_t)(c - name);
|
|
||||||
char *ret = janet_malloc(l + 3);
|
|
||||||
if (NULL == ret) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
ret[0] = '.';
|
|
||||||
ret[1] = '/';
|
|
||||||
memcpy(ret + 2, name, l + 1);
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||||
char *processed_name = get_processed_name(name);
|
char *processed_name = get_processed_name(name);
|
||||||
Clib lib = load_clib(processed_name);
|
Clib lib = load_clib(processed_name);
|
||||||
@@ -659,27 +614,22 @@ JANET_CORE_FN(janet_core_signal,
|
|||||||
"(signal what x)",
|
"(signal what x)",
|
||||||
"Raise a signal with payload x. ") {
|
"Raise a signal with payload x. ") {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
int sig;
|
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||||
if (janet_checkint(argv[0])) {
|
if (janet_checkint(argv[0])) {
|
||||||
int32_t s = janet_unwrap_integer(argv[0]);
|
int32_t s = janet_unwrap_integer(argv[0]);
|
||||||
if (s < 0 || s > 9) {
|
if (s < 0 || s > 9) {
|
||||||
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
||||||
}
|
}
|
||||||
sig = JANET_SIGNAL_USER0 + s;
|
janet_signalv(JANET_SIGNAL_USER0 + s, payload);
|
||||||
} else {
|
} else {
|
||||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||||
if (!janet_cstrcmp(kw, "yield")) {
|
for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
|
||||||
sig = JANET_SIGNAL_YIELD;
|
if (!janet_cstrcmp(kw, janet_signal_names[i])) {
|
||||||
} else if (!janet_cstrcmp(kw, "error")) {
|
janet_signalv((JanetSignal) i, payload);
|
||||||
sig = JANET_SIGNAL_ERROR;
|
}
|
||||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
|
||||||
sig = JANET_SIGNAL_DEBUG;
|
|
||||||
} else {
|
|
||||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
janet_panicf("unknown signal %v", argv[0]);
|
||||||
janet_signalv(sig, payload);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
@@ -1016,6 +966,9 @@ static void janet_load_libs(JanetTable *env) {
|
|||||||
#ifdef JANET_NET
|
#ifdef JANET_NET
|
||||||
janet_lib_net(env);
|
janet_lib_net(env);
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef JANET_FFI
|
||||||
|
janet_lib_ffi(env);
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
|
|||||||
127
src/core/ev.c
127
src/core/ev.c
@@ -79,7 +79,11 @@ typedef struct {
|
|||||||
int32_t limit;
|
int32_t limit;
|
||||||
int closed;
|
int closed;
|
||||||
int is_threaded;
|
int is_threaded;
|
||||||
JanetOSMutex lock;
|
#ifdef JANET_WINDOWS
|
||||||
|
CRITICAL_SECTION lock;
|
||||||
|
#else
|
||||||
|
pthread_mutex_t lock;
|
||||||
|
#endif
|
||||||
} JanetChannel;
|
} JanetChannel;
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
@@ -531,10 +535,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
|
|||||||
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
|
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
|
||||||
|
|
||||||
static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
|
static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
|
||||||
Janet tup[2];
|
Janet tup[3];
|
||||||
tup[0] = janet_ckeywordv(name);
|
tup[0] = janet_ckeywordv(name);
|
||||||
tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
|
tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
|
||||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
if (fiber->env != NULL) {
|
||||||
|
tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id"));
|
||||||
|
} else {
|
||||||
|
tup[2] = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
return janet_wrap_tuple(janet_tuple_n(tup, 3));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Common init code */
|
/* Common init code */
|
||||||
@@ -643,7 +652,7 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) {
|
|||||||
janet_q_init(&chan->items);
|
janet_q_init(&chan->items);
|
||||||
janet_q_init(&chan->read_pending);
|
janet_q_init(&chan->read_pending);
|
||||||
janet_q_init(&chan->write_pending);
|
janet_q_init(&chan->write_pending);
|
||||||
janet_os_mutex_init(&chan->lock);
|
janet_os_mutex_init((JanetOSMutex *) &chan->lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_chan_deinit(JanetChannel *chan) {
|
static void janet_chan_deinit(JanetChannel *chan) {
|
||||||
@@ -656,17 +665,17 @@ static void janet_chan_deinit(JanetChannel *chan) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_q_deinit(&chan->items);
|
janet_q_deinit(&chan->items);
|
||||||
janet_os_mutex_deinit(&chan->lock);
|
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_chan_lock(JanetChannel *chan) {
|
static void janet_chan_lock(JanetChannel *chan) {
|
||||||
if (!janet_chan_is_threaded(chan)) return;
|
if (!janet_chan_is_threaded(chan)) return;
|
||||||
janet_os_mutex_lock(&chan->lock);
|
janet_os_mutex_lock((JanetOSMutex *) &chan->lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_chan_unlock(JanetChannel *chan) {
|
static void janet_chan_unlock(JanetChannel *chan) {
|
||||||
if (!janet_chan_is_threaded(chan)) return;
|
if (!janet_chan_is_threaded(chan)) return;
|
||||||
janet_os_mutex_unlock(&chan->lock);
|
janet_os_mutex_unlock((JanetOSMutex *) &chan->lock);
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@@ -2678,9 +2687,10 @@ error:
|
|||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_ev_go,
|
JANET_CORE_FN(cfun_ev_go,
|
||||||
"(ev/go fiber &opt value supervisor)",
|
"(ev/go fiber-or-fun &opt value supervisor)",
|
||||||
"Put a fiber on the event loop to be resumed later. Optionally pass "
|
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped"
|
||||||
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
"with `fiber/new` first. "
|
||||||
|
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||||
"An optional `core/channel` can be provided as a supervisor. When various "
|
"An optional `core/channel` can be provided as a supervisor. When various "
|
||||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
||||||
"If not provided, the new fiber will inherit the current supervisor.") {
|
"If not provided, the new fiber will inherit the current supervisor.") {
|
||||||
@@ -2715,6 +2725,8 @@ JANET_CORE_FN(cfun_ev_go,
|
|||||||
return janet_wrap_fiber(fiber);
|
return janet_wrap_fiber(fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#define JANET_THREAD_SUPERVISOR_FLAG 0x100
|
||||||
|
|
||||||
/* For ev/thread - Run an interpreter in the new thread. */
|
/* For ev/thread - Run an interpreter in the new thread. */
|
||||||
static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||||
JanetBuffer *buffer = (JanetBuffer *) args.argp;
|
JanetBuffer *buffer = (JanetBuffer *) args.argp;
|
||||||
@@ -2737,7 +2749,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Get supervsior */
|
/* Get supervsior */
|
||||||
if (flags & 0x8) {
|
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||||
Janet sup =
|
Janet sup =
|
||||||
janet_unmarshal(nextbytes, endbytes - nextbytes,
|
janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||||
@@ -2789,6 +2801,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
|||||||
} else {
|
} else {
|
||||||
fiber = janet_unwrap_fiber(fiberv);
|
fiber = janet_unwrap_fiber(fiberv);
|
||||||
}
|
}
|
||||||
|
if (flags & 0x8) {
|
||||||
|
if (NULL == fiber->env) fiber->env = janet_table(0);
|
||||||
|
janet_table_put(fiber->env, janet_ckeywordv("task-id"), value);
|
||||||
|
}
|
||||||
fiber->supervisor_channel = janet_vm.user;
|
fiber->supervisor_channel = janet_vm.user;
|
||||||
janet_schedule(fiber, value);
|
janet_schedule(fiber, value);
|
||||||
janet_loop();
|
janet_loop();
|
||||||
@@ -2833,6 +2849,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
|||||||
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
|
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
|
||||||
"Otherwise, returns nil. Available flags:\n\n"
|
"Otherwise, returns nil. Available flags:\n\n"
|
||||||
"* `:n` - return immediately\n"
|
"* `:n` - return immediately\n"
|
||||||
|
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
||||||
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
||||||
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
||||||
janet_arity(argc, 1, 4);
|
janet_arity(argc, 1, 4);
|
||||||
@@ -2840,10 +2857,10 @@ JANET_CORE_FN(cfun_ev_thread,
|
|||||||
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
||||||
uint64_t flags = 0;
|
uint64_t flags = 0;
|
||||||
if (argc >= 3) {
|
if (argc >= 3) {
|
||||||
flags = janet_getflags(argv, 2, "nac");
|
flags = janet_getflags(argv, 2, "nact");
|
||||||
}
|
}
|
||||||
void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
||||||
if (NULL != supervisor) flags |= 0x8;
|
if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG;
|
||||||
|
|
||||||
/* Marshal arguments for the new thread. */
|
/* Marshal arguments for the new thread. */
|
||||||
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
||||||
@@ -2854,7 +2871,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
|||||||
if (!(flags & 0x2)) {
|
if (!(flags & 0x2)) {
|
||||||
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
|
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
|
||||||
}
|
}
|
||||||
if (flags & 0x8) {
|
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||||
janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
|
janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
|
||||||
}
|
}
|
||||||
if (!(flags & 0x4)) {
|
if (!(flags & 0x4)) {
|
||||||
@@ -3013,14 +3030,9 @@ JANET_CORE_FN(janet_cfun_stream_write,
|
|||||||
janet_await();
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
JanetOSMutex mutex;
|
|
||||||
} JanetAbstractMutex;
|
|
||||||
|
|
||||||
static int mutexgc(void *p, size_t size) {
|
static int mutexgc(void *p, size_t size) {
|
||||||
JanetAbstractMutex *mutex = (JanetAbstractMutex *) p;
|
|
||||||
(void) size;
|
(void) size;
|
||||||
janet_os_mutex_deinit(&mutex->mutex);
|
janet_os_mutex_deinit(p);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -3031,43 +3043,38 @@ const JanetAbstractType janet_mutex_type = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_mutex,
|
JANET_CORE_FN(janet_cfun_mutex,
|
||||||
"(ev/lock)",
|
"(ev/lock)",
|
||||||
"Create a new lock to coordinate threads.") {
|
"Create a new lock to coordinate threads.") {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
JanetAbstractMutex *mutex = janet_abstract_threaded(&janet_mutex_type, sizeof(JanetAbstractMutex));
|
void *mutex = janet_abstract_threaded(&janet_mutex_type, janet_os_mutex_size());
|
||||||
janet_os_mutex_init(&mutex->mutex);
|
janet_os_mutex_init(mutex);
|
||||||
return janet_wrap_abstract(mutex);
|
return janet_wrap_abstract(mutex);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_mutex_acquire,
|
JANET_CORE_FN(janet_cfun_mutex_acquire,
|
||||||
"(ev/acquire-lock lock)",
|
"(ev/acquire-lock lock)",
|
||||||
"Acquire a lock such that this operating system thread is the only thread with access to this resource."
|
"Acquire a lock such that this operating system thread is the only thread with access to this resource."
|
||||||
" This will block this entire thread until the lock becomes available, and will not yield to other fibers "
|
" This will block this entire thread until the lock becomes available, and will not yield to other fibers "
|
||||||
"on this system thread.") {
|
"on this system thread.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractMutex *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||||
janet_os_mutex_lock(&mutex->mutex);
|
janet_os_mutex_lock(mutex);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_mutex_release,
|
JANET_CORE_FN(janet_cfun_mutex_release,
|
||||||
"(ev/release-lock lock)",
|
"(ev/release-lock lock)",
|
||||||
"Release a lock such that other threads may acquire it.") {
|
"Release a lock such that other threads may acquire it.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractMutex *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||||
janet_os_mutex_unlock(&mutex->mutex);
|
janet_os_mutex_unlock(mutex);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
JanetOSRWLock rwlock;
|
|
||||||
} JanetAbstractRWLock;
|
|
||||||
|
|
||||||
static int rwlockgc(void *p, size_t size) {
|
static int rwlockgc(void *p, size_t size) {
|
||||||
JanetAbstractRWLock *rwlock = (JanetAbstractRWLock *) p;
|
|
||||||
(void) size;
|
(void) size;
|
||||||
janet_os_rwlock_deinit(&rwlock->rwlock);
|
janet_os_rwlock_deinit(p);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -3078,48 +3085,48 @@ const JanetAbstractType janet_rwlock_type = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_rwlock,
|
JANET_CORE_FN(janet_cfun_rwlock,
|
||||||
"(ev/rwlock)",
|
"(ev/rwlock)",
|
||||||
"Create a new read-write lock to coordinate threads.") {
|
"Create a new read-write lock to coordinate threads.") {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
JanetAbstractRWLock *rwlock = janet_abstract_threaded(&janet_rwlock_type, sizeof(JanetAbstractRWLock));
|
void *rwlock = janet_abstract_threaded(&janet_rwlock_type, janet_os_rwlock_size());
|
||||||
janet_os_rwlock_init(&rwlock->rwlock);
|
janet_os_rwlock_init(rwlock);
|
||||||
return janet_wrap_abstract(rwlock);
|
return janet_wrap_abstract(rwlock);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_rwlock_read_lock,
|
JANET_CORE_FN(janet_cfun_rwlock_read_lock,
|
||||||
"(ev/acquire-rlock rwlock)",
|
"(ev/acquire-rlock rwlock)",
|
||||||
"Acquire a read lock an a read-write lock.") {
|
"Acquire a read lock an a read-write lock.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||||
janet_os_rwlock_rlock(&rwlock->rwlock);
|
janet_os_rwlock_rlock(rwlock);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_rwlock_write_lock,
|
JANET_CORE_FN(janet_cfun_rwlock_write_lock,
|
||||||
"(ev/acquire-wlock rwlock)",
|
"(ev/acquire-wlock rwlock)",
|
||||||
"Acquire a write lock on a read-write lock.") {
|
"Acquire a write lock on a read-write lock.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||||
janet_os_rwlock_wlock(&rwlock->rwlock);
|
janet_os_rwlock_wlock(rwlock);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_rwlock_read_release,
|
JANET_CORE_FN(janet_cfun_rwlock_read_release,
|
||||||
"(ev/release-rlock rwlock)",
|
"(ev/release-rlock rwlock)",
|
||||||
"Release a read lock on a read-write lock") {
|
"Release a read lock on a read-write lock") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||||
janet_os_rwlock_runlock(&rwlock->rwlock);
|
janet_os_rwlock_runlock(rwlock);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_rwlock_write_release,
|
JANET_CORE_FN(janet_cfun_rwlock_write_release,
|
||||||
"(ev/release-wlock rwlock)",
|
"(ev/release-wlock rwlock)",
|
||||||
"Release a write lock on a read-write lock") {
|
"Release a write lock on a read-write lock") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||||
janet_os_rwlock_wunlock(&rwlock->rwlock);
|
janet_os_rwlock_wunlock(rwlock);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
1372
src/core/ffi.c
Normal file
1372
src/core/ffi.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -407,13 +407,26 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* In C, signed arithmetic overflow is undefined behvior
|
||||||
|
* but unsigned arithmetic overflow is twos complement
|
||||||
|
*
|
||||||
|
* Reference:
|
||||||
|
* https://en.cppreference.com/w/cpp/language/ub
|
||||||
|
* http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
|
||||||
|
*
|
||||||
|
* This means OPMETHOD & OPMETHODINVERT must always use
|
||||||
|
* unsigned arithmetic internally, regardless of the true type.
|
||||||
|
* This will not affect the end result (property of twos complement).
|
||||||
|
*/
|
||||||
#define OPMETHOD(T, type, name, oper) \
|
#define OPMETHOD(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_arity(argc, 2, -1); \
|
janet_arity(argc, 2, -1); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[0]); \
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
for (int32_t i = 1; i < argc; i++) \
|
for (int32_t i = 1; i < argc; i++) \
|
||||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
/* This avoids undefined behavior. See above for why. */ \
|
||||||
|
*box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
@@ -422,7 +435,8 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[1]); \
|
*box = janet_unwrap_##type(argv[1]); \
|
||||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
/* This avoids undefined behavior. See above for why. */ \
|
||||||
|
*box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
|
|||||||
@@ -545,6 +545,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
case JANET_FUNCTION: {
|
||||||
|
/* Special case function */
|
||||||
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
|
JanetBuffer *buf = janet_buffer(0);
|
||||||
|
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||||
|
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||||
|
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||||
|
janet_call(fun, 1, args);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
f = dflt_file;
|
f = dflt_file;
|
||||||
if (f == NULL) janet_panic("cannot print to nil");
|
if (f == NULL) janet_panic("cannot print to nil");
|
||||||
@@ -684,6 +694,16 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
|||||||
janet_buffer_deinit(&buffer);
|
janet_buffer_deinit(&buffer);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
case JANET_FUNCTION: {
|
||||||
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
|
int32_t len = 0;
|
||||||
|
while (format[len]) len++;
|
||||||
|
JanetBuffer *buf = janet_buffer(len);
|
||||||
|
janet_formatbv(buf, format, args);
|
||||||
|
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||||
|
janet_call(fun, 1, args);
|
||||||
|
break;
|
||||||
|
}
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER:
|
||||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||||
break;
|
break;
|
||||||
|
|||||||
@@ -37,6 +37,7 @@ typedef struct {
|
|||||||
JanetFuncEnv **seen_envs;
|
JanetFuncEnv **seen_envs;
|
||||||
JanetFuncDef **seen_defs;
|
JanetFuncDef **seen_defs;
|
||||||
int32_t nextid;
|
int32_t nextid;
|
||||||
|
int maybe_cycles;
|
||||||
} MarshalState;
|
} MarshalState;
|
||||||
|
|
||||||
/* Lead bytes in marshaling protocol */
|
/* Lead bytes in marshaling protocol */
|
||||||
@@ -364,13 +365,15 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
|||||||
|
|
||||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||||
janet_table_put(&st->seen,
|
if (st->maybe_cycles) {
|
||||||
janet_wrap_abstract(abstract),
|
janet_table_put(&st->seen,
|
||||||
janet_wrap_integer(st->nextid++));
|
janet_wrap_abstract(abstract),
|
||||||
|
janet_wrap_integer(st->nextid++));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
#define MARK_SEEN() \
|
#define MARK_SEEN() \
|
||||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
|
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||||
|
|
||||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||||
void *abstract = janet_unwrap_abstract(x);
|
void *abstract = janet_unwrap_abstract(x);
|
||||||
@@ -428,11 +431,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
|
|
||||||
/* Check reference and registry value */
|
/* Check reference and registry value */
|
||||||
{
|
{
|
||||||
Janet check = janet_table_get(&st->seen, x);
|
Janet check;
|
||||||
if (janet_checkint(check)) {
|
if (st->maybe_cycles) {
|
||||||
pushbyte(st, LB_REFERENCE);
|
check = janet_table_get(&st->seen, x);
|
||||||
pushint(st, janet_unwrap_integer(check));
|
if (janet_checkint(check)) {
|
||||||
return;
|
pushbyte(st, LB_REFERENCE);
|
||||||
|
pushint(st, janet_unwrap_integer(check));
|
||||||
|
return;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (st->rreg) {
|
if (st->rreg) {
|
||||||
check = janet_table_get(st->rreg, x);
|
check = janet_table_get(st->rreg, x);
|
||||||
@@ -613,6 +619,7 @@ void janet_marshal(
|
|||||||
st.seen_defs = NULL;
|
st.seen_defs = NULL;
|
||||||
st.seen_envs = NULL;
|
st.seen_envs = NULL;
|
||||||
st.rreg = rreg;
|
st.rreg = rreg;
|
||||||
|
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
|
||||||
janet_table_init(&st.seen, 0);
|
janet_table_init(&st.seen, 0);
|
||||||
marshal_one(&st, x, flags);
|
marshal_one(&st, x, flags);
|
||||||
janet_table_deinit(&st.seen);
|
janet_table_deinit(&st.seen);
|
||||||
@@ -1471,16 +1478,17 @@ JANET_CORE_FN(cfun_env_lookup,
|
|||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_marshal,
|
JANET_CORE_FN(cfun_marshal,
|
||||||
"(marshal x &opt reverse-lookup buffer)",
|
"(marshal x &opt reverse-lookup buffer no-cycles)",
|
||||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||||
"can then later be unmarshalled to reconstruct the initial value. "
|
"can then later be unmarshalled to reconstruct the initial value. "
|
||||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||||
"aliased values that are found in the table. Then a forward "
|
"aliased values that are found in the table. Then a forward "
|
||||||
"lookup table can be used to recover the original value when "
|
"lookup table can be used to recover the original value when "
|
||||||
"unmarshalling.") {
|
"unmarshalling.") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 4);
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
JanetTable *rreg = NULL;
|
JanetTable *rreg = NULL;
|
||||||
|
uint32_t flags = 0;
|
||||||
if (argc > 1) {
|
if (argc > 1) {
|
||||||
rreg = janet_gettable(argv, 1);
|
rreg = janet_gettable(argv, 1);
|
||||||
}
|
}
|
||||||
@@ -1489,7 +1497,10 @@ JANET_CORE_FN(cfun_marshal,
|
|||||||
} else {
|
} else {
|
||||||
buffer = janet_buffer(10);
|
buffer = janet_buffer(10);
|
||||||
}
|
}
|
||||||
janet_marshal(buffer, argv[0], rreg, 0);
|
if (argc > 3 && janet_truthy(argv[3])) {
|
||||||
|
flags |= JANET_MARSHAL_NO_CYCLES;
|
||||||
|
}
|
||||||
|
janet_marshal(buffer, argv[0], rreg, flags);
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -224,7 +224,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
|||||||
janet_schedule(s->fiber, janet_wrap_nil());
|
janet_schedule(s->fiber, janet_wrap_nil());
|
||||||
return JANET_ASYNC_STATUS_DONE;
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
case JANET_ASYNC_EVENT_READ: {
|
case JANET_ASYNC_EVENT_READ: {
|
||||||
|
#if defined(JANET_LINUX)
|
||||||
|
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||||
|
#else
|
||||||
|
/* On BSDs, CLOEXEC should be inherited from server socket */
|
||||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||||
|
#endif
|
||||||
if (JSOCKVALID(connfd)) {
|
if (JSOCKVALID(connfd)) {
|
||||||
janet_net_socknoblock(connfd);
|
janet_net_socknoblock(connfd);
|
||||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||||
@@ -884,7 +889,6 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
|
|||||||
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void janet_lib_net(JanetTable *env) {
|
void janet_lib_net(JanetTable *env) {
|
||||||
JanetRegExt net_cfuns[] = {
|
JanetRegExt net_cfuns[] = {
|
||||||
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
||||||
|
|||||||
@@ -470,15 +470,7 @@ static int proc_get_status(JanetProc *proc) {
|
|||||||
/* Function that is called in separate thread to wait on a pid */
|
/* Function that is called in separate thread to wait on a pid */
|
||||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||||
JanetProc *proc = (JanetProc *) args.argp;
|
JanetProc *proc = (JanetProc *) args.argp;
|
||||||
#ifdef WNOWAIT
|
|
||||||
pid_t result;
|
|
||||||
int status = 0;
|
|
||||||
do {
|
|
||||||
result = waitpid(proc->pid, &status, WNOWAIT);
|
|
||||||
} while (result == -1 && errno == EINTR);
|
|
||||||
#else
|
|
||||||
args.tag = proc_get_status(proc);
|
args.tag = proc_get_status(proc);
|
||||||
#endif
|
|
||||||
return args;
|
return args;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -489,11 +481,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
|||||||
janet_ev_dec_refcount();
|
janet_ev_dec_refcount();
|
||||||
JanetProc *proc = (JanetProc *) args.argp;
|
JanetProc *proc = (JanetProc *) args.argp;
|
||||||
if (NULL != proc) {
|
if (NULL != proc) {
|
||||||
#ifdef WNOWAIT
|
|
||||||
int status = proc_get_status(proc);
|
|
||||||
#else
|
|
||||||
int status = args.tag;
|
int status = args.tag;
|
||||||
#endif
|
|
||||||
proc->return_code = (int32_t) status;
|
proc->return_code = (int32_t) status;
|
||||||
proc->flags |= JANET_PROC_WAITED;
|
proc->flags |= JANET_PROC_WAITED;
|
||||||
proc->flags &= ~JANET_PROC_WAITING;
|
proc->flags &= ~JANET_PROC_WAITING;
|
||||||
@@ -1121,8 +1109,8 @@ JANET_CORE_FN(os_spawn,
|
|||||||
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
|
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
|
||||||
"same arguments as `os/execute`. Does not wait for the process. "
|
"same arguments as `os/execute`. Does not wait for the process. "
|
||||||
"For each of the :in, :out, and :err keys to the `env` argument, one "
|
"For each of the :in, :out, and :err keys to the `env` argument, one "
|
||||||
"can also pass in the keyword `:pipe`"
|
"can also pass in the keyword `:pipe` "
|
||||||
"to get streams for standard IO of the subprocess that can be read from and written to."
|
"to get streams for standard IO of the subprocess that can be read from and written to. "
|
||||||
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
||||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
||||||
"subprocess or `(os/proc-kill proc)`.") {
|
"subprocess or `(os/proc-kill proc)`.") {
|
||||||
@@ -1336,7 +1324,7 @@ JANET_CORE_FN(os_date,
|
|||||||
time_t t;
|
time_t t;
|
||||||
struct tm t_infos;
|
struct tm t_infos;
|
||||||
struct tm *t_info = NULL;
|
struct tm *t_info = NULL;
|
||||||
if (argc) {
|
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
|
||||||
int64_t integer = janet_getinteger64(argv, 0);
|
int64_t integer = janet_getinteger64(argv, 0);
|
||||||
t = (time_t) integer;
|
t = (time_t) integer;
|
||||||
} else {
|
} else {
|
||||||
@@ -1345,6 +1333,7 @@ JANET_CORE_FN(os_date,
|
|||||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||||
/* local time */
|
/* local time */
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
_tzset();
|
||||||
localtime_s(&t_infos, &t);
|
localtime_s(&t_infos, &t);
|
||||||
t_info = &t_infos;
|
t_info = &t_infos;
|
||||||
#else
|
#else
|
||||||
@@ -2035,23 +2024,23 @@ JANET_CORE_FN(os_open,
|
|||||||
"Allowed flags are as follows:\n\n"
|
"Allowed flags are as follows:\n\n"
|
||||||
" * :r - open this file for reading\n"
|
" * :r - open this file for reading\n"
|
||||||
" * :w - open this file for writing\n"
|
" * :w - open this file for writing\n"
|
||||||
" * :c - create a new file (O_CREATE)\n"
|
" * :c - create a new file (O\\_CREATE)\n"
|
||||||
" * :e - fail if the file exists (O_EXCL)\n"
|
" * :e - fail if the file exists (O\\_EXCL)\n"
|
||||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
||||||
"Posix-only flags:\n\n"
|
"Posix-only flags:\n\n"
|
||||||
" * :a - append to a file (O_APPEND)\n"
|
" * :a - append to a file (O\\_APPEND)\n"
|
||||||
" * :x - O_SYNC\n"
|
" * :x - O\\_SYNC\n"
|
||||||
" * :C - O_NOCTTY\n\n"
|
" * :C - O\\_NOCTTY\n\n"
|
||||||
"Windows-only flags:\n\n"
|
"Windows-only flags:\n\n"
|
||||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
||||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
||||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
" * :D - share deletes (FILE\\_SHARE\\_DELETE)\n"
|
||||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
" * :H - FILE\\_ATTRIBUTE\\_HIDDEN\n"
|
||||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
" * :O - FILE\\_ATTRIBUTE\\_READONLY\n"
|
||||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
||||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
||||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
||||||
" * :b - FILE_FLAG_NO_BUFFERING\n") {
|
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||||
|
|||||||
@@ -206,6 +206,37 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
|
||||||
|
JanetParseState *s = parser->states + stack_index;
|
||||||
|
JanetBuffer *buffer = janet_buffer(40);
|
||||||
|
if (msg) {
|
||||||
|
janet_buffer_push_cstring(buffer, msg);
|
||||||
|
}
|
||||||
|
if (c) {
|
||||||
|
janet_buffer_push_u8(buffer, c);
|
||||||
|
}
|
||||||
|
if (stack_index > 0) {
|
||||||
|
janet_buffer_push_cstring(buffer, ", ");
|
||||||
|
if (s->flags & PFLAG_PARENS) {
|
||||||
|
janet_buffer_push_u8(buffer, '(');
|
||||||
|
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||||
|
janet_buffer_push_u8(buffer, '[');
|
||||||
|
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||||
|
janet_buffer_push_u8(buffer, '{');
|
||||||
|
} else if (s->flags & PFLAG_STRING) {
|
||||||
|
janet_buffer_push_u8(buffer, '"');
|
||||||
|
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||||
|
int32_t i;
|
||||||
|
for (i = 0; i < s->argn; i++) {
|
||||||
|
janet_buffer_push_u8(buffer, '`');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||||
|
}
|
||||||
|
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||||
|
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
static int checkescape(uint8_t c) {
|
static int checkescape(uint8_t c) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
@@ -612,7 +643,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
case '}': {
|
case '}': {
|
||||||
Janet ds;
|
Janet ds;
|
||||||
if (p->statecount == 1) {
|
if (p->statecount == 1) {
|
||||||
p->error = "unexpected delimiter";
|
delim_error(p, 0, c, "unexpected closing delimiter ");
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||||
@@ -633,7 +664,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
ds = close_struct(p, state);
|
ds = close_struct(p, state);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
p->error = "mismatched delimiter";
|
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
popstate(p, ds);
|
popstate(p, ds);
|
||||||
@@ -684,26 +715,7 @@ void janet_parser_eof(JanetParser *parser) {
|
|||||||
size_t oldline = parser->line;
|
size_t oldline = parser->line;
|
||||||
janet_parser_consume(parser, '\n');
|
janet_parser_consume(parser, '\n');
|
||||||
if (parser->statecount > 1) {
|
if (parser->statecount > 1) {
|
||||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
|
||||||
JanetBuffer *buffer = janet_buffer(40);
|
|
||||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
|
||||||
if (s->flags & PFLAG_PARENS) {
|
|
||||||
janet_buffer_push_u8(buffer, '(');
|
|
||||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
|
||||||
janet_buffer_push_u8(buffer, '[');
|
|
||||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
|
||||||
janet_buffer_push_u8(buffer, '{');
|
|
||||||
} else if (s->flags & PFLAG_STRING) {
|
|
||||||
janet_buffer_push_u8(buffer, '"');
|
|
||||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
|
||||||
int32_t i;
|
|
||||||
for (i = 0; i < s->argn; i++) {
|
|
||||||
janet_buffer_push_u8(buffer, '`');
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
|
||||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
|
||||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
|
||||||
}
|
}
|
||||||
parser->line = oldline;
|
parser->line = oldline;
|
||||||
parser->column = oldcolumn;
|
parser->column = oldcolumn;
|
||||||
|
|||||||
@@ -211,9 +211,10 @@ tail:
|
|||||||
}
|
}
|
||||||
|
|
||||||
case RULE_SET: {
|
case RULE_SET: {
|
||||||
|
if (text >= s->text_end) return NULL;
|
||||||
uint32_t word = rule[1 + (text[0] >> 5)];
|
uint32_t word = rule[1 + (text[0] >> 5)];
|
||||||
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
||||||
return (text < s->text_end && (word & mask))
|
return (word & mask)
|
||||||
? text + 1
|
? text + 1
|
||||||
: NULL;
|
: NULL;
|
||||||
}
|
}
|
||||||
@@ -260,24 +261,46 @@ tail:
|
|||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_IF:
|
case RULE_IF: {
|
||||||
case RULE_IFNOT: {
|
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
up1(s);
|
up1(s);
|
||||||
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
if (!result) return NULL;
|
||||||
rule = rule_b;
|
rule = rule_b;
|
||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
|
case RULE_IFNOT: {
|
||||||
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
|
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||||
|
down1(s);
|
||||||
|
CapState cs = cap_save(s);
|
||||||
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
|
if (!!result) {
|
||||||
|
up1(s);
|
||||||
|
return NULL;
|
||||||
|
} else {
|
||||||
|
cap_load(s, cs);
|
||||||
|
up1(s);
|
||||||
|
rule = rule_b;
|
||||||
|
goto tail;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
case RULE_NOT: {
|
case RULE_NOT: {
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
down1(s);
|
down1(s);
|
||||||
|
CapState cs = cap_save(s);
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
up1(s);
|
if (result) {
|
||||||
return (result) ? NULL : text;
|
up1(s);
|
||||||
|
return NULL;
|
||||||
|
} else {
|
||||||
|
cap_load(s, cs);
|
||||||
|
up1(s);
|
||||||
|
return text;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_THRU:
|
case RULE_THRU:
|
||||||
@@ -1661,7 +1684,9 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void peg_call_reset(PegCall *c) {
|
static void peg_call_reset(PegCall *c) {
|
||||||
|
c->s.depth = JANET_RECURSION_GUARD;
|
||||||
c->s.captures->count = 0;
|
c->s.captures->count = 0;
|
||||||
|
c->s.tagged_captures->count = 0;
|
||||||
c->s.scratch->count = 0;
|
c->s.scratch->count = 0;
|
||||||
c->s.tags->count = 0;
|
c->s.tags->count = 0;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -762,8 +762,7 @@ static const char *scanformat(
|
|||||||
memset(precision, '\0', 3);
|
memset(precision, '\0', 3);
|
||||||
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||||
p++; /* skip flags */
|
p++; /* skip flags */
|
||||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
|
||||||
janet_panic("invalid format (repeated flags)");
|
|
||||||
if (isdigit((int)(*p)))
|
if (isdigit((int)(*p)))
|
||||||
width[0] = *p++; /* skip width */
|
width[0] = *p++; /* skip width */
|
||||||
if (isdigit((int)(*p)))
|
if (isdigit((int)(*p)))
|
||||||
@@ -983,8 +982,9 @@ void janet_buffer_format(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 's': {
|
case 's': {
|
||||||
const uint8_t *s = janet_getstring(argv, arg);
|
JanetByteView bytes = janet_getbytes(argv, arg);
|
||||||
int32_t l = janet_string_length(s);
|
const uint8_t *s = bytes.bytes;
|
||||||
|
int32_t l = bytes.len;
|
||||||
if (form[2] == '\0')
|
if (form[2] == '\0')
|
||||||
janet_buffer_push_bytes(b, s, l);
|
janet_buffer_push_bytes(b, s, l);
|
||||||
else {
|
else {
|
||||||
|
|||||||
@@ -80,9 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
const char *e = janet_parser_error(&parser);
|
const char *e = janet_parser_error(&parser);
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
ret = janet_cstringv(e);
|
ret = janet_cstringv(e);
|
||||||
size_t line = parser.line;
|
int32_t line = (int32_t) parser.line;
|
||||||
size_t col = parser.column;
|
int32_t col = (int32_t) parser.column;
|
||||||
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
|
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||||
done = 1;
|
done = 1;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -31,7 +31,7 @@
|
|||||||
|
|
||||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
janetc_cerror(opts.compiler, "expected 1 argument to quote");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
return janetc_cslot(argv[0]);
|
return janetc_cslot(argv[0]);
|
||||||
@@ -40,7 +40,7 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
janetc_cerror(opts.compiler, "expected 1 argument to splice");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
ret = janetc_value(opts, argv[0]);
|
ret = janetc_value(opts, argv[0]);
|
||||||
@@ -117,7 +117,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
|
|
||||||
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
||||||
@@ -143,7 +143,7 @@ static int destructure(JanetCompiler *c,
|
|||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
switch (janet_type(left)) {
|
switch (janet_type(left)) {
|
||||||
default:
|
default:
|
||||||
janetc_cerror(c, "unexpected type in destructuring");
|
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
|
||||||
return 1;
|
return 1;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
@@ -302,6 +302,9 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
|
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetTable *tab = janet_table(2);
|
JanetTable *tab = janet_table(2);
|
||||||
|
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||||
|
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||||
|
: "<multiple bindings>";
|
||||||
for (i = 1; i < argn - 1; i++) {
|
for (i = 1; i < argn - 1; i++) {
|
||||||
Janet attr = argv[i];
|
Janet attr = argv[i];
|
||||||
switch (janet_type(attr)) {
|
switch (janet_type(attr)) {
|
||||||
@@ -309,7 +312,7 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
|||||||
janetc_cerror(c, "unexpected form - did you intend to use defn?");
|
janetc_cerror(c, "unexpected form - did you intend to use defn?");
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
janetc_cerror(c, "could not add metadata to binding");
|
janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name));
|
||||||
break;
|
break;
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
janet_table_put(tab, attr, janet_wrap_true());
|
janet_table_put(tab, attr, janet_wrap_true());
|
||||||
@@ -822,6 +825,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
int seenopt = 0;
|
int seenopt = 0;
|
||||||
|
int namedargs = 0;
|
||||||
|
|
||||||
/* Begin function */
|
/* Begin function */
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
@@ -846,6 +850,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Keep track of destructured parameters */
|
/* Keep track of destructured parameters */
|
||||||
JanetSlot *destructed_params = NULL;
|
JanetSlot *destructed_params = NULL;
|
||||||
|
JanetSlot *named_params = NULL;
|
||||||
|
JanetTable *named_table = NULL;
|
||||||
|
JanetSlot named_slot;
|
||||||
|
|
||||||
/* Compile function parameters */
|
/* Compile function parameters */
|
||||||
params = janet_unwrap_tuple(argv[parami]);
|
params = janet_unwrap_tuple(argv[parami]);
|
||||||
@@ -853,49 +860,75 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
arity = paramcount;
|
arity = paramcount;
|
||||||
for (i = 0; i < paramcount; i++) {
|
for (i = 0; i < paramcount; i++) {
|
||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
if (namedargs) {
|
||||||
|
arity--;
|
||||||
|
if (!janet_checktype(param, JANET_SYMBOL)) {
|
||||||
|
errmsg = "only named arguments can follow &named";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
Janet key = janet_wrap_keyword(janet_unwrap_symbol(param));
|
||||||
|
janet_table_put(named_table, key, param);
|
||||||
|
janet_v_push(named_params, janetc_farslot(c));
|
||||||
|
} else if (janet_checktype(param, JANET_SYMBOL)) {
|
||||||
/* Check for varargs and unfixed arity */
|
/* Check for varargs and unfixed arity */
|
||||||
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
const uint8_t *sym = janet_unwrap_symbol(param);
|
||||||
if (seenamp) {
|
if (sym[0] == '&') {
|
||||||
errmsg = "& in unexpected location";
|
if (!janet_cstrcmp(sym, "&")) {
|
||||||
goto error;
|
if (seenamp) {
|
||||||
} else if (i == paramcount - 1) {
|
errmsg = "& in unexpected location";
|
||||||
allow_extra = 1;
|
goto error;
|
||||||
|
} else if (i == paramcount - 1) {
|
||||||
|
allow_extra = 1;
|
||||||
|
arity--;
|
||||||
|
} else if (i == paramcount - 2) {
|
||||||
|
vararg = 1;
|
||||||
|
arity -= 2;
|
||||||
|
} else {
|
||||||
|
errmsg = "& in unexpected location";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
seenamp = 1;
|
||||||
|
} else if (!janet_cstrcmp(sym, "&opt")) {
|
||||||
|
if (seenopt) {
|
||||||
|
errmsg = "only one &opt allowed";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 1) {
|
||||||
|
errmsg = "&opt cannot be last item in parameter list";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
min_arity = i;
|
||||||
arity--;
|
arity--;
|
||||||
} else if (i == paramcount - 2) {
|
seenopt = 1;
|
||||||
vararg = 1;
|
} else if (!janet_cstrcmp(sym, "&keys")) {
|
||||||
arity -= 2;
|
if (seenamp) {
|
||||||
} else {
|
errmsg = "&keys in unexpected location";
|
||||||
errmsg = "& in unexpected location";
|
goto error;
|
||||||
goto error;
|
} else if (i == paramcount - 2) {
|
||||||
}
|
vararg = 1;
|
||||||
seenamp = 1;
|
structarg = 1;
|
||||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
arity -= 2;
|
||||||
if (seenopt) {
|
} else {
|
||||||
errmsg = "only one &opt allowed";
|
errmsg = "&keys in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
} else if (i == paramcount - 1) {
|
}
|
||||||
errmsg = "&opt cannot be last item in parameter list";
|
seenamp = 1;
|
||||||
goto error;
|
} else if (!janet_cstrcmp(sym, "&named")) {
|
||||||
}
|
if (seenamp) {
|
||||||
min_arity = i;
|
errmsg = "&named in unexpected location";
|
||||||
arity--;
|
goto error;
|
||||||
seenopt = 1;
|
}
|
||||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
|
||||||
if (seenamp) {
|
|
||||||
errmsg = "&keys in unexpected location";
|
|
||||||
goto error;
|
|
||||||
} else if (i == paramcount - 2) {
|
|
||||||
vararg = 1;
|
vararg = 1;
|
||||||
structarg = 1;
|
structarg = 1;
|
||||||
arity -= 2;
|
arity--;
|
||||||
|
seenamp = 1;
|
||||||
|
namedargs = 1;
|
||||||
|
named_table = janet_table(10);
|
||||||
|
named_slot = janetc_farslot(c);
|
||||||
} else {
|
} else {
|
||||||
errmsg = "&keys in unexpected location";
|
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||||
goto error;
|
|
||||||
}
|
}
|
||||||
seenamp = 1;
|
|
||||||
} else {
|
} else {
|
||||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
janet_v_push(destructed_params, janetc_farslot(c));
|
janet_v_push(destructed_params, janetc_farslot(c));
|
||||||
@@ -914,6 +947,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
janet_v_free(destructed_params);
|
janet_v_free(destructed_params);
|
||||||
|
|
||||||
|
/* Compile named arguments */
|
||||||
|
if (namedargs) {
|
||||||
|
Janet param = janet_wrap_table(named_table);
|
||||||
|
destructure(c, param, named_slot, defleaf, NULL);
|
||||||
|
janetc_freeslot(c, named_slot);
|
||||||
|
janet_v_free(named_params);
|
||||||
|
}
|
||||||
|
|
||||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
if (!seenopt) min_arity = arity;
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
|
|||||||
@@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join,
|
|||||||
|
|
||||||
JANET_CORE_FN(cfun_string_format,
|
JANET_CORE_FN(cfun_string_format,
|
||||||
"(string/format format & values)",
|
"(string/format format & values)",
|
||||||
"Similar to `snprintf`, but specialized for operating with Janet values. Returns "
|
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
|
||||||
"a new string.") {
|
"a new string.") {
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_buffer(0);
|
JanetBuffer *buffer = janet_buffer(0);
|
||||||
|
|||||||
@@ -36,6 +36,13 @@
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#ifdef JANET_DYNAMIC_MODULES
|
||||||
|
#include <psapi.h>
|
||||||
|
#pragma comment (lib, "Psapi.lib")
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_APPLE
|
#ifdef JANET_APPLE
|
||||||
#include <AvailabilityMacros.h>
|
#include <AvailabilityMacros.h>
|
||||||
#endif
|
#endif
|
||||||
@@ -739,6 +746,13 @@ int janet_checkint64(Janet x) {
|
|||||||
return janet_checkint64range(dval);
|
return janet_checkint64range(dval);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int janet_checkuint64(Janet x) {
|
||||||
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
|
return 0;
|
||||||
|
double dval = janet_unwrap_number(x);
|
||||||
|
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||||
|
}
|
||||||
|
|
||||||
int janet_checksize(Janet x) {
|
int janet_checksize(Janet x) {
|
||||||
if (!janet_checktype(x, JANET_NUMBER))
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
return 0;
|
return 0;
|
||||||
@@ -877,6 +891,73 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Dynamic library loading */
|
||||||
|
|
||||||
|
char *get_processed_name(const char *name) {
|
||||||
|
if (name[0] == '.') return (char *) name;
|
||||||
|
const char *c;
|
||||||
|
for (c = name; *c; c++) {
|
||||||
|
if (*c == '/') return (char *) name;
|
||||||
|
}
|
||||||
|
size_t l = (size_t)(c - name);
|
||||||
|
char *ret = janet_malloc(l + 3);
|
||||||
|
if (NULL == ret) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
ret[0] = '.';
|
||||||
|
ret[1] = '/';
|
||||||
|
memcpy(ret + 2, name, l + 1);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
#if defined(JANET_WINDOWS)
|
||||||
|
|
||||||
|
static char error_clib_buf[256];
|
||||||
|
char *error_clib(void) {
|
||||||
|
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||||
|
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||||
|
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||||
|
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||||
|
return error_clib_buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
Clib load_clib(const char *name) {
|
||||||
|
if (name == NULL) {
|
||||||
|
return GetModuleHandle(NULL);
|
||||||
|
} else {
|
||||||
|
return LoadLibrary(name);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void free_clib(HINSTANCE clib) {
|
||||||
|
if (clib != GetModuleHandle(NULL)) {
|
||||||
|
FreeLibrary(clib);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void *symbol_clib(HINSTANCE clib, const char *sym) {
|
||||||
|
if (clib != GetModuleHandle(NULL)) {
|
||||||
|
return GetProcAddress(clib, sym);
|
||||||
|
} else {
|
||||||
|
/* Look up symbols from all loaded modules */
|
||||||
|
HMODULE hMods[1024];
|
||||||
|
DWORD needed = 0;
|
||||||
|
if (EnumProcessModules(GetCurrentProcess(), hMods, sizeof(hMods), &needed)) {
|
||||||
|
needed /= sizeof(HMODULE);
|
||||||
|
for (DWORD i = 0; i < needed; i++) {
|
||||||
|
void *address = GetProcAddress(hMods[i], sym);
|
||||||
|
if (NULL != address) {
|
||||||
|
return address;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panicf("ffi: %s", error_clib());
|
||||||
|
}
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Alloc function macro fills */
|
/* Alloc function macro fills */
|
||||||
void *(janet_malloc)(size_t size) {
|
void *(janet_malloc)(size_t size) {
|
||||||
|
|||||||
@@ -31,6 +31,14 @@
|
|||||||
|
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
|
#include <stddef.h>
|
||||||
|
#include <stdbool.h>
|
||||||
|
|
||||||
|
#ifdef JANET_EV
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
#include <pthread.h>
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||||
#include <time.h>
|
#include <time.h>
|
||||||
@@ -121,6 +129,31 @@ int janet_gettime(struct timespec *spec);
|
|||||||
#define strdup(x) _strdup(x)
|
#define strdup(x) _strdup(x)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||||
|
* with native code. */
|
||||||
|
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||||
|
typedef int Clib;
|
||||||
|
#define load_clib(name) ((void) name, 0)
|
||||||
|
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||||
|
#define error_clib() "dynamic libraries not supported"
|
||||||
|
#define free_clib(c) ((void) (c), 0)
|
||||||
|
#elif defined(JANET_WINDOWS)
|
||||||
|
#include <windows.h>
|
||||||
|
typedef HINSTANCE Clib;
|
||||||
|
void *symbol_clib(Clib clib, const char *sym);
|
||||||
|
void free_clib(Clib clib);
|
||||||
|
Clib load_clib(const char *name);
|
||||||
|
char *error_clib(void);
|
||||||
|
#else
|
||||||
|
#include <dlfcn.h>
|
||||||
|
typedef void *Clib;
|
||||||
|
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||||
|
#define free_clib(lib) dlclose((lib))
|
||||||
|
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||||
|
#define error_clib() dlerror()
|
||||||
|
#endif
|
||||||
|
char *get_processed_name(const char *name);
|
||||||
|
|
||||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||||
|
|
||||||
/* Initialize builtin libraries */
|
/* Initialize builtin libraries */
|
||||||
@@ -159,5 +192,8 @@ void janet_lib_ev(JanetTable *env);
|
|||||||
void janet_ev_mark(void);
|
void janet_ev_mark(void);
|
||||||
int janet_make_pipe(JanetHandle handles[2], int mode);
|
int janet_make_pipe(JanetHandle handles[2], int mode);
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef JANET_FFI
|
||||||
|
void janet_lib_ffi(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -295,6 +295,15 @@ int janet_equals(Janet x, Janet y) {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static uint64_t murmur64(uint64_t h) {
|
||||||
|
h ^= h >> 33;
|
||||||
|
h *= 0xff51afd7ed558ccdUL;
|
||||||
|
h ^= h >> 33;
|
||||||
|
h *= 0xc4ceb9fe1a85ec53UL;
|
||||||
|
h ^= h >> 33;
|
||||||
|
return h;
|
||||||
|
}
|
||||||
|
|
||||||
/* Computes a hash value for a function */
|
/* Computes a hash value for a function */
|
||||||
int32_t janet_hash(Janet x) {
|
int32_t janet_hash(Janet x) {
|
||||||
int32_t hash = 0;
|
int32_t hash = 0;
|
||||||
@@ -341,14 +350,11 @@ int32_t janet_hash(Janet x) {
|
|||||||
default:
|
default:
|
||||||
if (sizeof(double) == sizeof(void *)) {
|
if (sizeof(double) == sizeof(void *)) {
|
||||||
/* Assuming 8 byte pointer (8 byte aligned) */
|
/* Assuming 8 byte pointer (8 byte aligned) */
|
||||||
uint64_t i = janet_u64(x);
|
uint64_t i = murmur64(janet_u64(x));
|
||||||
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
|
hash = (int32_t)(i >> 32);
|
||||||
uint32_t hi = (uint32_t)(i >> 32);
|
|
||||||
uint32_t hilo = (hi ^ lo) * 2654435769u;
|
|
||||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
|
||||||
} else {
|
} else {
|
||||||
/* Assuming 4 byte pointer (or smaller) */
|
/* Assuming 4 byte pointer (or smaller) */
|
||||||
ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
|
uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
|
||||||
uint32_t hilo = (uint32_t) diff * 2654435769u;
|
uint32_t hilo = (uint32_t) diff * 2654435769u;
|
||||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -220,14 +220,14 @@
|
|||||||
/* Trace a function call */
|
/* Trace a function call */
|
||||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||||
if (func->def->name) {
|
if (func->def->name) {
|
||||||
janet_printf("trace (%S", func->def->name);
|
janet_eprintf("trace (%S", func->def->name);
|
||||||
} else {
|
} else {
|
||||||
janet_printf("trace (%p", janet_wrap_function(func));
|
janet_eprintf("trace (%p", janet_wrap_function(func));
|
||||||
}
|
}
|
||||||
for (int32_t i = 0; i < argc; i++) {
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
janet_printf(" %p", argv[i]);
|
janet_eprintf(" %p", argv[i]);
|
||||||
}
|
}
|
||||||
janet_printf(")\n");
|
janet_eprintf(")\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Invoke a method once we have looked it up */
|
/* Invoke a method once we have looked it up */
|
||||||
@@ -1285,6 +1285,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
|||||||
return signal;
|
return signal;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet void_cfunction(int32_t argc, Janet *argv) {
|
||||||
|
(void) argc;
|
||||||
|
(void) argv;
|
||||||
|
janet_panic("placeholder");
|
||||||
|
}
|
||||||
|
|
||||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||||
/* Check entry conditions */
|
/* Check entry conditions */
|
||||||
if (!janet_vm.fiber)
|
if (!janet_vm.fiber)
|
||||||
@@ -1292,9 +1298,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
|||||||
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
|
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
|
||||||
janet_panic("C stack recursed too deeply");
|
janet_panic("C stack recursed too deeply");
|
||||||
|
|
||||||
|
/* Dirty stack */
|
||||||
|
int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
|
||||||
|
if (dirty_stack) {
|
||||||
|
janet_fiber_cframe(janet_vm.fiber, void_cfunction);
|
||||||
|
}
|
||||||
|
|
||||||
/* Tracing */
|
/* Tracing */
|
||||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||||
|
janet_vm.stackn++;
|
||||||
vm_do_trace(fun, argc, argv);
|
vm_do_trace(fun, argc, argv);
|
||||||
|
janet_vm.stackn--;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push frame */
|
/* Push frame */
|
||||||
@@ -1322,6 +1336,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
|||||||
/* Teardown */
|
/* Teardown */
|
||||||
janet_vm.stackn = oldn;
|
janet_vm.stackn = oldn;
|
||||||
janet_gcunlock(handle);
|
janet_gcunlock(handle);
|
||||||
|
if (dirty_stack) {
|
||||||
|
janet_fiber_popframe(janet_vm.fiber);
|
||||||
|
janet_vm.fiber->stacktop += dirty_stack;
|
||||||
|
}
|
||||||
|
|
||||||
if (signal != JANET_SIGNAL_OK) {
|
if (signal != JANET_SIGNAL_OK) {
|
||||||
janet_panicv(*janet_vm.return_reg);
|
janet_panicv(*janet_vm.return_reg);
|
||||||
|
|||||||
@@ -163,6 +163,14 @@ extern "C" {
|
|||||||
#define JANET_DYNAMIC_MODULES
|
#define JANET_DYNAMIC_MODULES
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable the FFI library. Currently, FFI only enabled on
|
||||||
|
* x86-64 operating systems. */
|
||||||
|
#ifndef JANET_NO_FFI
|
||||||
|
#if !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
|
||||||
|
#define JANET_FFI
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Enable or disable the assembler. Enabled by default. */
|
/* Enable or disable the assembler. Enabled by default. */
|
||||||
#ifndef JANET_NO_ASSEMBLER
|
#ifndef JANET_NO_ASSEMBLER
|
||||||
#define JANET_ASSEMBLER
|
#define JANET_ASSEMBLER
|
||||||
@@ -228,7 +236,7 @@ extern "C" {
|
|||||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||||
#define JANET_MAX_PROTO_DEPTH 200
|
#define JANET_MAX_PROTO_DEPTH 200
|
||||||
|
|
||||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
/* Prevent macros to expand too deeply and error out. */
|
||||||
#define JANET_MAX_MACRO_EXPAND 200
|
#define JANET_MAX_MACRO_EXPAND 200
|
||||||
|
|
||||||
/* Define default max stack size for stacks before raising a stack overflow error.
|
/* Define default max stack size for stacks before raising a stack overflow error.
|
||||||
@@ -299,22 +307,10 @@ typedef struct {
|
|||||||
JANET_CURRENT_CONFIG_BITS })
|
JANET_CURRENT_CONFIG_BITS })
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Feature include for pthreads. Most feature detection code should go in
|
/* Some extra includes if EV is enabled */
|
||||||
* features.h instead. */
|
#ifdef JANET_EV
|
||||||
#ifndef JANET_WINDOWS
|
typedef struct JanetOSMutex JanetOSMutex;
|
||||||
#ifndef _XOPEN_SOURCE
|
typedef struct JanetOSRWLock JanetOSRWLock;
|
||||||
#define _XOPEN_SOURCE 600
|
|
||||||
#endif
|
|
||||||
#if _XOPEN_SOURCE < 600
|
|
||||||
#undef _XOPEN_SOURCE
|
|
||||||
#define _XOPEN_SOURCE 600
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* What to do when out of memory */
|
|
||||||
#ifndef JANET_OUT_OF_MEMORY
|
|
||||||
#include <stdio.h>
|
|
||||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/***** END SECTION CONFIG *****/
|
/***** END SECTION CONFIG *****/
|
||||||
@@ -334,27 +330,10 @@ typedef struct {
|
|||||||
#include <stddef.h>
|
#include <stddef.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
/* Some extra includes if EV is enabled */
|
|
||||||
#ifdef JANET_EV
|
/* What to do when out of memory */
|
||||||
#ifdef JANET_WINDOWS
|
#ifndef JANET_OUT_OF_MEMORY
|
||||||
typedef struct JanetDudCriticalSection {
|
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||||
/* Avoid including windows.h here - instead, create a structure of the same size */
|
|
||||||
/* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
|
|
||||||
void *debug_info;
|
|
||||||
long lock_count;
|
|
||||||
long recursion_count;
|
|
||||||
void *owning_thread;
|
|
||||||
void *lock_semaphore;
|
|
||||||
unsigned long spin_count;
|
|
||||||
} JanetOSMutex;
|
|
||||||
typedef struct JanetDudRWLock {
|
|
||||||
void *ptr;
|
|
||||||
} JanetOSRWLock;
|
|
||||||
#else
|
|
||||||
#include <pthread.h>
|
|
||||||
typedef pthread_mutex_t JanetOSMutex;
|
|
||||||
typedef pthread_rwlock_t JanetOSRWLock;
|
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_BSD
|
#ifdef JANET_BSD
|
||||||
@@ -865,6 +844,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||||||
|
|
||||||
JANET_API int janet_checkint(Janet x);
|
JANET_API int janet_checkint(Janet x);
|
||||||
JANET_API int janet_checkint64(Janet x);
|
JANET_API int janet_checkint64(Janet x);
|
||||||
|
JANET_API int janet_checkuint64(Janet x);
|
||||||
JANET_API int janet_checksize(Janet x);
|
JANET_API int janet_checksize(Janet x);
|
||||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||||
@@ -1385,6 +1365,8 @@ JANET_API int32_t janet_abstract_incref(void *abst);
|
|||||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||||
|
|
||||||
/* Expose some OS sync primitives */
|
/* Expose some OS sync primitives */
|
||||||
|
JANET_API size_t janet_os_mutex_size(void);
|
||||||
|
JANET_API size_t janet_os_rwlock_size(void);
|
||||||
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
||||||
JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
|
JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
|
||||||
JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
|
JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
|
||||||
@@ -1689,6 +1671,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
|||||||
|
|
||||||
/* Marshaling */
|
/* Marshaling */
|
||||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||||
|
#define JANET_MARSHAL_NO_CYCLES 0x40000
|
||||||
|
|
||||||
JANET_API void janet_marshal(
|
JANET_API void janet_marshal(
|
||||||
JanetBuffer *buf,
|
JanetBuffer *buf,
|
||||||
@@ -1936,6 +1919,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
|||||||
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
|
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
|
||||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||||
|
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
|
||||||
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
|
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||||
|
|||||||
@@ -87,8 +87,30 @@ static void simpleline(JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Windows */
|
/* State */
|
||||||
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
|
||||||
|
#ifndef JANET_SIMPLE_GETLINE
|
||||||
|
/* static state */
|
||||||
|
#define JANET_LINE_MAX 1024
|
||||||
|
#define JANET_MATCH_MAX 256
|
||||||
|
#define JANET_HISTORY_MAX 100
|
||||||
|
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||||
|
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||||
|
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||||
|
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||||
|
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||||
|
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||||
|
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||||
|
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||||
|
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||||
|
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||||
|
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||||
|
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||||
|
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Fallback */
|
||||||
|
#if defined(JANET_SIMPLE_GETLINE)
|
||||||
|
|
||||||
void janet_line_init() {
|
void janet_line_init() {
|
||||||
;
|
;
|
||||||
@@ -105,6 +127,80 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
|||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Rich implementation */
|
||||||
|
#else
|
||||||
|
|
||||||
|
/* Windows */
|
||||||
|
#ifdef _WIN32
|
||||||
|
|
||||||
|
#include <stdbool.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <io.h>
|
||||||
|
|
||||||
|
static void setup_console_output(void) {
|
||||||
|
/* Enable color console on windows 10 console and utf8 output and other processing */
|
||||||
|
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||||
|
DWORD dwMode = 0;
|
||||||
|
GetConsoleMode(hOut, &dwMode);
|
||||||
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||||
|
SetConsoleMode(hOut, dwMode);
|
||||||
|
SetConsoleOutputCP(65001);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Ansi terminal raw mode */
|
||||||
|
static int rawmode(void) {
|
||||||
|
if (gbl_israwmode) return 0;
|
||||||
|
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||||
|
DWORD dwMode = 0;
|
||||||
|
GetConsoleMode(hOut, &dwMode);
|
||||||
|
dwMode &= ~ENABLE_LINE_INPUT;
|
||||||
|
dwMode &= ~ENABLE_INSERT_MODE;
|
||||||
|
dwMode &= ~ENABLE_ECHO_INPUT;
|
||||||
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||||
|
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||||
|
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
||||||
|
gbl_israwmode = 1;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Disable raw mode */
|
||||||
|
static void norawmode(void) {
|
||||||
|
if (!gbl_israwmode) return;
|
||||||
|
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||||
|
DWORD dwMode = 0;
|
||||||
|
GetConsoleMode(hOut, &dwMode);
|
||||||
|
dwMode |= ENABLE_LINE_INPUT;
|
||||||
|
dwMode |= ENABLE_INSERT_MODE;
|
||||||
|
dwMode |= ENABLE_ECHO_INPUT;
|
||||||
|
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||||
|
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||||
|
SetConsoleMode(hOut, dwMode);
|
||||||
|
gbl_israwmode = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static long write_console(const char *bytes, size_t n) {
|
||||||
|
DWORD nwritten = 0;
|
||||||
|
BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
|
||||||
|
if (!result) return -1; /* error */
|
||||||
|
return (long)nwritten;
|
||||||
|
}
|
||||||
|
|
||||||
|
static long read_console(char *into, size_t n) {
|
||||||
|
DWORD numread;
|
||||||
|
BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
|
||||||
|
if (!result) return -1; /* error */
|
||||||
|
return (long)numread;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int check_simpleline(JanetBuffer *buffer) {
|
||||||
|
if (!_isatty(_fileno(stdin)) || rawmode()) {
|
||||||
|
simpleline(buffer);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
/* Posix */
|
/* Posix */
|
||||||
#else
|
#else
|
||||||
|
|
||||||
@@ -125,24 +221,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
|||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
|
|
||||||
/* static state */
|
|
||||||
#define JANET_LINE_MAX 1024
|
|
||||||
#define JANET_MATCH_MAX 256
|
|
||||||
#define JANET_HISTORY_MAX 100
|
|
||||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
|
||||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
|
||||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
|
||||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
|
||||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
|
||||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
|
||||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
|
||||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
|
||||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
|
||||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
|
||||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
|
||||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
|
||||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
|
||||||
|
|
||||||
/* Unsupported terminal list from linenoise */
|
/* Unsupported terminal list from linenoise */
|
||||||
static const char *badterms[] = {
|
static const char *badterms[] = {
|
||||||
@@ -152,15 +231,6 @@ static const char *badterms[] = {
|
|||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
static char *sdup(const char *s) {
|
|
||||||
size_t len = strlen(s) + 1;
|
|
||||||
char *mem = janet_malloc(len);
|
|
||||||
if (!mem) {
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
return memcpy(mem, s, len);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Ansi terminal raw mode */
|
/* Ansi terminal raw mode */
|
||||||
static int rawmode(void) {
|
static int rawmode(void) {
|
||||||
struct termios t;
|
struct termios t;
|
||||||
@@ -186,13 +256,53 @@ static void norawmode(void) {
|
|||||||
gbl_israwmode = 0;
|
gbl_israwmode = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int checktermsupport() {
|
||||||
|
const char *t = getenv("TERM");
|
||||||
|
int i;
|
||||||
|
if (!t) return 1;
|
||||||
|
for (i = 0; badterms[i]; i++)
|
||||||
|
if (!strcmp(t, badterms[i])) return 0;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
static long write_console(char *bytes, size_t n) {
|
||||||
|
return write(STDOUT_FILENO, bytes, n);
|
||||||
|
}
|
||||||
|
|
||||||
|
static long read_console(char *into, size_t n) {
|
||||||
|
return read(STDIN_FILENO, into, n);
|
||||||
|
}
|
||||||
|
|
||||||
|
static int check_simpleline(JanetBuffer *buffer) {
|
||||||
|
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||||
|
simpleline(buffer);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (rawmode()) {
|
||||||
|
simpleline(buffer);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static char *sdup(const char *s) {
|
||||||
|
size_t len = strlen(s) + 1;
|
||||||
|
char *mem = janet_malloc(len);
|
||||||
|
if (!mem) {
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
return memcpy(mem, s, len);
|
||||||
|
}
|
||||||
|
|
||||||
static int curpos(void) {
|
static int curpos(void) {
|
||||||
char buf[32];
|
char buf[32];
|
||||||
int cols, rows;
|
int cols, rows;
|
||||||
unsigned int i = 0;
|
unsigned int i = 0;
|
||||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
if (write_console("\x1b[6n", 4) != 4) return -1;
|
||||||
while (i < sizeof(buf) - 1) {
|
while (i < sizeof(buf) - 1) {
|
||||||
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
if (read_console(buf + i, 1) != 1) break;
|
||||||
if (buf[i] == 'R') break;
|
if (buf[i] == 'R') break;
|
||||||
i++;
|
i++;
|
||||||
}
|
}
|
||||||
@@ -203,18 +313,23 @@ static int curpos(void) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int getcols(void) {
|
static int getcols(void) {
|
||||||
|
#ifdef _WIN32
|
||||||
|
CONSOLE_SCREEN_BUFFER_INFO csbi;
|
||||||
|
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
|
||||||
|
return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
|
||||||
|
#else
|
||||||
struct winsize ws;
|
struct winsize ws;
|
||||||
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
||||||
int start, cols;
|
int start, cols;
|
||||||
start = curpos();
|
start = curpos();
|
||||||
if (start == -1) goto failed;
|
if (start == -1) goto failed;
|
||||||
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
|
if (write_console("\x1b[999C", 6) != 6) goto failed;
|
||||||
cols = curpos();
|
cols = curpos();
|
||||||
if (cols == -1) goto failed;
|
if (cols == -1) goto failed;
|
||||||
if (cols > start) {
|
if (cols > start) {
|
||||||
char seq[32];
|
char seq[32];
|
||||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
if (write_console(seq, strlen(seq)) == -1) {
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -224,10 +339,11 @@ static int getcols(void) {
|
|||||||
}
|
}
|
||||||
failed:
|
failed:
|
||||||
return 80;
|
return 80;
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
static void clear(void) {
|
static void clear(void) {
|
||||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -259,7 +375,7 @@ static void refresh(void) {
|
|||||||
/* Move cursor to original position. */
|
/* Move cursor to original position. */
|
||||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||||
janet_buffer_push_cstring(&b, seq);
|
janet_buffer_push_cstring(&b, seq);
|
||||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
if (write_console((char *) b.data, b.count) == -1) {
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
janet_buffer_deinit(&b);
|
janet_buffer_deinit(&b);
|
||||||
@@ -285,7 +401,7 @@ static int insert(char c, int draw) {
|
|||||||
if (gbl_plen + gbl_len < gbl_cols) {
|
if (gbl_plen + gbl_len < gbl_cols) {
|
||||||
/* Avoid a full update of the line in the
|
/* Avoid a full update of the line in the
|
||||||
* trivial case. */
|
* trivial case. */
|
||||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
if (write_console(&c, 1) == -1) return -1;
|
||||||
} else {
|
} else {
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
@@ -312,7 +428,7 @@ static void historymove(int delta) {
|
|||||||
gbl_historyi = gbl_history_count - 1;
|
gbl_historyi = gbl_history_count - 1;
|
||||||
}
|
}
|
||||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
gbl_pos = gbl_len = (int) strlen(gbl_buf);
|
||||||
gbl_buf[gbl_len] = '\0';
|
gbl_buf[gbl_len] = '\0';
|
||||||
|
|
||||||
refresh();
|
refresh();
|
||||||
@@ -527,6 +643,7 @@ static void check_specials(JanetByteView src) {
|
|||||||
check_cmatch(src, "unquote");
|
check_cmatch(src, "unquote");
|
||||||
check_cmatch(src, "var");
|
check_cmatch(src, "var");
|
||||||
check_cmatch(src, "while");
|
check_cmatch(src, "while");
|
||||||
|
check_cmatch(src, "upscope");
|
||||||
}
|
}
|
||||||
|
|
||||||
static void resolve_format(JanetTable *entry) {
|
static void resolve_format(JanetTable *entry) {
|
||||||
@@ -740,14 +857,14 @@ static int line() {
|
|||||||
|
|
||||||
addhistory();
|
addhistory();
|
||||||
|
|
||||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
char c;
|
char c;
|
||||||
char seq[3];
|
char seq[3];
|
||||||
|
|
||||||
int rc;
|
int rc;
|
||||||
do {
|
do {
|
||||||
rc = read(STDIN_FILENO, &c, 1);
|
rc = read_console(&c, 1);
|
||||||
} while (rc < 0 && errno == EINTR);
|
} while (rc < 0 && errno == EINTR);
|
||||||
if (rc <= 0) return -1;
|
if (rc <= 0) return -1;
|
||||||
|
|
||||||
@@ -764,8 +881,13 @@ static int line() {
|
|||||||
kleft();
|
kleft();
|
||||||
break;
|
break;
|
||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
|
clearlines();
|
||||||
norawmode();
|
norawmode();
|
||||||
|
#ifdef _WIN32
|
||||||
|
ExitProcess(1);
|
||||||
|
#else
|
||||||
kill(getpid(), SIGINT);
|
kill(getpid(), SIGINT);
|
||||||
|
#endif
|
||||||
/* fallthrough */
|
/* fallthrough */
|
||||||
case 17: /* ctrl-q */
|
case 17: /* ctrl-q */
|
||||||
gbl_cancel_current_repl_form = 1;
|
gbl_cancel_current_repl_form = 1;
|
||||||
@@ -826,23 +948,25 @@ static int line() {
|
|||||||
case 23: /* ctrl-w */
|
case 23: /* ctrl-w */
|
||||||
kbackspacew();
|
kbackspacew();
|
||||||
break;
|
break;
|
||||||
|
#ifndef _WIN32
|
||||||
case 26: /* ctrl-z */
|
case 26: /* ctrl-z */
|
||||||
norawmode();
|
norawmode();
|
||||||
kill(getpid(), SIGSTOP);
|
kill(getpid(), SIGSTOP);
|
||||||
rawmode();
|
rawmode();
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
|
#endif
|
||||||
case 27: /* escape sequence */
|
case 27: /* escape sequence */
|
||||||
/* Read the next two bytes representing the escape sequence.
|
/* Read the next two bytes representing the escape sequence.
|
||||||
* Use two calls to handle slow terminals returning the two
|
* Use two calls to handle slow terminals returning the two
|
||||||
* chars at different times. */
|
* chars at different times. */
|
||||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
if (read_console(seq, 1) == -1) break;
|
||||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||||
if (seq[0] == '[') {
|
if (seq[0] == '[') {
|
||||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
if (read_console(seq + 1, 1) == -1) break;
|
||||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||||
/* Extended escape, read additional byte. */
|
/* Extended escape, read additional byte. */
|
||||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
if (read_console(seq + 2, 1) == -1) break;
|
||||||
if (seq[2] == '~') {
|
if (seq[2] == '~') {
|
||||||
switch (seq[1]) {
|
switch (seq[1]) {
|
||||||
case '1': /* Home */
|
case '1': /* Home */
|
||||||
@@ -861,7 +985,7 @@ static int line() {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else if (seq[0] == 'O') {
|
} else if (seq[0] == 'O') {
|
||||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
if (read_console(seq + 1, 1) == -1) break;
|
||||||
switch (seq[1]) {
|
switch (seq[1]) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
@@ -944,28 +1068,12 @@ void janet_line_deinit() {
|
|||||||
gbl_historyi = 0;
|
gbl_historyi = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int checktermsupport() {
|
|
||||||
const char *t = getenv("TERM");
|
|
||||||
int i;
|
|
||||||
if (!t) return 1;
|
|
||||||
for (i = 0; badterms[i]; i++)
|
|
||||||
if (!strcmp(t, badterms[i])) return 0;
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
gbl_prompt = p;
|
gbl_prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
gbl_historyi = 0;
|
gbl_historyi = 0;
|
||||||
|
if (check_simpleline(buffer)) return;
|
||||||
FILE *out = janet_dynfile("err", stderr);
|
FILE *out = janet_dynfile("err", stderr);
|
||||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
|
||||||
simpleline(buffer);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
if (rawmode()) {
|
|
||||||
simpleline(buffer);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
if (line()) {
|
if (line()) {
|
||||||
norawmode();
|
norawmode();
|
||||||
fputc('\n', out);
|
fputc('\n', out);
|
||||||
@@ -981,6 +1089,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
|||||||
replacehistory();
|
replacehistory();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void clear_at_exit(void) {
|
||||||
|
if (!gbl_israwmode) {
|
||||||
|
clearlines();
|
||||||
|
norawmode();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@@ -993,18 +1108,11 @@ int main(int argc, char **argv) {
|
|||||||
JanetTable *env;
|
JanetTable *env;
|
||||||
|
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
/* Enable color console on windows 10 console and utf8 output. */
|
setup_console_output();
|
||||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
|
||||||
DWORD dwMode = 0;
|
|
||||||
GetConsoleMode(hOut, &dwMode);
|
|
||||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
|
||||||
SetConsoleMode(hOut, dwMode);
|
|
||||||
SetConsoleOutputCP(65001);
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
|
#if !defined(JANET_SIMPLE_GETLINE)
|
||||||
/* Try and not leave the terminal in a bad state */
|
atexit(clear_at_exit);
|
||||||
atexit(norawmode);
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if defined(JANET_PRF)
|
#if defined(JANET_PRF)
|
||||||
|
|||||||
@@ -164,36 +164,26 @@
|
|||||||
|
|
||||||
(:close s))
|
(:close s))
|
||||||
|
|
||||||
(defn check-matching-names [stream]
|
|
||||||
(def ln (net/localname stream))
|
|
||||||
(def pn (net/peername stream))
|
|
||||||
(def [my-ip my-port] ln)
|
|
||||||
(def [remote-ip remote-port] pn)
|
|
||||||
(def msg (string my-ip " " my-port " " remote-ip " " remote-port))
|
|
||||||
(def buf @"")
|
|
||||||
(ev/gather
|
|
||||||
(net/write stream msg)
|
|
||||||
(net/read stream 1024 buf))
|
|
||||||
(def comparison (string/split " " buf))
|
|
||||||
(assert (and (= my-ip (get comparison 2))
|
|
||||||
(= (string my-port) (get comparison 3))
|
|
||||||
(= remote-ip (get comparison 0))
|
|
||||||
(= (string remote-port) (get comparison 1)))
|
|
||||||
(string/format "localname should match peername: msg=%j, buf=%j" msg buf)))
|
|
||||||
|
|
||||||
# Test on both server and client
|
# Test on both server and client
|
||||||
(defn names-handler
|
(defn names-handler
|
||||||
[stream]
|
[stream]
|
||||||
(defer (:close stream)
|
(defer (:close stream)
|
||||||
(check-matching-names stream)))
|
# prevent immediate close
|
||||||
|
(ev/read stream 1)
|
||||||
|
(def [host port] (net/localname stream))
|
||||||
|
(assert (= host "127.0.0.1") "localname host server")
|
||||||
|
(assert (= port 8000) "localname port server")))
|
||||||
|
|
||||||
# Test localname and peername
|
# Test localname and peername
|
||||||
(repeat 20
|
(repeat 10
|
||||||
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
||||||
(defn test-names []
|
(repeat 10
|
||||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||||
(check-matching-names conn)))
|
(def [host port] (net/peername conn))
|
||||||
(repeat 20 (test-names)))
|
(assert (= host "127.0.0.1") "peername host client ")
|
||||||
|
(assert (= port 8000) "peername port client")
|
||||||
|
# let server close
|
||||||
|
(ev/write conn " "))))
|
||||||
(gccollect))
|
(gccollect))
|
||||||
|
|
||||||
# Create pipe
|
# Create pipe
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2021 Calvin Rose & contributors
|
# Copyright (c) 2022 Calvin Rose & contributors
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
@@ -80,5 +80,27 @@
|
|||||||
"table rawget regression"
|
"table rawget regression"
|
||||||
(table/new -1))
|
(table/new -1))
|
||||||
|
|
||||||
|
# Named arguments
|
||||||
|
(defn named-arguments
|
||||||
|
[&named bob sally joe]
|
||||||
|
(+ bob sally joe))
|
||||||
|
|
||||||
|
(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
|
||||||
|
|
||||||
|
(defn named-opt-arguments
|
||||||
|
[&opt x &named a b c]
|
||||||
|
(+ x a b c))
|
||||||
|
|
||||||
|
(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
|
||||||
|
|
||||||
|
(let [b @""]
|
||||||
|
(defn dummy [a b c]
|
||||||
|
(+ a b c))
|
||||||
|
(trace dummy)
|
||||||
|
(defn errout [arg]
|
||||||
|
(buffer/push b arg))
|
||||||
|
(assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
|
||||||
|
(assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
55
test/suite0012.janet
Normal file
55
test/suite0012.janet
Normal file
@@ -0,0 +1,55 @@
|
|||||||
|
# Copyright (c) 2022 Calvin Rose & contributors
|
||||||
|
#
|
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
# deal in the Software without restriction, including without limitation the
|
||||||
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
# sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
# furnished to do so, subject to the following conditions:
|
||||||
|
#
|
||||||
|
# The above copyright notice and this permission notice shall be included in
|
||||||
|
# all copies or substantial portions of the Software.
|
||||||
|
#
|
||||||
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
|
(import ./helper :prefix "" :exit true)
|
||||||
|
(start-suite 12)
|
||||||
|
|
||||||
|
(var counter 0)
|
||||||
|
(def thunk (delay (++ counter)))
|
||||||
|
(assert (= (thunk) 1) "delay 1")
|
||||||
|
(assert (= counter 1) "delay 2")
|
||||||
|
(assert (= (thunk) 1) "delay 3")
|
||||||
|
(assert (= counter 1) "delay 4")
|
||||||
|
|
||||||
|
(def has-ffi (dyn 'ffi/native))
|
||||||
|
|
||||||
|
# FFI check
|
||||||
|
(compwhen has-ffi
|
||||||
|
(ffi/context))
|
||||||
|
|
||||||
|
(compwhen has-ffi
|
||||||
|
(ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
|
||||||
|
(compwhen has-ffi
|
||||||
|
(def buffer1 @"aaaa")
|
||||||
|
(def buffer2 @"bbbb")
|
||||||
|
(memcpy buffer1 buffer2 4)
|
||||||
|
(assert (= (string buffer1) "bbbb") "ffi 1 - memcpy"))
|
||||||
|
|
||||||
|
(compwhen has-ffi
|
||||||
|
(assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1")
|
||||||
|
(assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1")
|
||||||
|
(assert (= 5 (ffi/size [:int :pack-all :char])) "size packed struct 2")
|
||||||
|
(assert (= 4 (ffi/align [:int :char])) "align 1")
|
||||||
|
(assert (= 1 (ffi/align [:pack :int :char])) "align 2")
|
||||||
|
(assert (= 1 (ffi/align [:int :char :pack-all])) "align 3")
|
||||||
|
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size"))
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
|
|
||||||
43
test/suite0013.janet
Normal file
43
test/suite0013.janet
Normal file
@@ -0,0 +1,43 @@
|
|||||||
|
# Copyright (c) 2022 Calvin Rose & contributors
|
||||||
|
#
|
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
# deal in the Software without restriction, including without limitation the
|
||||||
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
# sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
# furnished to do so, subject to the following conditions:
|
||||||
|
#
|
||||||
|
# The above copyright notice and this permission notice shall be included in
|
||||||
|
# all copies or substantial portions of the Software.
|
||||||
|
#
|
||||||
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
|
(import ./helper :prefix "" :exit true)
|
||||||
|
(start-suite 13)
|
||||||
|
|
||||||
|
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||||
|
@{0 0 1 3 2 6}))
|
||||||
|
|
||||||
|
(assert (deep= (tabseq [i :in (range 3)] i)
|
||||||
|
@{}))
|
||||||
|
|
||||||
|
(def- sym-prefix-peg
|
||||||
|
(peg/compile
|
||||||
|
~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
|
||||||
|
:anchor (drop (cmt ($) ,|(= $ 0)))
|
||||||
|
:cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
|
||||||
|
:recur (+ :cap (> -1 :recur))
|
||||||
|
:main (> -1 :recur)}))
|
||||||
|
|
||||||
|
(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
|
||||||
|
(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
|
||||||
|
|
||||||
|
(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
20
test/suite0014.janet
Normal file
20
test/suite0014.janet
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
(import ./helper :prefix "" :exit true)
|
||||||
|
(start-suite 14)
|
||||||
|
|
||||||
|
(assert (deep=
|
||||||
|
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||||
|
@[]) "peg not")
|
||||||
|
|
||||||
|
(assert (deep=
|
||||||
|
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||||
|
@[]) "peg if-not")
|
||||||
|
|
||||||
|
(assert (deep=
|
||||||
|
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||||
|
@[]) "peg if-not drop")
|
||||||
|
|
||||||
|
(assert (deep=
|
||||||
|
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||||
|
@[]) "peg if not")
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
@@ -159,6 +159,7 @@
|
|||||||
<Condition>ALLUSERS=1</Condition>
|
<Condition>ALLUSERS=1</Condition>
|
||||||
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
|
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" 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_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" />
|
<Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
|
||||||
<Environment Id="JANET_HEADERPATH_PERMACHINE" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
<Environment Id="JANET_HEADERPATH_PERMACHINE" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
||||||
<Environment Id="JANET_LIBPATH_PERMACHINE" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
<Environment Id="JANET_LIBPATH_PERMACHINE" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
||||||
@@ -167,6 +168,7 @@
|
|||||||
<Condition>NOT ALLUSERS=1</Condition>
|
<Condition>NOT ALLUSERS=1</Condition>
|
||||||
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
|
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" 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_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" />
|
<Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />
|
||||||
<Environment Id="JANET_HEADERPATH_PERUSER" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
<Environment Id="JANET_HEADERPATH_PERUSER" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
||||||
<Environment Id="JANET_LIBPATH_PERUSER" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
<Environment Id="JANET_LIBPATH_PERUSER" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
||||||
|
|||||||
@@ -17,6 +17,7 @@
|
|||||||
"quote"
|
"quote"
|
||||||
"quasiquote"
|
"quasiquote"
|
||||||
"unquote"
|
"unquote"
|
||||||
|
"upscope"
|
||||||
"splice"]
|
"splice"]
|
||||||
(all-bindings)))
|
(all-bindings)))
|
||||||
(def allsyms (dyn :allsyms))
|
(def allsyms (dyn :allsyms))
|
||||||
|
|||||||
Reference in New Issue
Block a user