Merge branch 'master' into ev

This commit is contained in:
Calvin Rose 2020-06-22 22:25:44 -05:00
commit 328ee94412
21 changed files with 377 additions and 104 deletions

0
.gitattributes vendored
View File

View File

@ -2,7 +2,35 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Add JANET_GIT environment variable to jpm to use a specific git binary (useful mainly on windows).
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18
- Expose `janet_table_clear` in API.
- Respect `JANET_NO_PROCESSES` define when building
- Fix `jpm` rules having multiple copies of the same dependency.
- Fix `jpm` install in some cases.
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
to their current length.
## 1.10.0 - 2020-06-14
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
- Add `:no-compile` to `create-executable` option for jpm.
- Fix bug with the `trace` function.
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
By default, threads will now consume much less memory per thread, but sending data between
threads may cost more.
- Fix flychecking when using the `use` macro.
- CTRL-C no longer exits the repl, and instead cancels the current form.
- Various small bug fixes
- New MSI installer instead of NSIS based installer.
- Make `os/realpath` work on windows.
- Add polymorphic `compare` functions for comparing numbers.
- Add `to` and `thru` peg combinators.
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
- Expose current macro form inside macros as (dyn :macro-form)

View File

@ -150,7 +150,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
##### Amalgamation #####
########################
SONAME=libjanet.so.1.9
SONAME=libjanet.so.1.10
build/shell.c: src/mainclient/shell.c
cp $< $@
@ -234,6 +234,10 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
##### Installation #####
########################
build/jpm: jpm $(JANET_TARGET)
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
chmod +x build/jpm
.INTERMEDIATE: build/janet.pc
build/janet.pc: $(JANET_TARGET)
echo 'prefix=$(PREFIX)' > $@
@ -249,7 +253,7 @@ build/janet.pc: $(JANET_TARGET)
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) build/janet.pc
install: $(JANET_TARGET) build/janet.pc build/jpm
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
@ -260,7 +264,7 @@ install: $(JANET_TARGET) build/janet.pc
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf jpm '$(DESTDIR)$(BINDIR)'
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'

View File

@ -146,6 +146,7 @@ cd janet
meson setup build \
--buildtype release \
--optimization 2 \
--libdir /usr/local/lib \
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
ninja -C build

140
jpm
View File

