1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-08 11:33:02 +00:00

Compare commits

..

54 Commits

Author SHA1 Message Date
Calvin Rose
894cd0e022 Prepare for 1.25.1 release. 2022-10-29 11:58:29 -05:00
Calvin Rose
db2c63fffc Update CHANGELOG.md 2022-10-24 20:32:02 -05:00
Calvin Rose
60e0f32f1a Fix os/open with :rw permissions on posix. 2022-10-24 19:39:58 -05:00
Calvin Rose
e731996a68 Allow overriding JANETCONF_HEADER in Makefile.
This allows a configuration workflow that is a bit simpler than before
and doesn't requiring applying patches. Instead, add a config.mk to
source dir with JANETCONF_HEADER=myconfig.h and compile as usual.

The patching workflow will of course still work exactly as before.
2022-10-24 09:49:51 -05:00
Calvin Rose
2f69cd4209 Add easier option for adding config.mk in root directory. 2022-10-23 13:11:07 -05:00
Calvin Rose
fd59de25c5 Add memcmp to the core. Useful in binary protocol implementations. 2022-10-18 11:54:07 -05:00
Calvin Rose
af12c3d41a Typo fixes. 2022-10-10 18:38:24 -05:00
Calvin Rose
54b52bbeb5 Prepare for 1.25.0 release. 2022-10-10 18:24:48 -05:00
Calvin Rose
1174c68d9a Update CHANGELOG.md 2022-10-10 18:23:15 -05:00
Calvin Rose
448ea7167f Add CLOEXEC when calling accept on Linux.
Prevents leakage of file descriptors to subprocesses.
The symptom of the above issue is sockets that don't seem to close
until a subprocess completes.
2022-10-10 18:06:31 -05:00
Calvin Rose
6b27008c99 Fix os/date with nil argument. 2022-10-10 15:24:28 -05:00
Calvin Rose
725c785882 Formatting. 2022-10-10 14:24:03 -05:00
Calvin Rose
ab068cff67 Remove WNOWAIT code on linux.
Would cause os/proc-wait to block in some circumstances.
2022-10-10 14:23:17 -05:00
bakpakin
9dc03adfda Fix pass by reference in windows FFI to accomodate stack shift. 2022-09-22 10:58:16 -05:00
bakpakin
49f9e4eddf Fix ifdef in capi.c for janet_getuinteger64 and janet_getinteger64 2022-09-20 15:42:20 -05:00
bakpakin
43c47ac44c Address #1037 - move stack hack after arg writing logic to avoid
clobber.
2022-09-20 15:37:20 -05:00
Calvin Rose
1cebe64664 Add some soft test cases for #1037. 2022-09-20 10:01:12 -05:00
Calvin Rose
f33c381043 Improve sysv64 classify algorithm. 2022-09-20 09:45:17 -05:00
Calvin Rose
3479841c77 Address #1034 - add handling for 8-16 byte structs in FFI. 2022-09-20 09:28:46 -05:00
Calvin Rose
6a899968a9 Allow passing user signals to (signal) as keywords. 2022-09-17 21:18:07 -05:00
Calvin Rose
bb8405a36e Merge pull request #1029 from locriacyber/patch-0
Fix documentation for ev/go, ev/spawn
2022-09-16 07:32:25 -05:00
bakpakin
c7bc711f63 Add windows FFI example test case for void functions with double
argument.
2022-09-15 13:58:54 -05:00
bakpakin
e326071c35 Fix void returns in windows FFI - address #1025 2022-09-15 13:51:11 -05:00
Locria Cyber
ad6a669381 Add doc for ev/go
Document that you can pass a function instead of a fiber to ev/go
2022-09-14 00:17:53 +00:00
Locria Cyber
e4c9dafc9a Fix typo in ev/spawn doc 2022-09-13 23:49:42 +00:00
Calvin Rose
dfc0aefd87 Merge pull request #1028 from autumnull/master
Made peg 'not' and 'if-not' drop their captures on success
2022-09-13 15:20:10 -05:00
Calvin Rose
356b39c6f5 Add test case for #1027 2022-09-12 19:00:59 -05:00
Calvin Rose
8da7bb6b68 Fix peg/replace-all and family - Fix #1027 2022-09-12 18:58:48 -05:00
Autumn!
9341081a4d Made peg 'not' and 'if-not' drop their captures on success 2022-09-12 23:07:56 +01:00
Calvin Rose
324a086eb4 Merge pull request #1023 from ScriptDevil/set-manpath
Set JANET_MANPATH environment variable while installing.
2022-09-10 09:55:01 -05:00
Ashok Gautham
ed595f52c2 Set JANET_MANPATH environment variable while installing.
JPM on windows currently installs its manpage to C:\ directly because this isn't set when installing Janet through the MSI installer
2022-09-09 13:24:36 +05:30
Calvin Rose
64ad0023bb Merge pull request #1022 from autumnull/master
Removed unnecessary backslashes from documentation
2022-09-08 08:52:55 -05:00
Autumn!
fe5f661d15 Removed unnecessary backslashes from documentation 2022-09-08 13:21:17 +01:00
Calvin Rose
ff26e3a8ba Remove end of string check that is now redudant.
The addition of some code to avoid valgrind warnings made this code
redundant.
2022-09-05 20:13:15 -05:00
Calvin Rose
14657a762c Fix peg RULE_SET op code when at tail of string in some cases. 2022-09-05 14:11:03 -05:00
Calvin Rose
4754fa3902 Fix issue #1021 - bad format specifiers in run.c 2022-09-03 14:03:51 -05:00
Calvin Rose
f302f87337 Merge pull request #1019 from Techcable/fix/inttypes-overflow
Signed integer overflow is undefined behavior in C, avoid it in inttypes.c
2022-08-30 23:23:11 -05:00
Calvin Rose
94dbcde292 Merge pull request #1020 from pepe/comment-typo
Fix typo in define comment
2022-08-30 22:57:52 -05:00
Josef Pospíšil
4336a174b1 Fix typo in define comment 2022-08-30 09:21:20 +02:00
Techcable
0adb13ed71 inttypes.c: Avoid signed integer overflow (U.B.)
In C, signed arithmetic overflow is undefined behvior
but unsigned arithmetic overflow is twos complement

Unconditionally switch to unsigned arithmetic internally for +, -, *
This will not affect the result thanks to twos complement awesomeness.

I don't think this will be an issue in these functions,
but it has a history of causing bugs.....
2022-08-29 18:38:51 -07:00
Calvin Rose
03ba1f7021 Update CHANGELOG and version numbers. 2022-08-26 13:15:30 -05:00
Calvin Rose
1f7f20788c Add line loop example for awk or sed like processing. 2022-08-26 12:29:23 -05:00
Calvin Rose
c59dd29190 Add stress test for marshalling to examples. 2022-08-26 12:27:53 -05:00
Calvin Rose
99f63a41a3 Improve pointer hashing to avoid hash collisions. 2022-08-26 12:18:10 -05:00
Calvin Rose
a575f5df36 Add option to marshal values without cycle detection. 2022-08-26 11:20:02 -05:00
Calvin Rose
0817e627ee Prepare for 1.24.1 release. 2022-08-24 13:23:53 -05:00
Calvin Rose
14d90239a7 Merge branch 'master' of github.com:janet-lang/janet 2022-08-24 11:35:37 -05:00
Calvin Rose
f5d11dc656 Address #1014 improve parse errors when bad delimiters are found.
Reuse some existing logic for eof errors.
2022-08-24 11:34:59 -05:00
Calvin Rose
6dcf5bf077 Merge pull request #1012 from Techcable/doc/clarify-flag-E
Clarify the documentation of janet -E flag
2022-08-21 13:45:17 -05:00
Calvin Rose
ac2082e9b3 Allow adding name to short-fns.
When short-fn is used in a macro, it can be useful to
give the function a nicer name then a raw pointer.
2022-08-18 14:33:59 -05:00
Techcable
dbac495bee Clarify the documentation of janet -E flag
This confused me, despite having a fair deal of janet experience.
2022-08-18 12:16:14 -07:00
Calvin Rose
fe5ccb163e Merge branch 'master' of github.com:janet-lang/janet 2022-08-16 12:38:59 -05:00
Calvin Rose
1aea5ee007 Remove stack inversion code for sysv64 FFI. 2022-08-16 12:38:44 -05:00
Calvin Rose
13cd9f8067 Remove stack inversion code for sysv64 FFI. 2022-08-16 12:20:38 -05:00
29 changed files with 608 additions and 188 deletions