@ -19,6 +19,9 @@
# Defaults
#
###START###
# Overriden on some installs.
(def- exe-dir
"Directory containing jpm script"
(do
@ -26,21 +29,28 @@
(def i (last (string/find-all sep exe)))
(slice exe 0 i)))
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
(defn- install-paths []
{:headerpath (os/realpath (string exe-dir "/../include/janet"))
:libpath (os/realpath (string exe-dir "/../lib"))
:binpath exe-dir})
###END###
# Default based on janet binary location
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
(string exe-dir "/../include/janet")))
(get (install-paths) :headerpath)))
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
(string exe-dir "/../lib")))
(get (install-paths) :libpath)))
# We want setting JANET_PATH to contain installed binaries. However, it is convenient
# to have globally installed binaries got to the same place as jpm itself, which is on
# the $PATH.
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
(if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
exe-dir))
(get (install-paths) :binpath)))
# modpath should only be derived from the syspath being used or an environment variable.
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
#
# Utilities
@ -66,11 +76,13 @@
(defn rm
"Remove a directory and all sub directories."
[path]
(if (= (os/lstat path :mode) :directory)
(do
(case (os/lstat path :mode)
:directory (do
(each subpath (os/dir path)
(rm (string path sep subpath)))
(os/rmdir path))
nil nil # do nothing if file does not exist
# Default, try to remove
(os/rm path)))
(defn- rimraf
@ -78,7 +90,8 @@
[path]
(if is-win
# windows get rid of read-only files
(os/shell (string `rmdir /S /Q "` path `"`))
(when (os/stat path :mode)
(os/shell (string `rmdir /S /Q "` path `"`)))
(rm path)))
(defn clear-cache
@ -175,9 +188,27 @@
(unless item (error (string "No rule for target " target)))
item)
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(unless (find |(= dep $) deps)
(array/push deps dep)))
(defn- add-thunk
[target more &opt phony]
(def item (gettarget target))
(def [_ thunks pthunks] item)
(array/push (if phony pthunks thunks) more)
item)
(defn- rule-impl
[target deps thunk &opt phony]
(put (getrules) target @[(array/slice deps) @[thunk] phony]))
(def rules (getrules))
(unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
(each d deps (add-dep target d))
(add-thunk target thunk phony))
(defmacro rule
"Add a rule to the rule graph."
@ -201,20 +232,6 @@
[target deps & body]
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(array/push deps dep))
(defn- add-thunk
[target more]
(def item (gettarget target))
(def [_ thunks] item)
(array/push thunks more)
item)
(defmacro add-body
"Add recipe code to an existing rule. This makes existing rules do more but
does not modify the dependency graph."
@ -244,9 +261,11 @@
(error (string "No rule for file " target " found."))))
(def [deps thunks phony] item)
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
(when (or phony (needs-build-some target realdeps))
(each thunk thunks (thunk)))
(unless phony target))
(each thunk phony (thunk))
(unless (empty? thunks)
(when (needs-build-some target realdeps)
(each thunk thunks (thunk))
target)))
#
# Importing a file
@ -310,26 +329,30 @@
# Detect threads
(def env (fiber/getenv (fiber/current)))
(def threads? (not (not (env 'thread/new))))
# Default libraries to link
(def- thread-flags
(if is-win []
(if threads? ["-lpthread"] [])))
# lflags needed for the janet binary.
# flags needed for the janet binary and compiling standalone
# executables.
(def janet-lflags
(case (os/which)
:macos ["-ldl" "-lm" ;thread-flags]
:windows [;thread-flags]
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
["-lm" ;thread-flags]))
(def janet-ldflags [])
(def janet-cflags [])
# Default flags for natives, but not required
# How can we better detect the need for -pthread?
# we probably want to better detect compiler
(def default-lflags (if is-win ["/nologo"] []))
(def default-cflags
(if is-win
["/nologo" "/MD"]
["-std=c99" "-Wall" "-Wextra"]))
(def default-ldflags [])
# Required flags for dynamic libraries. These
# are used no matter what for dynamic libraries.
@ -339,7 +362,7 @@
["-fPIC"]))
(def- dynamic-lflags
(if is-win
["/DLL" ;thread-flags]
["/DLL"]
(if is-mac
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
["-shared" ;thread-flags])))
@ -385,8 +408,8 @@
"Generate strings for adding custom defines to the compiler."
[define value]
(if value
(string (if is-win "/D" "-D") define "=" value)
(string (if is-win "/D" "-D") define)))
(string "-D" define "=" value)
(string "-D" define)))
(defn- make-defines
"Generate many defines. Takes a dictionary of defines. If a value is
@ -398,8 +421,8 @@
"Generate the c flags from the input options."
[opts]
@[;(opt opts :cflags default-cflags)
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
(string "-I" (dyn :headerpath JANET_HEADERPATH))
(string "-O" (opt opts :optimize 2))])
(defn- entry-name
"Name of symbol that enters static compilation of a module."
@ -585,7 +608,8 @@ int main(int argc, const char **argv) {
# Create executable's janet image
(def cimage_dest (string dest ".c"))
(rule dest [source]
(def no-compile (opts :no-compile))
(rule (if no-compile cimage_dest dest) [source]
(check-cc)
(print "generating executable c source...")
(create-dirs dest)
@ -641,11 +665,11 @@ int main(int argc, const char **argv) {
# Append main function
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
# Compile and link final exectable
(do
(unless no-compile
(def cc (opt opts :compiler default-compiler))
(def ldflags [;dep-ldflags ;(opt opts :ldflags [])])
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
(def cflags (getcflags opts))
(def cflags [;(getcflags opts) ;janet-cflags])
(def defines (make-defines (opt opts :defines {})))
(print "compiling and linking " dest "...")
(if is-win
@ -728,7 +752,7 @@ int main(int argc, const char **argv) {
:binpath (abspath (dyn :binpath JANET_BINPATH))]
(os/cd module-dir)
(unless fresh
(os/execute [(git-path) "pull" "origin" "master"] :p))
(os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
(when tag
(os/execute [(git-path) "reset" "--hard" tag] :p))
(unless (dyn :offline)
@ -747,9 +771,9 @@ int main(int argc, const char **argv) {
(def name (last parts))
(def path (string destdir sep name))
(array/push (dyn :installed-files) path)
(add-body "install"
(mkdir destdir)
(copy src destdir)))
(phony "install" []
(mkdir destdir)
(copy src destdir)))
(defn- make-lockfile
[&opt filename]
@ -884,17 +908,22 @@ int main(int argc, const char **argv) {
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
This executable can be installed as well to the --binpath given."
[&keys {:install install :name name :entry entry :headers headers
:cflags cflags :lflags lflags :deps deps :ldflags ldflags}]
:cflags cflags :lflags lflags :deps deps :ldflags ldflags
:no-compile no-compile}]
(def name (if is-win (string name ".exe") name))
(def dest (string "build" sep name))
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags} entry dest)
(add-dep "build" dest)
(when headers
(each h headers (add-dep dest h)))
(when deps
(each d deps (add-dep dest d)))
(when install
(install-rule dest (dyn :binpath JANET_BINPATH))))
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
(if no-compile
(let [cdest (string dest ".c")]
(add-dep "build" cdest))
(do
(add-dep "build" dest)
(when headers
(each h headers (add-dep dest h)))
(when deps
(each d deps (add-dep dest d)))
(when install
(install-rule dest (dyn :binpath JANET_BINPATH))))))
(defn declare-binscript
"Declare a janet file to be installed as an executable script. Creates
@ -908,7 +937,7 @@ int main(int argc, const char **argv) {
(def name (last parts))
(def path (string binpath sep name))
(array/push (dyn :installed-files) path)
(add-body "install"
(phony "install" []
(def contents
(with [f (file/open main)]
(def first-line (:read f :line))
@ -926,7 +955,7 @@ int main(int argc, const char **argv) {
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
(def newname (string binpath sep name ".bat"))
(array/push (dyn :installed-files) newname)
(add-body "install"
(phony "install" []
(spit newname bat))))
(defn- print-rule-tree
@ -973,7 +1002,8 @@ int main(int argc, const char **argv) {
(phony "build" [])
(phony "manifest" []
(phony "manifest" [manifest])
(rule manifest []
(print "generating " manifest "...")
(mkdir manifests)
(def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
@ -985,7 +1015,7 @@ int main(int argc, const char **argv) {
:paths installed-files})
(spit manifest (string/format "%j\n" man)))
(phony "install" ["uninstall" "build" "manifest"]
(phony "install" ["uninstall" "build" manifest]
(when (dyn :test)
(do-rule "test"))
(print "Installed as '" (meta :name) "'."))

View File

@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.10.0')
version : '1.10.2')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@ -247,7 +247,18 @@ pkg.generate(libjanet,
# Installation
install_man('janet.1')
install_man('jpm.1')
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
install_data(sources : ['jpm'], install_dir : get_option('bindir'))
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
install_man('jpm.1')
patched_jpm = custom_target('patched-jpm',
input : ['tools/patch-jpm.janet', 'jpm'],
install : true,
install_dir : get_option('bindir'),
build_by_default : true,
output : ['jpm'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
endif

View File

@ -433,6 +433,17 @@
(def ,binding ,i)
,body))))
(defn- loop-fiber-template
[binding expr body]
(with-syms [f s]
(def ds (if (idempotent? binding) binding (gensym)))
~(let [,f ,expr]
(while true
(def ,ds (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,;(if (= ds binding) [] [~(def ,binding ,ds)])
,;body))))
(defn- loop1
[body head i]
@ -470,12 +481,7 @@
:pairs (keys-template binding object true [rest])
:in (each-template binding object [rest])
:iterate (iterate-template binding object rest)
:generate (with-syms [f s]
~(let [,f ,object]
(while true
(def ,binding (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,rest)))
:generate (loop-fiber-template binding object [rest])
(error (string "unexpected loop verb " verb)))))
(defmacro for
@ -493,6 +499,18 @@
[x ds & body]
(keys-template x ds true body))
(defmacro eachy
"Resume a fiber in a loop until it has errored or died. Evaluate the body
of the loop with binding set to the yielded value."
[x fiber & body]
(loop-fiber-template x fiber body))
(defmacro repeat
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
(defmacro each
"Loop over each value in ds. Returns nil."
[x ds & body]
@ -542,6 +560,7 @@
(put _env 'each-template nil)
(put _env 'keys-template nil)
(put _env 'range-template nil)
(put _env 'loop-fiber-template nil)
(defmacro seq
"Similar to loop, but accumulates the loop body into an array and returns that.

View File

@ -28,9 +28,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 10
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.10.0"
#define JANET_VERSION "1.10.2-dev"
/* #define JANET_BUILD "local" */

View File

@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetArray *array = janet_getarray(argv, 0);
if (array->count) {
if (array->count < array->capacity) {
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
array->data = newData;
array->capacity = array->count;
}
} else {
array->capacity = 0;
free(array->data);
array->data = NULL;
}
return argv[0];
}
static const JanetReg array_cfuns[] = {
{
"array/new", cfun_array_new,
@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = {
"By default, n is 1. "
"Returns the array.")
},
{
"array/trim", cfun_array_trim,
JDOC("(array/trim arr)\n\n"
"Set the backing capacity of an array to its current length. Returns the modified array.")
},
{NULL, NULL, NULL}
};

View File

@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count) {
if (buffer->count < buffer->capacity) {
uint8_t *newData = realloc(buffer->data, buffer->count);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = buffer->count;
}
} else {
buffer->capacity = 0;
free(buffer->data);
buffer->data = NULL;
}
return argv[0];
}
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
"Returns the modified buffer.")
},
{
"buffer/trim", cfun_buffer_trim,
JDOC("(buffer/trim buffer)\n\n"
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
"modified buffer.")
},
{
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n"

View File

@ -325,7 +325,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
}
Janet janet_dyn(const char *name) {
if (!janet_vm_fiber) return janet_wrap_nil();
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) return janet_wrap_nil();
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
}
if (janet_vm_fiber->env) {
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
} else {
@ -334,11 +337,15 @@ Janet janet_dyn(const char *name) {
}
void janet_setdyn(const char *name, Janet value) {
if (!janet_vm_fiber) return;
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
} else {
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

View File

@ -206,14 +206,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
// In the following code explicit casts are sometimes used to help
// make it clear when int/float conversions are happening.
//
static int64_t compare_double_double(double x, double y) {
static int compare_double_double(double x, double y) {
return (x < y) ? -1 : ((x > y) ? 1 : 0);
}
static int64_t compare_int64_double(int64_t x, double y) {
static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) {
@ -226,7 +226,7 @@ static int64_t compare_int64_double(int64_t x, double y) {
}
}
static int64_t compare_uint64_double(uint64_t x, double y) {
static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if (y < 0) {

View File

@ -1225,6 +1225,9 @@ static Janet os_rename(int32_t argc, Janet *argv) {
static Janet os_realpath(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
const char *src = janet_getcstring(argv, 0);
#ifdef JANET_NO_REALPATH
janet_panic("os/realpath not enabled for this platform");
#else
#ifdef JANET_WINDOWS
char *dest = _fullpath(NULL, src, _MAX_PATH);
#else
@ -1234,6 +1237,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
Janet ret = janet_cstringv(dest);
free(dest);
return ret;
#endif
}
static Janet os_permission_string(int32_t argc, Janet *argv) {

View File

@ -123,9 +123,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
#undef HEX
#undef BUFSIZE
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
for (int32_t i = 0; i < len; ++i) {
@ -354,12 +351,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
if (depth == 0) return 1;
switch (janet_type(x)) {
case JANET_NIL:
case JANET_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@ -994,3 +995,6 @@ void janet_buffer_format(
}
}
}
#undef HEX
#undef BUFSIZE

View File

@ -23,7 +23,6 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
janet_stacktrace(cres.macrofiber, ret);
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
}
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR:
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
janet_eprintf("parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
done = 1;
break;
case JANET_PARSE_PENDING:
if (index == len) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
} else {

View File

@ -34,6 +34,9 @@
typedef struct JanetScratch JanetScratch;
/* Top level dynamic bindings */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;

View File

@ -66,9 +66,15 @@ struct JanetMailbox {
JanetBuffer messages[];
};
#define JANET_THREAD_HEAVYWEIGHT 0x1
#define JANET_THREAD_ABSTRACTS 0x2
#define JANET_THREAD_CFUNCTIONS 0x4
static const char janet_thread_flags[] = "hac";
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
uint64_t flags;
} JanetMailboxPair;
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
@ -175,7 +181,7 @@ static int thread_mark(void *p, size_t size) {
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
@ -183,6 +189,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
pair->flags = flags;
return pair;
}
@ -442,16 +449,44 @@ static int thread_worker(JanetMailboxPair *pair) {
janet_init();
/* Get dictionaries for default encode/decode */
JanetTable *encode = janet_get_core_table("make-image-dict");
JanetTable *encode;
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
janet_vm_thread_decode = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
}
/* Create parent thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the abstract registry */
if (pair->flags & JANET_THREAD_ABSTRACTS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
janet_vm_abstract_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
}
/* Unmarshal the normal registry */
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm_registry));
janet_vm_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm_registry));
}
/* Unmarshal the function */
Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY);
if (status) goto error;
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
JanetFunction *func = janet_unwrap_function(funcv);
@ -558,22 +593,40 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 3);
/* Just type checking */
janet_getfunction(argv, 0);
int32_t cap = janet_optinteger(argv, argc, 1, 10);
if (cap < 1 || cap > UINT16_MAX) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
JanetTable *encode = janet_get_core_table("make-image-dict");
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
JanetTable *encode;
if (flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
}
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
if (flags & JANET_THREAD_ABSTRACTS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
janet_panic("could not send abstract registry to thread");
}
}
if (flags & JANET_THREAD_CFUNCTIONS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
janet_panic("could not send registry to thread");
}
}
/* If thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]);
@ -638,10 +691,14 @@ static const JanetReg threadlib_cfuns[] = {
},
{
"thread/new", cfun_thread_new,
JDOC("(thread/new func &opt capacity)\n\n"
JDOC("(thread/new func &opt capacity flags)\n\n"
"Start a new thread that will start immediately. "
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
"Can optionally provide flags to the new thread - supported flags are:\n"
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
"\t:a - Allow sending over registered abstract types to the new thread\n"
"\t:c - Send over cfunction information to the new thread.\n"
"Returns a handle to the new thread.")
},
{

View File

@ -33,6 +33,7 @@
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
@ -929,7 +930,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
janet_stack_frame(stack)->pc = pc;
if (janet_fiber_funcframe(fiber, func)) {
@ -968,7 +969,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
if (janet_fiber_funcframe_tail(fiber, func)) {
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
@ -1419,6 +1420,8 @@ int janet_init(void) {
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Dynamic bindings */
janet_vm_top_dyns = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);
/* Fibers */
@ -1449,6 +1452,7 @@ void janet_deinit(void) {
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
janet_vm_top_dyns = NULL;
free(janet_vm_traversal_base);
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;

View File

@ -1373,6 +1373,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);

View File

@ -307,4 +307,22 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
(defn check-jdn [x]
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
(check-jdn 0)
(check-jdn nil)
(check-jdn [])
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
(check-jdn -0.123123123123)
(check-jdn 12837192371923)
(check-jdn "a string")
(check-jdn @"a buffer")
# Issue 428
(var result nil)
(defn f [] (yield {:a :ok}))
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
(assert (= result :ok) "issue 428 2")
(end-suite)

33
tools/patch-jpm.janet Normal file
View File

@ -0,0 +1,33 @@
# Patch jpm to have the correct paths for the current install.
# usage: janet patch-jpm.janet output --libdir=/usr/local/lib/x64-linux/ --binpath
(def- argpeg
(peg/compile
'(* "--" '(to "=") "=" '(any 1))))
(def- args (tuple/slice (dyn :args) 3))
(def- len (length args))
(var i :private 0)
(def install-paths @{})
# Get flags
(each a args
(if-let [m (peg/match argpeg a)]
(let [[key value] m]
(put install-paths (keyword key) value))))
(def- replace-peg
(peg/compile
~(% (* '(to "###START###")
(constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
(thru "###END###")
'(any 1)))))
(def source (slurp ((dyn :args) 1)))
(def newsource (0 (peg/match replace-peg source)))
(spit ((dyn :args) 2) newsource)
(unless (= :windows (os/which))
(os/shell (string `chmod +x "` ((dyn :args) 2) `"`)))