5
.gitignore vendored
View File

@@ -68,10 +68,13 @@ tags
vgcore.*
*.out.*
# Wix artifacts
# WiX artifacts
*.msi
*.wixpdb
# Makefile config
/config.mk
# Created by https://www.gitignore.io/api/c
### C ###

View File

@@ -1,15 +1,33 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.25.1 - 2022-10-29
- Add `memcmp` function to core library.
- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
- Support config.mk for more easily configuring the Makefile.
## 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 collisions 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 autocompletion and
- 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, supverisor messages over threaded channels would be from ambiguous threads/fibers.
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

View File

@@ -21,9 +21,10 @@
################################
##### Set global variables #####
################################
sinclude config.mk
PREFIX?=/usr/local
JANETCONF_HEADER?=src/conf/janetconf.h
INCLUDEDIR?=$(PREFIX)/include
BINDIR?=$(PREFIX)/bin
LIBDIR?=$(PREFIX)/lib
@@ -83,7 +84,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
##### Name Files #####
######################
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
JANET_LOCAL_HEADERS=src/core/features.h \
src/core/util.h \
@@ -168,24 +169,24 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.24.dylib
SONAME=libjanet.1.25.dylib
else
SONAME=libjanet.so.1.24
SONAME=libjanet.so.1.25
endif
build/c/shell.c: src/mainclient/shell.c
cp $< $@
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
build/janetconf.h: src/conf/janetconf.h
build/janetconf.h: $(JANETCONF_HEADER)
cp $< $@
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
$(JANET_TARGET): build/janet.o build/shell.o

View File

@@ -3,11 +3,46 @@
#include <string.h>
#ifdef _WIN32
#define EXPORTER __declspec(dllexport)
#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;
@@ -57,15 +92,15 @@ double double_lots_2(
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;
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
@@ -73,17 +108,6 @@ double float_fn(float x, float y, float z) {
return (x + y) * z;
}
typedef struct {
int a;
int b;
} intint;
typedef struct {
int a;
int b;
int c;
} intintint;
EXPORTER
int intint_fn(double x, intint ii) {
printf("double: %g\n", x);
@@ -104,12 +128,6 @@ intint return_struct(int i) {
return ret;
}
typedef struct {
int64_t a;
int64_t b;
int64_t c;
} big;
EXPORTER
big struct_big(int i, double d) {
big ret;
@@ -124,7 +142,67 @@ 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;
}

View File

@@ -14,6 +14,9 @@
(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])
@@ -43,6 +46,15 @@
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
@@ -84,6 +96,15 @@
# 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)))
@@ -99,6 +120,10 @@
(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)))

2
examples/lineloop.janet Normal file
View File

@@ -0,0 +1,2 @@
(while (not (empty? (def line (getline))))
(prin "line: " line))

View 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)))

View File

@@ -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.
.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
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
.BR \-d
Enable debug mode. On all terminating signals as well the debug signal, this will

View File

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

View File

@@ -1749,7 +1749,7 @@
* tuple -- a tuple pattern will match if its first element matches, and the
following elements are treated as predicates and are true.
* `\_` symbol -- the last special case is the `\_` symbol, which is a wildcard
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
that will match any value without creating a binding.
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
@@ -2177,7 +2177,7 @@
|(+ $ $) # use pipe reader macro for terse function literals.
|(+ $&) # variadic functions
```
[arg]
[arg &opt name]
(var max-param-seen -1)
(var vararg false)
(defn saw-special-arg
@@ -2203,8 +2203,9 @@
x))
x))
(def expanded (macex arg on-binding))
(def name-splice (if name [name] []))
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
###
###
@@ -3567,7 +3568,7 @@
(ev/go (fn _call [&] (f ;args))))
(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]
~(,ev/go (fn _spawn [&] ,;body)))
@@ -3886,7 +3887,7 @@
"E" (fn E-switch [i &]
(set no-file false)
(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))
(if (function? thunk)
((thunk) ;subargs)

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 24
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_MINOR 25
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.24.0"
#define JANET_VERSION "1.25.1"
/* #define JANET_BUILD "local" */

View File

@@ -260,7 +260,7 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INTTYPES
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);
#else
Janet x = argv[n];
@@ -272,7 +272,7 @@ int64_t janet_getinteger64(const Janet *argv, int32_t n) {
}
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INTTYPES
#ifdef JANET_INT_TYPES
return janet_unwrap_u64(argv[n]);
#else
Janet x = argv[n];

View File

@@ -996,7 +996,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
}
/* C Function for compiling */
JANET_CORE_FN(cfun,
JANET_CORE_FN(cfun_compile,
"(compile ast &opt env source lints)",
"Compiles an Abstract Syntax Tree (ast) into a function. "
"Pair the compile function with parsing functionality to implement "
@@ -1043,7 +1043,7 @@ JANET_CORE_FN(cfun,
void janet_lib_compile(JanetTable *env) {
JanetRegExt cfuns[] = {
JANET_CORE_REG("compile", cfun),
JANET_CORE_REG("compile", cfun_compile),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);

View File

@@ -614,27 +614,39 @@ JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. ") {
janet_arity(argc, 1, 2);
int sig;
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
if (janet_checkint(argv[0])) {
int32_t s = janet_unwrap_integer(argv[0]);
if (s < 0 || s > 9) {
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 {
JanetKeyword kw = janet_getkeyword(argv, 0);
if (!janet_cstrcmp(kw, "yield")) {
sig = JANET_SIGNAL_YIELD;
} else if (!janet_cstrcmp(kw, "error")) {
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]);
for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
if (!janet_cstrcmp(kw, janet_signal_names[i])) {
janet_signalv((JanetSignal) i, payload);
}
}
}
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
janet_signalv(sig, payload);
janet_panicf("unknown signal %v", argv[0]);
}
JANET_CORE_FN(janet_core_memcmp,
"(memcmp a b &opt len offset-a offset-b)",
"Compare memory. Takes to byte sequences `a` and `b`, and "
"return 0 if they have identical contents, a negative integer if a is less than b, "
"and a positive integer if a is greather than b. Optionally take a length and offsets "
"to compare slices of the bytes sequences.") {
janet_arity(argc, 2, 5);
JanetByteView a = janet_getbytes(argv, 0);
JanetByteView b = janet_getbytes(argv, 1);
int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
int32_t offset_a = janet_optnat(argv, argc, 3, 0);
int32_t offset_b = janet_optnat(argv, argc, 4, 0);
if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
}
#ifdef JANET_BOOTSTRAP
@@ -938,6 +950,7 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),
JANET_REG_END
};

View File

@@ -2687,9 +2687,10 @@ error:
/* C functions */
JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. Optionally pass "
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
"(ev/go fiber-or-fun &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped"
"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 "
"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.") {

View File

@@ -123,9 +123,10 @@ typedef enum {
JANET_SYSV64_INTEGER,
JANET_SYSV64_SSE,
JANET_SYSV64_SSEUP,
JANET_SYSV64_X87,
JANET_SYSV64_X87UP,
JANET_SYSV64_COMPLEX_X87,
JANET_SYSV64_PAIR_INTINT,
JANET_SYSV64_PAIR_INTSSE,
JANET_SYSV64_PAIR_SSEINT,
JANET_SYSV64_PAIR_SSESSE,
JANET_SYSV64_NO_CLASS,
JANET_SYSV64_MEMORY,
JANET_WIN64_REGISTER,
@@ -601,7 +602,7 @@ static JanetFFIMapping void_mapping(void) {
#ifdef JANET_FFI_SYSV64_ENABLED
/* AMD64 ABI Draft 0.99.7 November 17, 2014 15:08
* See section 3.2.3 Parameter Passing */
static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
static JanetFFIWordSpec sysv64_classify_ext(JanetFFIType type, size_t shift) {
switch (type.prim) {
case JANET_FFI_TYPE_PTR:
case JANET_FFI_TYPE_STRING:
@@ -623,20 +624,63 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
if (st->size > 16) return JANET_SYSV64_MEMORY;
if (!st->is_aligned) return JANET_SYSV64_MEMORY;
JanetFFIWordSpec clazz = JANET_SYSV64_NO_CLASS;
for (uint32_t i = 0; i < st->field_count; i++) {
JanetFFIWordSpec next_class = sysv64_classify(st->fields[i].type);
if (next_class != clazz) {
if (clazz == JANET_SYSV64_NO_CLASS) {
clazz = next_class;
} else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
clazz = JANET_SYSV64_MEMORY;
} else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
clazz = JANET_SYSV64_INTEGER;
} else if (next_class == JANET_SYSV64_X87 || next_class == JANET_SYSV64_X87UP
|| next_class == JANET_SYSV64_COMPLEX_X87) {
clazz = JANET_SYSV64_MEMORY;
} else {
clazz = JANET_SYSV64_SSE;
if (st->size > 8 && st->size <= 16) {
/* map to pair classification */
int has_int_lo = 0;
int has_int_hi = 0;
for (uint32_t i = 0; i < st->field_count; i++) {
JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
switch (next_class) {
default:
break;
case JANET_SYSV64_INTEGER:
if (shift + st->fields[i].offset + type_size(st->fields[i].type) <= 8) {
has_int_lo = 1;
} else {
has_int_hi = 2;
}
break;
case JANET_SYSV64_PAIR_INTINT:
has_int_lo = 1;
has_int_hi = 2;
break;
case JANET_SYSV64_PAIR_INTSSE:
has_int_lo = 1;
break;
case JANET_SYSV64_PAIR_SSEINT:
has_int_hi = 2;
break;
break;
}
}
switch (has_int_hi + has_int_lo) {
case 0:
clazz = JANET_SYSV64_PAIR_SSESSE;
break;
case 1:
clazz = JANET_SYSV64_PAIR_INTSSE;
break;
case 2:
clazz = JANET_SYSV64_PAIR_SSEINT;
break;
case 3:
clazz = JANET_SYSV64_PAIR_INTINT;
break;
}
} else {
/* Normal struct classification */
for (uint32_t i = 0; i < st->field_count; i++) {
JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
if (next_class != clazz) {
if (clazz == JANET_SYSV64_NO_CLASS) {
clazz = next_class;
} else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
clazz = JANET_SYSV64_MEMORY;
} else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
clazz = JANET_SYSV64_INTEGER;
} else {
clazz = JANET_SYSV64_SSE;
}
}
}
}
@@ -649,6 +693,9 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
return JANET_SYSV64_NO_CLASS;
}
}
static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
return sysv64_classify_ext(type, 0);
}
#endif
JANET_CORE_FN(cfun_ffi_signature,
@@ -687,7 +734,7 @@ JANET_CORE_FN(cfun_ffi_signature,
uint32_t ref_stack_count = 0;
ret.spec = JANET_WIN64_REGISTER;
uint32_t next_register = 0;
if (ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
if (ret_size != 0 && ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
ret.spec = JANET_WIN64_REGISTER_REF;
next_register++;
} else if (ret.type.prim == JANET_FFI_TYPE_FLOAT ||
@@ -753,6 +800,8 @@ JANET_CORE_FN(cfun_ffi_signature,
JanetFFIWordSpec ret_spec = sysv64_classify(ret.type);
ret.spec = ret_spec;
if (ret_spec == JANET_SYSV64_SSE) variant = 1;
if (ret_spec == JANET_SYSV64_PAIR_INTSSE) variant = 2;
if (ret_spec == JANET_SYSV64_PAIR_SSEINT) variant = 3;
/* Spill register overflow to memory */
uint32_t next_register = 0;
uint32_t next_fp_register = 0;
@@ -781,8 +830,8 @@ JANET_CORE_FN(cfun_ffi_signature,
mappings[i].offset = stack_count;
stack_count += el_size;
}
break;
}
break;
case JANET_SYSV64_SSE: {
if (next_fp_register < max_fp_regs) {
mappings[i].offset = next_fp_register++;
@@ -791,21 +840,57 @@ JANET_CORE_FN(cfun_ffi_signature,
mappings[i].offset = stack_count;
stack_count += el_size;
}
break;
}
break;
case JANET_SYSV64_MEMORY: {
mappings[i].offset = stack_count;
stack_count += el_size;
}
}
}
/* Invert stack */
for (uint32_t i = 0; i < arg_count; i++) {
if (mappings[i].spec == JANET_SYSV64_MEMORY) {
uint32_t old_offset = mappings[i].offset;
size_t el_size = type_size(mappings[i].type);
mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset;
break;
case JANET_SYSV64_PAIR_INTINT: {
if (next_register + 1 < max_regs) {
mappings[i].offset = next_register++;
mappings[i].offset2 = next_register++;
} else {
mappings[i].spec = JANET_SYSV64_MEMORY;
mappings[i].offset = stack_count;
stack_count += el_size;
}
}
break;
case JANET_SYSV64_PAIR_INTSSE: {
if (next_register < max_regs && next_fp_register < max_fp_regs) {
mappings[i].offset = next_register++;
mappings[i].offset2 = next_fp_register++;
} else {
mappings[i].spec = JANET_SYSV64_MEMORY;
mappings[i].offset = stack_count;
stack_count += el_size;
}
}
break;
case JANET_SYSV64_PAIR_SSEINT: {
if (next_register < max_regs && next_fp_register < max_fp_regs) {
mappings[i].offset = next_fp_register++;
mappings[i].offset2 = next_register++;
} else {
mappings[i].spec = JANET_SYSV64_MEMORY;
mappings[i].offset = stack_count;
stack_count += el_size;
}
}
break;
case JANET_SYSV64_PAIR_SSESSE: {
if (next_fp_register < max_fp_regs) {
mappings[i].offset = next_fp_register++;
mappings[i].offset2 = next_fp_register++;
} else {
mappings[i].spec = JANET_SYSV64_MEMORY;
mappings[i].offset = stack_count;
stack_count += el_size;
}
}
break;
}
}
}
@@ -841,23 +926,38 @@ typedef struct {
double x;
double y;
} sysv64_sse_return;
typedef struct {
uint64_t x;
double y;
} sysv64_intsse_return;
typedef struct {
double y;
uint64_t x;
} sysv64_sseint_return;
typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
typedef sysv64_intsse_return janet_sysv64_variant_3(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
typedef sysv64_sseint_return janet_sysv64_variant_4(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
sysv64_int_return int_return;
sysv64_sse_return sse_return;
union {
sysv64_int_return int_return;
sysv64_sse_return sse_return;
sysv64_sseint_return sseint_return;
sysv64_intsse_return intsse_return;
} retu;
uint64_t pair[2];
uint64_t regs[6];
double fp_regs[8];
JanetFFIWordSpec ret_spec = signature->ret.spec;
void *ret_mem = &int_return;
void *ret_mem = &retu.int_return;
if (ret_spec == JANET_SYSV64_MEMORY) {
ret_mem = alloca(type_size(signature->ret.type));
regs[0] = (uint64_t) ret_mem;
} else if (ret_spec == JANET_SYSV64_SSE) {
ret_mem = &sse_return;
}
uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count);
for (uint32_t i = 0; i < signature->arg_count; i++) {
@@ -876,21 +976,55 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point
case JANET_SYSV64_MEMORY:
to = stack + arg.offset;
break;
case JANET_SYSV64_PAIR_INTINT:
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
regs[arg.offset] = pair[0];
regs[arg.offset2] = pair[1];
continue;
case JANET_SYSV64_PAIR_INTSSE:
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
regs[arg.offset] = pair[0];
((uint64_t *) fp_regs)[arg.offset2] = pair[1];
continue;
case JANET_SYSV64_PAIR_SSEINT:
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
((uint64_t *) fp_regs)[arg.offset] = pair[0];
regs[arg.offset2] = pair[1];
continue;
case JANET_SYSV64_PAIR_SSESSE:
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
((uint64_t *) fp_regs)[arg.offset] = pair[0];
((uint64_t *) fp_regs)[arg.offset2] = pair[1];
continue;
}
janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
}
if (signature->variant) {
sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
} else {
int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
switch (signature->variant) {
case 0:
retu.int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 1:
retu.sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 2:
retu.intsse_return = ((janet_sysv64_variant_3 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 3:
retu.sseint_return = ((janet_sysv64_variant_4 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
}
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
@@ -959,8 +1093,9 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
ret_mem = alloca(type_size(signature->ret.type));
regs[0].integer = (uint64_t) ret_mem;
}
uint64_t *stack = alloca(signature->stack_count * 8);
stack -= 2; /* hack to get proper stack placement */
size_t stack_size = signature->stack_count * 8;
size_t stack_shift = 2;
uint64_t *stack = alloca(stack_size);
for (uint32_t i = 0; i < signature->arg_count; i++) {
int32_t n = i + 2;
JanetFFIMapping arg = signature->args[i];
@@ -969,16 +1104,20 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
} else if (arg.spec == JANET_WIN64_STACK_REF) {
uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
stack[arg.offset] = (uint64_t) ptr;
stack[arg.offset] = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
} else if (arg.spec == JANET_WIN64_REGISTER_REF) {
uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
regs[arg.offset].integer = (uint64_t) ptr;
regs[arg.offset].integer = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
} else {
janet_ffi_write_one((uint8_t *) &regs[arg.offset].integer, argv, n, arg.type, JANET_FFI_MAX_RECUR);
}
}
/* hack to get proper stack placement and avoid clobbering from logic above - shift stack down, otherwise we have issues.
* Technically, this writes into 16 bytes of unallocated stack memory */
if (stack_size) memmove(stack - stack_shift, stack, stack_size);
switch (signature->variant) {
default:
janet_panicf("unknown variant %d", signature->variant);

View File

@@ -407,13 +407,26 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
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) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
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); \
} \
@@ -422,7 +435,8 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*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); \
} \

View File

@@ -37,6 +37,7 @@ typedef struct {
JanetFuncEnv **seen_envs;
JanetFuncDef **seen_defs;
int32_t nextid;
int maybe_cycles;
} MarshalState;
/* 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) {
MarshalState *st = (MarshalState *)(ctx->m_state);
janet_table_put(&st->seen,
janet_wrap_abstract(abstract),
janet_wrap_integer(st->nextid++));
if (st->maybe_cycles) {
janet_table_put(&st->seen,
janet_wrap_abstract(abstract),
janet_wrap_integer(st->nextid++));
}
}
#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) {
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 */
{
Janet check = janet_table_get(&st->seen, x);
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
return;
Janet check;
if (st->maybe_cycles) {
check = janet_table_get(&st->seen, x);
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
return;
}
}
if (st->rreg) {
check = janet_table_get(st->rreg, x);
@@ -613,6 +619,7 @@ void janet_marshal(
st.seen_defs = NULL;
st.seen_envs = NULL;
st.rreg = rreg;
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
janet_table_init(&st.seen, 0);
marshal_one(&st, x, flags);
janet_table_deinit(&st.seen);
@@ -1471,16 +1478,17 @@ JANET_CORE_FN(cfun_env_lookup,
}
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 "
"can then later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward "
"lookup table can be used to recover the original value when "
"unmarshalling.") {
janet_arity(argc, 1, 3);
janet_arity(argc, 1, 4);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
uint32_t flags = 0;
if (argc > 1) {
rreg = janet_gettable(argv, 1);
}
@@ -1489,7 +1497,10 @@ JANET_CORE_FN(cfun_marshal,
} else {
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);
}

View File

@@ -224,7 +224,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
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);
#endif
if (JSOCKVALID(connfd)) {
janet_net_socknoblock(connfd);
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);

View File

@@ -470,15 +470,7 @@ static int proc_get_status(JanetProc *proc) {
/* Function that is called in separate thread to wait on a pid */
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
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);
#endif
return args;
}
@@ -489,11 +481,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
janet_ev_dec_refcount();
JanetProc *proc = (JanetProc *) args.argp;
if (NULL != proc) {
#ifdef WNOWAIT
int status = proc_get_status(proc);
#else
int status = args.tag;
#endif
proc->return_code = (int32_t) status;
proc->flags |= JANET_PROC_WAITED;
proc->flags &= ~JANET_PROC_WAITING;
@@ -1336,7 +1324,7 @@ JANET_CORE_FN(os_date,
time_t t;
struct tm t_infos;
struct tm *t_info = NULL;
if (argc) {
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
int64_t integer = janet_getinteger64(argv, 0);
t = (time_t) integer;
} else {
@@ -2149,20 +2137,18 @@ JANET_CORE_FN(os_open,
#ifdef JANET_LINUX
open_flags |= O_CLOEXEC;
#endif
int read_flag = 0;
int write_flag = 0;
for (const uint8_t *c = opt_flags; *c; c++) {
switch (*c) {
default:
break;
case 'r':
open_flags = (open_flags & O_WRONLY)
? ((open_flags & ~O_WRONLY) | O_RDWR)
: (open_flags | O_RDONLY);
read_flag = 1;
stream_flags |= JANET_STREAM_READABLE;
break;
case 'w':
open_flags = (open_flags & O_RDONLY)
? ((open_flags & ~O_RDONLY) | O_RDWR)
: (open_flags | O_WRONLY);
write_flag = 1;
stream_flags |= JANET_STREAM_WRITABLE;
break;
case 'c':
@@ -2186,6 +2172,15 @@ JANET_CORE_FN(os_open,
break;
}
}
/* If both read and write, fix up to O_RDWR */
if (read_flag && !write_flag) {
open_flags |= O_RDONLY;
} else if (write_flag && !read_flag) {
open_flags |= O_WRONLY;
} else {
open_flags = O_RDWR;
}
do {
fd = open(path, open_flags, mode);
} while (fd == -1 && errno == EINTR);

View File

@@ -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) {
switch (c) {
default:
@@ -612,7 +643,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
case '}': {
Janet ds;
if (p->statecount == 1) {
p->error = "unexpected delimiter";
delim_error(p, 0, c, "unexpected closing delimiter ");
return 1;
}
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);
}
} else {
p->error = "mismatched delimiter";
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
return 1;
}
popstate(p, ds);
@@ -684,26 +715,7 @@ void janet_parser_eof(JanetParser *parser) {
size_t oldline = parser->line;
janet_parser_consume(parser, '\n');
if (parser->statecount > 1) {
JanetParseState *s = parser->states + (parser->statecount - 1);
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;
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
}
parser->line = oldline;
parser->column = oldcolumn;

View File

@@ -211,9 +211,10 @@ tail:
}
case RULE_SET: {
if (text >= s->text_end) return NULL;
uint32_t word = rule[1 + (text[0] >> 5)];
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
return (text < s->text_end && (word & mask))
return (word & mask)
? text + 1
: NULL;
}
@@ -260,24 +261,46 @@ tail:
goto tail;
}
case RULE_IF:
case RULE_IFNOT: {
case RULE_IF: {
const uint32_t *rule_a = s->bytecode + rule[1];
const uint32_t *rule_b = s->bytecode + rule[2];
down1(s);
const uint8_t *result = peg_rule(s, rule_a, text);
up1(s);
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
if (!result) return NULL;
rule = rule_b;
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: {
const uint32_t *rule_a = s->bytecode + rule[1];
down1(s);
CapState cs = cap_save(s);
const uint8_t *result = peg_rule(s, rule_a, text);
up1(s);
return (result) ? NULL : text;
if (result) {
up1(s);
return NULL;
} else {
cap_load(s, cs);
up1(s);
return text;
}
}
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) {
c->s.depth = JANET_RECURSION_GUARD;
c->s.captures->count = 0;
c->s.tagged_captures->count = 0;
c->s.scratch->count = 0;
c->s.tags->count = 0;
}

View File

@@ -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);
errflags |= 0x04;
ret = janet_cstringv(e);
size_t line = parser.line;
size_t col = parser.column;
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
}

View File

@@ -295,6 +295,15 @@ int janet_equals(Janet x, Janet y) {
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 */
int32_t janet_hash(Janet x) {
int32_t hash = 0;
@@ -341,11 +350,8 @@ int32_t janet_hash(Janet x) {
default:
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer (8 byte aligned) */
uint64_t i = janet_u64(x);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
uint64_t i = murmur64(janet_u64(x));
hash = (int32_t)(i >> 32);
} else {
/* Assuming 4 byte pointer (or smaller) */
uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);

View File

@@ -236,7 +236,7 @@ extern "C" {
/* Maximum depth to follow table prototypes before giving up and returning nil. */
#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 default max stack size for stacks before raising a stack overflow error.
@@ -1671,6 +1671,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
/* Marshaling */
#define JANET_MARSHAL_UNSAFE 0x20000
#define JANET_MARSHAL_NO_CYCLES 0x40000
JANET_API void janet_marshal(
JanetBuffer *buf,

View File

@@ -27,4 +27,17 @@
(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
View 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)

0
tools/format.sh Normal file → Executable file
View File

View File

@@ -159,6 +159,7 @@
<Condition>ALLUSERS=1</Condition>
<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_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_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"/>
@@ -167,6 +168,7 @@
<Condition>NOT ALLUSERS=1</Condition>
<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_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_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"/>