1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-06 18:43:04 +00:00

Compare commits

..

57 Commits

Author SHA1 Message Date
Calvin Rose
2bf5e341d3 Update for 1.12.1 2020-09-07 16:10:33 -05:00
Calvin Rose
b53890ddae Make some changes for WASM build. 2020-09-07 16:08:43 -05:00
Calvin Rose
93602ad9ea Prepare 1.12.0 Release. 2020-09-07 15:28:46 -05:00
Calvin Rose
ff57b3eb72 Make zero?, one?, neg? and pos? polymorphic. 2020-09-06 19:05:58 -05:00
Calvin Rose
1837e89fe4 Address #470 - hyphen's in native module names. 2020-09-06 15:23:24 -05:00
Calvin Rose
24b8b0e382 Fix NaNboxing bug that cause flaky builds.
The macro janet_checktype(x, JANET_NUMBER) was incorrect when
x was NaN. This caused the initial unmarshalling dictionary to be missing
entries in certain cases.
2020-09-06 14:59:29 -05:00
Calvin Rose
321a758ab9 Change hash implementation for pointers. 2020-09-06 11:41:45 -05:00
Calvin Rose
1a9c14acde Add checksum to build/janet.c to check for inconsistent builds. 2020-09-06 11:04:07 -05:00
Calvin Rose
e8734c77b4 Fix bug by casting to unsigned char.
Higher unciode codepoints where being read as negative char values.
We need to cast to unsigned char before comparing to 0x20 to check
for unprintable characters.
2020-09-06 10:47:05 -05:00
Calvin Rose
1eb00a9f74 Remove restriction on bytes being input to getline. 2020-09-06 10:36:38 -05:00
Calvin Rose
922a21d359 Run make format. 2020-09-05 21:26:21 -05:00
Calvin Rose
4a4f314768 Update changelog. 2020-09-05 20:23:55 -05:00
Calvin Rose
3c64596ea1 Add %t formatter to janet.
Was not present in printf and family.
2020-09-05 20:21:49 -05:00
Calvin Rose
33283b1b6e Change linking process for standalone executables.
We separate compilation and linking so that mixed C/C++ binaries
will work.
2020-09-05 10:19:34 -05:00
Calvin Rose
2f89bdc672 Conditional compilation on some c99 syntax in header.
If the header is in a C++11 compilation unit, use C++11
aggregate initialization syntax instead.
2020-09-05 09:45:34 -05:00
Calvin Rose
2d275c4782 Enable exception handling for C++ with MSVC. 2020-09-04 21:43:34 -05:00
Calvin Rose
25156eb83e For #469 - Add support for C++ and mixed C/C++
WIP and for native modules. Required a few changes to headers and
some changes to JPM.
2020-09-04 17:41:36 -05:00
Calvin Rose
39032b45c9 Remove extra file. 2020-09-04 14:55:47 -05:00
Calvin Rose
821a8dca3b Fix os/spawn - os/execute switch. 2020-09-04 14:54:58 -05:00
Calvin Rose
0145b133a1 Add os/spawn instead of os/execute with :a 2020-09-04 08:09:05 -05:00
Calvin Rose
b0b137d7f0 Apply formatting to windows changes. 2020-09-02 19:12:27 -05:00
Calvin Rose
b0c09153c2 Allow IO redirection on windows. 2020-09-02 19:07:45 -05:00
Calvin Rose
0485078c6c Fix some issues on BSD and Windows. 2020-09-01 21:47:08 -05:00
Calvin Rose
7079cc43c9 Make some improvements and add os/proc-kill as well. 2020-09-01 21:36:49 -05:00
Calvin Rose
e7fca0051e Add :a option to os/execute, and allow redirecting stdio.
This should help cover a number of common cases for
use of subprocesses. This should also eventually work well
with the ev branch via
2020-09-01 20:06:35 -05:00
Calvin Rose
6273e56886 Add janet_getjfile to C API. 2020-08-29 17:36:14 -05:00
Calvin Rose
8b9ad2dce8 Add :x flag to os/execute. 2020-08-29 10:27:32 -05:00
Calvin Rose
301cbb0e68 Update changelog 2020-08-29 09:22:10 -05:00
Calvin Rose
5313963baf Don't run main when flychecking. 2020-08-29 09:05:18 -05:00
Calvin Rose
f60348eee4 Merge branch 'master' of github.com:janet-lang/janet into master 2020-08-27 08:20:31 -05:00
Calvin Rose
a31e079f93 Fix import macro to not coerce everything to string. 2020-08-27 08:19:41 -05:00
Calvin Rose
556edc9f0d Fix import macro to not coerce everything to string. 2020-08-27 07:46:51 -05:00
Calvin Rose
5dda83dc73 Add second argument to disasm. 2020-08-22 16:18:10 -05:00
Calvin Rose
28439d822a Add cancel function.
This should allow better stack unwinding on a fiber that
no longer needs to complete.
2020-08-22 15:35:37 -05:00
Calvin Rose
b1d8ee19ca Enable mutliline paste in shell.c with TCSADRAIN.
Replaces TCSAFLUSH.
2020-08-22 11:39:57 -05:00
Calvin Rose
f7c556ed8d Add curenv to core. 2020-08-22 10:16:14 -05:00
Calvin Rose
5377e10532 Address #466?
Do not restore pc when returning from top most fiber frame.

Also add JANET_DEBUG config define for various debugging related
configurations. In fiber.c, when debug is enabled we reallocate the
entire stack everytime we push a frame to help uncover use after free
errors.
2020-08-17 07:01:58 -05:00
Calvin Rose
58374623b7 Add a vm_commit before JOP_NEXT. 2020-08-13 22:28:50 -05:00
Calvin Rose
7e7498350f Fix #463
Fix outdated code in macex1, such as checking for unquote-splicing,
    which no longer exists. Also fix macex1 for quasiquoted tables and
    structs. macex1 is not the macro expander used by the compiler, so
    these bugs only affected code which called macex manually, such as
    the short-fn macro.
2020-08-12 06:10:42 -05:00
Calvin Rose
06c268c274 Start working on throwing errors from async functions. 2020-08-11 08:33:24 -05:00
Calvin Rose
9b36e2b145 Be aggressive with setting SO_NOSIGPIPE on BSD/Apple. 2020-08-10 18:59:53 -05:00
Calvin Rose
ca75f8dc20 Address #463 - prevent sigpipe on client connections.
We erroneously did not set SO_NOSIGPIPE on connections aquired with
net/connect, only those quired thorugh net/server. This meant that
failed writes by a client could send sigpipe.
2020-08-10 18:45:44 -05:00
Calvin Rose
6f2f3fdb68 Return an error message if writes fail. Address #462. 2020-08-10 11:06:31 -05:00
Calvin Rose
c903e49a4f Change feature flags for BSD. 2020-08-10 10:42:56 -05:00
Calvin Rose
9121feb44f Update changelog.` 2020-08-09 11:39:40 -05:00
Calvin Rose
7b42ed66f2 Add xprint, xprin, xprintf, and xprinf. 2020-08-09 09:30:58 -05:00
Calvin Rose
c3af30d520 Fix broken links in README.md 2020-08-07 19:48:06 -05:00
Calvin Rose
2598123140 Rename test suites such that it is easier to add more of them. 2020-08-07 15:34:13 -05:00
Calvin Rose
40627191f3 Merge pull request #460 from andrewchambers/fix
Add missing JANET_API to janet_cryptorand.
2020-08-07 11:46:44 -05:00
Andrew Chambers
38dc844e85 Add missing JANET_API to janet_cryptorand. 2020-08-07 14:02:26 +12:00
Calvin Rose
abc4405a76 Address #459 - Update meson.build
Don't search for cross compilerUnless needed.
This should help prevent issues building Meson on debian. Also
fix issue using the wrong set of flags to build the native janet
interpreter vs. the cross compiled janet interpreter.
2020-08-06 20:45:18 -05:00
Calvin Rose
243c66442d Add PRF enabled build to sourcehut builds. 2020-08-04 10:30:54 -05:00
Calvin Rose
9afcec77f6 Disable PRF by default. 2020-08-03 21:52:57 -05:00
Calvin Rose
70ad98cc6f Fix arc4random_buf implementation. 2020-08-03 21:49:49 -05:00
Calvin Rose
76cfbde933 Add JANET_HASHSEED environment variable. 2020-08-03 20:56:11 -05:00
Calvin Rose
f200bd9594 Merge pull request #455 from andrewchambers/prfseed
Initialize PRF with random data when it is enabled.
2020-08-03 20:14:51 -05:00
Andrew Chambers
4d4ca7bb36 Initialize PRF with random data when it is enabled. 2020-08-04 12:13:36 +12:00
47 changed files with 1254 additions and 347 deletions

15
.builds/meson2.yml Normal file
View File

@@ -0,0 +1,15 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dprf=true
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@@ -19,5 +19,4 @@ tasks:
meson configure -Dint_types=false
meson configure -Dtyped_array=false
meson configure -Dreduced_os=true
meson configure -Dprf=false
ninja # will not pass tests but should build

4
.gitignore vendored
View File

@@ -61,6 +61,10 @@ tags
vgcore.*
*.out.*
# Wix artifacts
*.msi
*.wixpdb
# Created by https://www.gitignore.io/api/c
### C ###

View File

@@ -1,9 +1,38 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.11.2 - 2020-08-03
## 1.12.1 - 2020-09-07
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
- Add C++ support to jpm and improve C++ interop in janet.h.
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
- Expose `janet_cfuns_prefix` in C API.
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
- Add `janet_getjfile` to C API.
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
When called like this, `os/execute` returns immediately.
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
- Don't run `main` when flychecking.
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
- Fix import macro to not try and coerce everything to a string.
- Allow passing a second argument to `disasm`.
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
- Allow multi-line paste into built in repl.
- Add `(curenv)`.
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
to raise errors or other signals.
- Update meson build script to fix bug on Debian's version of meson
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
- `net/write` now raises an error message if write fails.
- Fix issue with SIGPIPE on macOS and BSDs.
## 1.11.3 - 2020-08-03
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
- Expose `janet_cryptorand` in C API.
- Properly initialize PRF in default janet program
- Add `index-of` to core library.
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
- Fix defaults on Windows for ARM
- Fix defaults on NetBSD.

View File

@@ -149,13 +149,14 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
# Now the reason we bootstrap in the first place
build/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
cksum $@
########################
##### Amalgamation #####
########################
SONAME=libjanet.so.1.11
SONAME=libjanet.so.1.12
build/shell.c: src/mainclient/shell.c
cp $< $@

View File

@@ -2,10 +2,10 @@
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">

View File

@@ -213,5 +213,13 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time.
.RE
.B JANET_HASHSEED
.RS
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
cannot be defined for this variable to have an effect.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

153
jpm
View File

@@ -132,6 +132,15 @@
"Convert url with potential bad characters into a file path element."
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
(def- entry-replacer
"Convert url with potential bad characters into an entry-name"
(peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_")))))))
(defn entry-replace
"Escape special characters in the entry-name"
[name]
(get (peg/match entry-replacer name) 0))
(defn filepath-replace
"Remove special characters from a string or path
to make it into a path segment."
@@ -323,7 +332,9 @@
#
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
(def default-cpp-compiler (or (os/getenv "CXX") (if is-win "cl.exe" "c++")))
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
(def default-cpp-linker (or (os/getenv "CXX") (if is-win "link.exe" "c++")))
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
# Detect threads
@@ -352,6 +363,10 @@
(if is-win
["/nologo" "/MD"]
["-std=c99" "-Wall" "-Wextra"]))
(def default-cppflags
(if is-win
["/nologo" "/MD" "/EHsc"]
["-std=c++11" "-Wall" "-Wextra"]))
(def default-ldflags [])
# Required flags for dynamic libraries. These
@@ -424,29 +439,54 @@
(string "-I" (dyn :headerpath JANET_HEADERPATH))
(string "-O" (opt opts :optimize 2))])
(defn- getcppflags
"Generate the cpp flags from the input options."
[opts]
@[;(opt opts :cppflags default-cppflags)
(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."
[name]
(string "janet_module_entry_" (filepath-replace name)))
(string "janet_module_entry_" (entry-replace name)))
(defn- compile-c
"Compile a C file into an object file."
[opts src dest &opt static?]
(def cc (opt opts :compiler default-compiler))
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
(def entry-defines (if-let [n (opts :entry-name)]
(def entry-defines (if-let [n (and static? (opts :entry-name))]
[(make-define "JANET_ENTRY_NAME" n)]
[]))
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(check-cc)
(print "compiling " dest "...")
(print "compiling " src " to " dest "...")
(create-dirs dest)
(if is-win
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cc "-c" src ;defines ;cflags "-o" dest))))
(defn- compile-cpp
"Compile a C++ file into an object file."
[opts src dest &opt static?]
(def cpp (opt opts :cpp-compiler default-cpp-compiler))
(def cflags [;(getcppflags opts) ;(if static? [] dynamic-cflags)])
(def entry-defines (if-let [n (and static? (opts :entry-name))]
[(make-define "JANET_ENTRY_NAME" n)]
[]))
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(check-cc)
(print "compiling " src " to " dest "...")
(create-dirs dest)
(if is-win
(shell cpp ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cpp "-c" src ;defines ;cflags "-o" dest))))
(defn- libjanet
"Find libjanet.a (or libjanet.lib on windows) at compile time"
[]
@@ -466,7 +506,7 @@
(string hpath `\\janet.lib`))
(defn- link-c
"Link object files together to make a native module."
"Link C object files together to make a native module."
[opts target & objects]
(def linker (opt opts (if is-win :linker :compiler) default-linker))
(def cflags (getcflags opts))
@@ -481,6 +521,22 @@
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
(defn- link-cpp
"Link C++ object files together to make a native module."
[opts target & objects]
(def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
(def cflags (getcppflags opts))
(def lflags [;(opt opts :lflags default-lflags)
;(if (opts :static) [] dynamic-lflags)])
(def ldflags [;(opt opts :ldflags [])])
(rule target objects
(check-cc)
(print "linking " target "...")
(create-dirs target)
(if is-win
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
(defn- archive-c
"Link object files together to make a static library."
[opts target & objects]
@@ -535,6 +591,23 @@
```
int main(int argc, const char **argv) {
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
char *envvar = getenv("JANET_HASHSEED");
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
}
janet_init_hash_key(hash_key);
#endif
janet_init();
/* Get core env */
@@ -638,10 +711,12 @@ int main(int argc, const char **argv) {
(table/setproto m oldproto))
# Find static modules
(var has-cpp false)
(def declarations @"")
(def lookup-into-invocations @"")
(loop [[prefix name] :pairs prefixes]
(def meta (eval-string (slurp (modpath-to-meta name))))
(if (meta :cpp) (set has-cpp true))
(buffer/push-string lookup-into-invocations
" temptab = janet_table(0);\n"
" temptab->proto = env;\n"
@@ -664,17 +739,33 @@ int main(int argc, const char **argv) {
(create-buffer-c-impl image cimage_dest "janet_payload_image")
# Append main function
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
(def oimage_dest (out-path cimage_dest ".c" ".o"))
# Compile and link final exectable
(unless no-compile
(def cc (opt opts :compiler default-compiler))
(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) ;janet-cflags])
(def defines (make-defines (opt opts :defines {})))
(print "compiling and linking " dest "...")
(def cc (opt opts :compiler default-compiler))
(def cflags [;(getcflags opts) ;janet-cflags])
(check-cc)
(print "compiling " cimage_dest " to " oimage_dest "...")
(create-dirs oimage_dest)
(if is-win
(shell cc ;cflags ;ldflags cimage_dest ;lflags `/link` (string "/OUT:" dest))
(shell cc ;cflags ;ldflags `-o` dest cimage_dest ;lflags)))))
(shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest)
(shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest))
(if has-cpp
(let [linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
cppflags [;(getcppflags opts) ;janet-cflags]]
(print "linking " dest "...")
(if is-win
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
(shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags)))
(let [linker (opt opts (if is-win :linker :compiler) default-linker)]
(print "linking " dest "...")
(create-dirs dest)
(if is-win
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
(shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags)))))))
#
# Installation and Dependencies
@@ -836,9 +927,23 @@ int main(int argc, const char **argv) {
# Make dynamic module
(def lname (string "build" sep name modext))
(loop [src :in sources]
(compile-c opts src (out-path src ".c" objext)))
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
# Get objects to build with
(var has-cpp false)
(def objects
(seq [src :in sources]
(cond
(string/has-suffix? ".cpp" src)
(let [op (out-path src ".cpp" objext)]
(compile-cpp opts src op)
(set has-cpp true)
op)
(string/has-suffix? ".c" src)
(let [op (out-path src ".c" objext)]
(compile-c opts src op)
op)
(errorf "unknown source file type: %s, expected .c or .cpp"))))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (out-path src ".janet" ".janet.c"))
@@ -846,7 +951,7 @@ int main(int argc, const char **argv) {
(array/push objects o-src)
(create-buffer-c src c-src (embed-name src))
(compile-c opts c-src o-src)))
(link-c opts lname ;objects)
((if has-cpp link-cpp link-c) opts lname ;objects)
(add-dep "build" lname)
(install-rule lname path)
@@ -859,6 +964,7 @@ int main(int argc, const char **argv) {
"# Metadata for static library %s\n\n%.20p"
(string name statext)
{:static-entry ename
:cpp has-cpp
:ldflags ~',(opts :ldflags)
:lflags ~',(opts :lflags)})))
(add-dep "build" metaname)
@@ -870,9 +976,21 @@ int main(int argc, const char **argv) {
(def opts (merge @{:entry-name ename} opts))
(def sobjext (string ".static" objext))
(def sjobjext (string ".janet" sobjext))
(loop [src :in sources]
(compile-c opts src (out-path src ".c" sobjext) true))
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
# Get static objects
(def sobjects
(seq [src :in sources]
(cond
(string/has-suffix? ".cpp" src)
(let [op (out-path src ".cpp" sobjext)]
(compile-cpp opts src op true)
op)
(string/has-suffix? ".c" src)
(let [op (out-path src ".c" sobjext)]
(compile-c opts src op true)
op)
(errorf "unknown source file type: %s, expected .c or .cpp"))))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (out-path src ".janet" ".janet.c"))
@@ -1122,7 +1240,8 @@ Keys are:
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
--archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows).
--cpp-compiler : C++ compiler to use for natives. Defaults to $CXX or c++ (cl.exe on windows).
--archiver : C archiver to use for static libraries. Defaults to $AR ar (lib.exe on windows).
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
other platforms.
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git

6
jpm.1
View File

@@ -71,9 +71,13 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
.TP
.BR \-\-compiler=$CC
Sets the compiler used for compiling native modules and standalone executables. Defaults
Sets the C compiler used for compiling native modules and standalone executables. Defaults
to cc.
.BR \-\-cpp\-compiler=$CXX
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
to c++..
.TP
.BR \-\-linker
Sets the linker used to create native modules and executables. Only used on windows, where

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.11.2')
version : '1.12.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -71,6 +71,7 @@ conf.set('JANET_STACK_MAX', get_option('stack_max'))
conf.set('JANET_NO_UMASK', not get_option('umask'))
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@@ -178,30 +179,28 @@ libjanet = library('janet', janetc,
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
native_cc = meson.get_compiler('c', native: true)
cross_cc = meson.get_compiler('c', native: false)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
else
extra_native_cflags = []
extra_cflags = []
endif
if cross_cc.has_argument('-fvisibility=hidden')
extra_cross_cflags = ['-fvisibility=hidden']
else
extra_cross_cflags = []
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_native_cflags,
c_args : extra_cflags,
install : true)
if meson.is_cross_build()
native_cc = meson.get_compiler('c', native: true)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
else
extra_native_cflags = []
endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_cross_cflags,
c_args : extra_native_cflags,
native : true)
else
janet_nativeclient = janet_mainclient
@@ -216,16 +215,17 @@ docs = custom_target('docs',
# Tests
test_files = [
'test/suite0.janet',
'test/suite1.janet',
'test/suite2.janet',
'test/suite3.janet',
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet',
'test/suite7.janet',
'test/suite8.janet',
'test/suite9.janet'
'test/suite0000.janet',
'test/suite0001.janet',
'test/suite0002.janet',
'test/suite0003.janet',
'test/suite0004.janet',
'test/suite0005.janet',
'test/suite0006.janet',
'test/suite0007.janet',
'test/suite0008.janet',
'test/suite0009.janet',
'test/suite0010.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())

View File

@@ -15,6 +15,7 @@ option('net', type : 'boolean', value : true)
option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

View File

@@ -7,6 +7,8 @@
###
###
(def root-env "The root environment used to create environments with (make-env)" _env)
(def defn :macro
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
(fn defn [name & more]
@@ -81,10 +83,6 @@
(defn nan? "Check if x is NaN" [x] (not= x x))
(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
(defn zero? "Check if x is zero." [x] (= x 0))
(defn pos? "Check if x is greater than 0." [x] (> x 0))
(defn neg? "Check if x is less than 0." [x] (< x 0))
(defn one? "Check if x is equal to 1." [x] (= x 1))
(defn number? "Check if x is a number." [x] (= (type x) :number))
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
(defn string? "Check if x is a string." [x] (= (type x) :string))
@@ -567,15 +565,6 @@
[head & body]
(loop1 body head 0))
(put _env 'loop1 nil)
(put _env 'check-indexed nil)
(put _env 'for-template nil)
(put _env 'for-var-template nil)
(put _env 'iterate-template nil)
(put _env 'each-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.
See loop for details."
@@ -594,6 +583,16 @@
[& body]
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
(defmacro- undef
"Remove binding from root-env"
[& syms]
~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
(undef _env)
(undef loop1 check-indexed for-template for-var-template iterate-template
each-template range-template loop-fiber-template)
(defn sum
"Returns the sum of xs. If xs is empty, returns 0."
[xs]
@@ -619,7 +618,7 @@
the fal form. Bindings have the same syntax as the let macro."
[bindings tru &opt fal]
(def len (length bindings))
(if (zero? len) (error "expected at least 1 binding"))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(defn aux [i]
(if (>= i len)
@@ -749,7 +748,12 @@
[& xs]
(compare-reduce >= xs))
(put _env 'compare-reduce nil)
(defn zero? "Check if x is zero." [x] (= (compare x 0) 0))
(defn pos? "Check if x is greater than 0." [x] (= (compare x 0) 1))
(defn neg? "Check if x is less than 0." [x] (= (compare x 0) -1))
(defn one? "Check if x is equal to 1." [x] (= (compare x 1) 0))
(undef compare-reduce)
###
###
@@ -785,8 +789,8 @@
[a &opt by]
(sort-help a 0 (- (length a) 1) (or by <)))
(put _env 'sort-part nil)
(put _env 'sort-help nil)
(undef sort-part)
(undef sort-help)
(defn sort-by
"Returns a new sorted array that compares elements by invoking
@@ -1140,8 +1144,8 @@
:tuple (tuple/slice (walk-ind f form))
form))
(put _env 'walk-ind nil)
(put _env 'walk-dict nil)
(undef walk-ind)
(undef walk-dict)
(defn postwalk
"Do a post-order traversal of a data structure and call (f x)
@@ -1350,7 +1354,7 @@
[tab & colls]
(loop [c :in colls
key :keys c]
(set (tab key) (in c key)))
(put tab key (in c key)))
tab)
(defn merge
@@ -1361,7 +1365,7 @@
(def container @{})
(loop [c :in colls
key :keys c]
(set (container key) (in c key)))
(put container key (in c key)))
container)
(defn keys
@@ -1615,9 +1619,9 @@
,(aux (+ 2 i))
,$res)))) 0)))
(put _env 'sentinel nil)
(put _env 'match-1 nil)
(put _env 'with-idemp nil)
(undef sentinel)
(undef match-1)
(undef with-idemp)
###
###
@@ -1742,8 +1746,8 @@
[&opt sym]
~(,doc* ',sym))
(put _env 'env-walk nil)
(put _env 'print-index nil)
(undef env-walk)
(undef print-index)
###
###
@@ -1804,14 +1808,16 @@
(defn expandqq [t]
(defn qq [x]
(case (type x)
:tuple (do
(def x0 (in x 0))
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
(tuple x0 (recur (in x 1)))
(tuple/slice (map qq x))))
:tuple (if (= :brackets (tuple/type x))
~[,;(map qq x)]
(do
(def x0 (get x 0))
(if (= 'unquote x0)
(tuple x0 (recur (get x 1)))
(tuple/slice (map qq x)))))
:array (map qq x)
:table (table (map qq (kvs x)))
:struct (struct (map qq (kvs x)))
:table (table ;(map qq (kvs x)))
:struct (struct ;(map qq (kvs x)))
x))
(tuple (in t 0) (qq (in t 1))))
@@ -1875,7 +1881,7 @@
(case tx
:tuple (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
:array (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
:struct (deep-not= (pairs x) (pairs y))
:struct (deep-not= (kvs x) (kvs y))
:table (deep-not= (table/to-struct x) (table/to-struct y))
:buffer (not= (string x) (string y))
(not= x y))))
@@ -2030,7 +2036,7 @@
will inherit bindings from the parent environment, but new
bindings will not pollute the parent environment."
[&opt parent]
(def parent (if parent parent _env))
(def parent (if parent parent root-env))
(def newenv (table/setproto @{} parent))
newenv)
@@ -2067,6 +2073,14 @@
(if ec "\e[0m" "")))
(eflush))
(defn curenv
"Get the current environment table. Same as (fiber/getenv (fiber/current)). If n
is provided, gets the nth prototype of the environment table."
[&opt n]
(var e (fiber/getenv (fiber/current)))
(if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
e)
(defn run-context
"Run a context. This evaluates expressions in an environment,
and is encapsulates the parsing, compilation, and evaluation.
@@ -2238,10 +2252,11 @@
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
@{})
(def comptime
(defmacro comptime
"(comptime x)\n\n
Evals x at compile time and returns the result. Similar to a top level unquote."
:macro eval)
[x]
(eval x))
(defn make-image
"Create an image from an environment returned by require.
@@ -2295,7 +2310,7 @@
(module/add-paths ".jimage" :image)
# Version of fexists that works even with a reduced OS
(if-let [has-stat (_env 'os/stat)]
(if-let [has-stat (root-env 'os/stat)]
(let [stat (has-stat :value)]
(defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
(defglobal "fexists"
@@ -2342,10 +2357,10 @@
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))
(put _env 'fexists nil)
(put _env 'mod-filter nil)
(put _env 'check-. nil)
(put _env 'not-check-. nil)
(undef fexists)
(undef mod-filter)
(undef check-.)
(undef not-check-.)
(def module/cache
"Table mapping loaded module identifiers to their environments."
@@ -2453,7 +2468,7 @@
(def newv (table/setproto @{:private (not ep)} v))
(put env (symbol prefix k) newv)))
(put _env 'require-1 nil)
(undef require-1)
(defmacro import
"Import a module. First requires the module, and then merges its
@@ -2465,7 +2480,8 @@
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
module cache."
[path & args]
(def argm (map |(if (keyword? $) $ (string $)) args))
(def ps (partition 2 args))
(def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
(tuple import* (string path) ;argm))
(defmacro use
@@ -2519,7 +2535,7 @@
(in (.slots frame-idx) (or nth 0)))
# Conditional compilation for disasm
(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
(defn .disasm
"Gets the assembly for the current function."
@@ -2581,13 +2597,9 @@
(debug/unfbreak fun i))
(print "Cleared " (length bytecode) " breakpoints in " fun))
(unless (get _env 'disasm)
(put _env '.disasm nil)
(put _env '.bytecode nil)
(put _env '.breakall nil)
(put _env '.clearall nil)
(put _env '.ppasm nil))
(put _env 'disasm-alias nil)
(unless (get root-env 'disasm)
(undef .disasm .bytecode .breakall .clearall .ppasm))
(undef disasm-alias)
(defn .source
"Show the source code for the function being debugged."
@@ -2641,9 +2653,9 @@
"An environment that contains dot prefixed functions for debugging."
@{})
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
(put _env 'debugger-keys nil)
(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))
(undef debugger-keys)
###
###
@@ -2739,7 +2751,7 @@
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
# conditional compilation for reduced os
(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn cli-main
"Entrance for the Janet CLI tool. Call this functions with the command line
@@ -2848,9 +2860,10 @@
(def subargs (array/slice args i))
(put env :args subargs)
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env)
(if-let [main (get (in env 'main) :value)]
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
(if (function? thunk) (thunk) (error (thunk :error)))))
(unless *compile-only*
(if-let [main (get (in env 'main) :value)]
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
(if (function? thunk) (thunk) (error (thunk :error))))))
(set i lenargs))))
(when (and (not *compile-only*) (or *should-repl* *no-file*))
@@ -2873,12 +2886,7 @@
(setdyn :err-color (if *colorize* true))
(repl getchunk nil env)))
(put _env 'no-side-effects nil)
(put _env 'is-safe-def nil)
(put _env 'safe-forms nil)
(put _env 'importers nil)
(put _env 'use-2 nil)
(put _env 'getenv-alias nil)
(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
###
###
@@ -2886,12 +2894,13 @@
###
###
(def root-env "The root environment used to create environments with (make-env)" _env)
(do
(put _env 'boot/opts nil)
(put _env '_env nil)
(def load-dict (env-lookup _env))
(undef boot/opts undef)
(def load-dict (env-lookup root-env))
(put load-dict 'boot/config nil)
(put load-dict 'boot/args nil)
(each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil)))
(merge-into load-image-dict load-dict)
(merge-into make-image-dict (invert load-dict)))
@@ -2912,25 +2921,29 @@
(put into k (x k))))
into)
(def env (fiber/getenv (fiber/current)))
# Modify env based on some options.
(loop [[k v] :pairs env
(loop [[k v] :pairs root-env
:when (symbol? k)]
(def flat (proto-flatten @{} v))
(when (boot/config :no-docstrings)
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
(put flat :source-map nil))
(put env k flat))
(put root-env k flat))
(put env 'boot/config nil)
(put env 'boot/args nil)
(def image (let [env-pairs (pairs (env-lookup env))
(put root-env 'boot/config nil)
(put root-env 'boot/args nil)
(def image (let [env-pairs (pairs (env-lookup root-env))
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
lookup (table ;(mapcat identity essential-pairs))
reverse-lookup (invert lookup)]
(marshal env reverse-lookup)))
# Check no duplicate values
(def temp @{})
(eachp [k v] lookup
(if (in temp v) (errorf "duplicate value: %v" v))
(put temp v k))
(marshal root-env reverse-lookup)))
# Create amalgamation

View File

@@ -23,6 +23,7 @@
#include <janet.h>
#include <assert.h>
#include <stdio.h>
#include <math.h>
#include "tests.h"
@@ -44,6 +45,11 @@ int system_test() {
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
#ifdef NAN
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
#else
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
#endif
assert(NULL != &janet_wrap_nil);

View File

@@ -27,10 +27,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 11
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_MINOR 12
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.11.2"
#define JANET_VERSION "1.12.1"
/* #define JANET_BUILD "local" */
@@ -57,6 +57,7 @@
/* #define JANET_NO_UMASK */
/* Other settings */
/* #define JANET_DEBUG */
/* #define JANET_PRF */
/* #define JANET_NO_UTC_MKTIME */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */

View File

@@ -73,6 +73,7 @@ static const JanetInstructionDef janet_ops[] = {
{"call", JOP_CALL},
{"clo", JOP_CLOSURE},
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
@@ -840,85 +841,110 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
return janet_wrap_nil();
}
Janet janet_disasm(JanetFuncDef *def) {
int32_t i;
/*
* Disasm sections
*/
static Janet janet_disasm_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->arity);
}
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->min_arity);
}
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->max_arity);
}
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
return janet_wrap_integer(def->slotcount);
}
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
JanetArray *bcode = janet_array(def->bytecode_length);
JanetArray *constants;
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_ckeywordv("arity"), janet_wrap_integer(def->arity));
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_wrap_integer(def->min_arity));
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_wrap_integer(def->max_arity));
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_wrap_array(bcode));
if (NULL != def->source) {
janet_table_put(ret, janet_ckeywordv("source"), janet_wrap_string(def->source));
}
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
janet_table_put(ret, janet_ckeywordv("vararg"), janet_wrap_true());
}
if (NULL != def->name) {
janet_table_put(ret, janet_ckeywordv("name"), janet_wrap_string(def->name));
}
/* Add constants */
if (def->constants_length > 0) {
constants = janet_array(def->constants_length);
janet_table_put(ret, janet_ckeywordv("constants"), janet_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
constants->data[i] = def->constants[i];
}
constants->count = def->constants_length;
}
/* Add bytecode */
for (i = 0; i < def->bytecode_length; i++) {
for (int32_t i = 0; i < def->bytecode_length; i++) {
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
}
bcode->count = def->bytecode_length;
return janet_wrap_array(bcode);
}
/* Add source map */
if (NULL != def->sourcemap) {
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_wrap_array(sourcemap));
static Janet janet_disasm_source(JanetFuncDef *def) {
if (def->source != NULL) return janet_wrap_string(def->source);
return janet_wrap_nil();
}
static Janet janet_disasm_name(JanetFuncDef *def) {
if (def->name != NULL) return janet_wrap_string(def->name);
return janet_wrap_nil();
}
static Janet janet_disasm_vararg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
}
static Janet janet_disasm_constants(JanetFuncDef *def) {
JanetArray *constants = janet_array(def->constants_length);
for (int32_t i = 0; i < def->constants_length; i++) {
constants->data[i] = def->constants[i];
}
constants->count = def->constants_length;
return janet_wrap_array(constants);
}
/* Add environments */
if (NULL != def->environments) {
JanetArray *envs = janet_array(def->environments_length);
for (i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
janet_table_put(ret, janet_ckeywordv("environments"), janet_wrap_array(envs));
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
if (NULL == def->sourcemap) return janet_wrap_nil();
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
return janet_wrap_array(sourcemap);
}
/* Add closures */
/* Funcdefs cannot be recursive */
if (NULL != def->defs) {
JanetArray *defs = janet_array(def->defs_length);
for (i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
janet_table_put(ret, janet_ckeywordv("defs"), janet_wrap_array(defs));
static Janet janet_disasm_environments(JanetFuncDef *def) {
JanetArray *envs = janet_array(def->environments_length);
for (int32_t i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
return janet_wrap_array(envs);
}
/* Add slotcount */
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_wrap_integer(def->slotcount));
static Janet janet_disasm_defs(JanetFuncDef *def) {
JanetArray *defs = janet_array(def->defs_length);
for (int32_t i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
return janet_wrap_array(defs);
}
Janet janet_disasm(JanetFuncDef *def) {
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(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("vararg"), janet_disasm_vararg(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("constants"), janet_disasm_constants(def));
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
return janet_wrap_struct(janet_table_to_struct(ret));
}
/* C Function for assembly */
static Janet cfun_asm(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 1);
janet_fixarity(argc, 1);
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
if (res.status != JANET_ASSEMBLE_OK) {
@@ -928,9 +954,26 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
}
static Janet cfun_disasm(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 1);
janet_arity(argc, 1, 2);
JanetFunction *f = janet_getfunction(argv, 0);
return janet_disasm(f->def);
if (argc == 2) {
JanetKeyword kw = janet_getkeyword(argv, 1);
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(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, "vararg")) return janet_disasm_vararg(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, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
janet_panicf("unknown disasm key %v", argv[1]);
} else {
return janet_disasm(f->def);
}
}
static const JanetReg asm_cfuns[] = {
@@ -938,15 +981,29 @@ static const JanetReg asm_cfuns[] = {
"asm", cfun_asm,
JDOC("(asm assembly)\n\n"
"Returns a new function that is the compiled result of the assembly.\n"
"The syntax for the assembly can be found on the Janet website. Will throw an\n"
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
"to the return value of disasm. Will throw an\n"
"error on invalid assembly.")
},
{
"disasm", cfun_disasm,
JDOC("(disasm func)\n\n"
JDOC("(disasm func &opt field)\n\n"
"Returns assembly that could be used be compile the given function.\n"
"func must be a function, not a c function. Will throw on error on a badly\n"
"typed argument.")
"typed argument. If given a field name, will only return that part of the function assembly.\n"
"Possible fields are:\n\n"
"\t:arity - number of required and optional arguments.\n"
"\t:min-arity - minimum number of arguments function can be called with.\n"
"\t:max-arity - maximum number of arguments function can be called with.\n"
"\t:vararg - true if function can take a variable number of arguments.\n"
"\t:bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
"\t:source - name of source file that this function was compiled from.\n"
"\t:name - name of function.\n"
"\t:slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
"\t:constants - an array of constants referenced by this function.\n"
"\t:sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
"\t:environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
"\t:defs - other function definitions that this function may instantiate.\n")
},
{NULL, NULL, NULL}
};

View File

@@ -103,6 +103,7 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS, /* JOP_NEXT */
JINT_SSS, /* JOP_NOT_EQUALS, */
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
JINT_SSS /* JOP_CANCEL, */
};
/* Verify some bytecode */

View File

@@ -231,6 +231,9 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
}
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
}
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
JanetCompiler *c = opts.compiler;
@@ -383,6 +386,7 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{fixarity2, do_cmp},
{fixarity2, do_cancel},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -61,6 +61,7 @@
#define JANET_FUN_MODULO 29
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
#define JANET_FUN_CANCEL 32
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@@ -946,6 +946,10 @@ static const uint32_t resume_asm[] = {
JOP_RESUME | (1 << 24),
JOP_RETURN
};
static const uint32_t cancel_asm[] = {
JOP_CANCEL | (1 << 24),
JOP_RETURN
};
static const uint32_t in_asm[] = {
JOP_IN | (1 << 24),
JOP_LOAD_NIL | (3 << 8),
@@ -1083,6 +1087,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
@@ -1209,7 +1218,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
}
/* Load core cfunctions (and some built in janet assembly functions) */
JanetTable *dict = janet_table(300);
JanetTable *dict = janet_table(512);
janet_load_libs(dict);
/* Add replacements */

View File

@@ -25,8 +25,15 @@
#ifndef JANET_FEATURES_H_defined
#define JANET_FEATURES_H_defined
#ifndef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 200809L
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|| defined(__bsdi__) || defined(__DragonFly__)
/* Use BSD soucre on any BSD systems, include OSX */
# define _BSD_SOURCE
#else
/* Use POSIX feature flags */
# ifndef _POSIX_C_SOURCE
# define _POSIX_C_SOURCE 200809L
# endif
#endif
#if defined(WIN32) || defined(_WIN32)

View File

@@ -85,6 +85,22 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
}
#ifdef JANET_DEBUG
/* Test for memory issues by reallocating fiber every time we push a stack frame */
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
int32_t n = fiber->capacity;
if (n) {
Janet *newData = malloc(sizeof(Janet) * n);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
free(fiber->data);
fiber->data = newData;
}
}
#endif
/* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
@@ -173,6 +189,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Nil unset stack arguments (Needed for gc correctness) */
@@ -305,6 +325,10 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
Janet *stack = fiber->data + fiber->frame;
@@ -367,6 +391,10 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Set the next frame */

View File

@@ -46,7 +46,8 @@
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
#define JANET_FIBER_MASK_USER 0x3FF0
#define JANET_FIBER_STATUS_MASK 0xFF0000
#define JANET_FIBER_RESUME_SIGNAL 0x800000
#define JANET_FIBER_STATUS_MASK 0x7F0000
#define JANET_FIBER_STATUS_OFFSET 16
#define JANET_FIBER_BREAKPOINT 0x1000000

View File

@@ -56,8 +56,8 @@ static int32_t checkflags(const uint8_t *str) {
int32_t flags = 0;
int32_t i;
int32_t len = janet_string_length(str);
if (!len || len > 3)
janet_panic("file mode must have a length between 1 and 3");
if (!len || len > 10)
janet_panic("file mode must have a length between 1 and 10");
switch (*str) {
default:
janet_panicf("invalid flag %c, expected w, a, or r", *str);
@@ -75,7 +75,7 @@ static int32_t checkflags(const uint8_t *str) {
for (i = 1; i < len; i++) {
switch (str[i]) {
default:
janet_panicf("invalid flag %c, expected + or b", str[i]);
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
break;
case '+':
if (flags & JANET_FILE_UPDATE) return -1;
@@ -85,6 +85,10 @@ static int32_t checkflags(const uint8_t *str) {
if (flags & JANET_FILE_BINARY) return -1;
flags |= JANET_FILE_BINARY;
break;
case 'n':
if (flags & JANET_FILE_NONIL) return -1;
flags |= JANET_FILE_NONIL;
break;
}
}
return flags;
@@ -112,11 +116,11 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
if (janet_string_length(fmode) != 1 ||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
flags = JANET_FILE_PIPED | checkflags(fmode);
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
}
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
} else {
fmode = (const uint8_t *)"r";
flags = JANET_FILE_PIPED | JANET_FILE_READ;
@@ -126,6 +130,8 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
#endif
FILE *f = popen((const char *)fname, (const char *)fmode);
if (!f) {
if (flags & JANET_FILE_NONIL)
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
return janet_wrap_nil();
}
return janet_makefile(f, flags);
@@ -155,7 +161,9 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
return f ? janet_makefile(f, flags) : janet_wrap_nil();
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
/* Read up to n bytes into buffer. */
@@ -282,6 +290,8 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
iof->flags |= JANET_FILE_CLOSED;
if (status == -1) janet_panic("could not close file");
return janet_wrap_integer(WEXITSTATUS(status));
#else
return janet_wrap_nil();
#endif
} else {
if (fclose(iof->file)) {
@@ -389,18 +399,16 @@ FILE *janet_dynfile(const char *name, FILE *def) {
return iofile->file;
}
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
FILE *f;
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
/* Other values simply do nothing */
return janet_wrap_nil();
janet_panicf("cannot print to %v", x);
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
for (int32_t i = 0; i < argc; ++i) {
for (int32_t i = offset; i < argc; ++i) {
janet_to_string_b(buf, argv[i]);
}
if (newline)
@@ -409,6 +417,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -419,7 +428,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
break;
}
}
for (int32_t i = 0; i < argc; ++i) {
for (int32_t i = offset; i < argc; ++i) {
int32_t len;
const uint8_t *vstr;
if (janet_checktype(argv[i], JANET_BUFFER)) {
@@ -432,7 +441,11 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
}
if (len) {
if (1 != fwrite(vstr, len, 1, f)) {
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
if (f == dflt_file) {
janet_panicf("cannot print %d bytes", len);
} else {
janet_panicf("cannot print %d bytes to %v", len, x);
}
}
}
}
@@ -441,6 +454,13 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
return janet_wrap_nil();
}
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_print(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
}
@@ -457,25 +477,33 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
FILE *f;
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
const char *fmt = janet_getcstring(argv, 0);
Janet x = janet_dyn(name);
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
FILE *f;
const char *fmt = janet_getcstring(argv, offset);
switch (janet_type(x)) {
default:
/* Other values simply do nothing */
return janet_wrap_nil();
janet_panicf("cannot print to %v", x);
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
janet_buffer_format(buf, fmt, 0, argc, argv);
janet_buffer_format(buf, fmt, offset, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
return janet_wrap_nil();
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -487,11 +515,11 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
}
}
JanetBuffer *buf = janet_buffer(10);
janet_buffer_format(buf, fmt, 0, argc, argv);
janet_buffer_format(buf, fmt, offset, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
if (buf->count) {
if (1 != fwrite(buf->data, buf->count, 1, f)) {
janet_panicf("could not print %d bytes to file", buf->count, name);
janet_panicf("could not print %d bytes to file", buf->count);
}
}
/* Clear buffer to make things easier for GC */
@@ -502,6 +530,14 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
return janet_wrap_nil();
}
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
janet_arity(argc, 1, -1);
Janet x = janet_dyn(name);
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
}
@@ -518,6 +554,16 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
@@ -631,6 +677,29 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"xprint", cfun_io_xprint,
JDOC("(xprint to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
"newline character. The value to print "
"to is the first argument, and is otherwise the same as print. Returns nil.")
},
{
"xprin", cfun_io_xprin,
JDOC("(xprin to & xs)\n\n"
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
"to is the first argument, and is otherwise the same as prin. Returns nil.")
},
{
"xprintf", cfun_io_xprintf,
JDOC("(xprint to fmt & xs)\n\n"
"Like printf but prints to an explicit file or value to. Returns nil.")
},
{
"xprinf", cfun_io_xprinf,
JDOC("(xprin to fmt & xs)\n\n"
"Like prinf but prints to an explicit file or value to. Returns nil.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
@@ -659,7 +728,8 @@ static const JanetReg io_cfuns[] = {
"\tw - allow writing to the file\n"
"\ta - append to the file\n"
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
"\t+ - append to the file instead of overwriting it\n"
"\tn - error if the file cannot be opened instead of returning nil")
},
{
"file/close", cfun_io_fclose,
@@ -719,6 +789,10 @@ static const JanetReg io_cfuns[] = {
/* C API */
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &janet_file_type);
}
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
@@ -743,17 +817,18 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
janet_register_abstract_type(&janet_file_type);
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
/* stdout */
janet_core_def(env, "stdout",
janet_makefile(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
JDOC("The standard output file."));
/* stderr */
janet_core_def(env, "stderr",
janet_makefile(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
JDOC("The standard error file."));
/* stdin */
janet_core_def(env, "stdin",
janet_makefile(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdin, JANET_FILE_READ | default_flags),
JDOC("The standard input file."));
}

View File

@@ -139,6 +139,19 @@ static int janet_stream_close(void *p, size_t s) {
return 0;
}
static void nosigpipe(JSock s) {
#ifdef SO_NOSIGPIPE
int enable = 1;
if (setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
JSOCKCLOSE(s);
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
}
#else
(void) s;
#endif
}
/*
* Event loop
*/
@@ -262,8 +275,11 @@ static size_t janet_loop_event(size_t index) {
int ret = 1;
int should_resume = 0;
Janet resumeval = janet_wrap_nil();
JanetSignal resumesignal = JANET_SIGNAL_OK;
if (stream->flags & JANET_STREAM_CLOSED) {
should_resume = 1;
resumeval = janet_cstringv("stream is closed");
resumesignal = JANET_SIGNAL_ERROR;
ret = 0;
} else {
switch (jlfd->event_type) {
@@ -275,6 +291,8 @@ static size_t janet_loop_event(size_t index) {
if (!(stream->flags & JANET_STREAM_READABLE)) {
should_resume = 1;
ret = 0;
resumesignal = JANET_SIGNAL_ERROR;
resumeval = janet_cstringv("stream not readable");
break;
}
JReadInt nread;
@@ -296,6 +314,13 @@ static size_t janet_loop_event(size_t index) {
should_resume = 1;
if (nread > 0) {
resumeval = janet_wrap_buffer(buffer);
} else {
if (nread == 0) {
resumeval = janet_cstringv("could not read from stream");
} else {
resumeval = janet_cstringv(strerror(JLASTERR));
}
resumesignal = JANET_SIGNAL_ERROR;
}
ret = 0;
} else {
@@ -308,6 +333,7 @@ static size_t janet_loop_event(size_t index) {
JSock connfd = accept(fd, NULL, NULL);
if (JSOCKVALID(connfd)) {
/* Made a new connection socket */
nosigpipe(connfd);
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
Janet streamv = janet_wrap_abstract(stream);
JanetFunction *handler = jlfd->data.read_accept.handler;
@@ -328,6 +354,8 @@ static size_t janet_loop_event(size_t index) {
const uint8_t *bytes;
if (!(stream->flags & JANET_STREAM_WRITABLE)) {
should_resume = 1;
resumesignal = JANET_SIGNAL_ERROR;
resumeval = janet_cstringv("stream not writeable");
ret = 0;
break;
}
@@ -350,6 +378,12 @@ static size_t janet_loop_event(size_t index) {
if (nwrote > 0) {
start += nwrote;
} else {
resumesignal = JANET_SIGNAL_ERROR;
if (nwrote == -1) {
resumeval = janet_cstringv(strerror(JLASTERR));
} else {
resumeval = janet_cstringv("could not write");
}
start = len;
}
}
@@ -376,7 +410,7 @@ static size_t janet_loop_event(size_t index) {
if (NULL != jlfd->fiber && should_resume) {
/* Resume the fiber */
Janet out;
JanetSignal sig = janet_continue(jlfd->fiber, resumeval, &out);
JanetSignal sig = janet_continue_signal(jlfd->fiber, resumeval, &out, resumesignal);
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
janet_stacktrace(jlfd->fiber, out);
}
@@ -511,6 +545,8 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
janet_panic("could not connect to socket");
}
nosigpipe(sock);
/* Wrap socket in abstract type JanetStream */
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
return janet_wrap_abstract(stream);
@@ -536,12 +572,7 @@ static Janet cfun_net_server(int32_t argc, Janet *argv) {
JSOCKCLOSE(sfd);
janet_panic("setsockopt(SO_REUSEADDR) failed");
}
#ifdef SO_NOSIGPIPE
if (setsockopt(sfd, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
JSOCKCLOSE(sfd);
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
}
#endif
nosigpipe(sfd);
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
JSOCKCLOSE(sfd);
@@ -637,7 +668,7 @@ static const JanetReg net_cfuns[] = {
JDOC("(net/read stream nbytes &opt buf)\n\n"
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Returns a buffer with up to n more bytes in it.")
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
},
{
"net/chunk", cfun_stream_chunk,
@@ -648,7 +679,7 @@ static const JanetReg net_cfuns[] = {
"net/write", cfun_stream_write,
JDOC("(net/write stream data)\n\n"
"Write data to a stream, suspending the current fiber until the write "
"completes. Returns stream.")
"completes. Returns nil, or raises an error if the write failed.")
},
{
"net/close", cfun_stream_close,

View File

@@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "gc.h"
#endif
#ifndef JANET_REDUCED_OS
@@ -36,8 +37,7 @@
#include <stdio.h>
#include <string.h>
#include <sys/stat.h>
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#include <signal.h>
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
@@ -68,12 +68,6 @@ extern char **environ;
#include <mach/mach.h>
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
void arc4random_buf(void *buf, size_t nbytes);
#endif
/* Not POSIX, but all Unixes but Solaris have this function. */
#if defined(JANET_POSIX) && !defined(__sun)
time_t timegm(struct tm *tm);
@@ -320,13 +314,149 @@ static JanetBuffer *os_exec_escape(JanetView args) {
}
#endif
static Janet os_execute(int32_t argc, Janet *argv) {
/* Process type for when running a subprocess and not immediately waiting */
static const JanetAbstractType ProcAT;
#define JANET_PROC_CLOSED 1
#define JANET_PROC_WAITED 2
typedef struct {
int flags;
#ifdef JANET_WINDOWS
HANDLE pHandle;
HANDLE tHandle;
#else
int pid;
#endif
int return_code;
JanetFile *in;
JanetFile *out;
JanetFile *err;
} JanetProc;
static int janet_proc_gc(void *p, size_t s) {
(void) s;
JanetProc *proc = (JanetProc *) p;
#ifdef JANET_WINDOWS
if (!(proc->flags & JANET_PROC_CLOSED)) {
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
}
#else
if (!(proc->flags & JANET_PROC_WAITED)) {
/* Kill and wait to prevent zombies */
kill(proc->pid, SIGKILL);
int status;
waitpid(proc->pid, &status, 0);
}
#endif
return 0;
}
static int janet_proc_mark(void *p, size_t s) {
(void) s;
JanetProc *proc = (JanetProc *)p;
if (NULL != proc->in) janet_mark(janet_wrap_abstract(proc->in));
if (NULL != proc->out) janet_mark(janet_wrap_abstract(proc->out));
if (NULL != proc->err) janet_mark(janet_wrap_abstract(proc->err));
return 0;
}
static Janet os_proc_wait_impl(JanetProc *proc) {
if (proc->flags & JANET_PROC_WAITED) {
janet_panicf("cannot wait on process that has already finished");
}
proc->flags |= JANET_PROC_WAITED;
int status = 0;
#ifdef JANET_WINDOWS
WaitForSingleObject(proc->pHandle, INFINITE);
GetExitCodeProcess(proc->pHandle, &status);
if (!(proc->flags & JANET_PROC_CLOSED)) {
proc->flags |= JANET_PROC_CLOSED;
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
}
#else
waitpid(proc->pid, &status, 0);
#endif
proc->return_code = (int32_t) status;
return janet_wrap_integer(proc->return_code);
}
static Janet os_proc_wait(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
return os_proc_wait_impl(proc);
}
static Janet os_proc_kill(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
janet_panicf("cannot kill process that has already finished");
}
#ifdef JANET_WINDOWS
if (proc->flags & JANET_PROC_CLOSED) {
janet_panicf("cannot close process handle that is already closed");
}
proc->flags |= JANET_PROC_CLOSED;
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
#else
int status = kill(proc->pid, SIGKILL);
if (status) {
janet_panic(strerror(errno));
}
#endif
/* After killing process we wait on it. */
if (argc > 1 && janet_truthy(argv[1])) {
return os_proc_wait_impl(proc);
} else {
return argv[0];
}
}
static const JanetMethod proc_methods[] = {
{"wait", os_proc_wait},
{"kill", os_proc_kill},
{NULL, NULL}
};
static int janet_proc_get(void *p, Janet key, Janet *out) {
JanetProc *proc = (JanetProc *)p;
if (janet_keyeq(key, "in")) {
*out = (NULL == proc->in) ? janet_wrap_nil() : janet_wrap_abstract(proc->in);
return 1;
}
if (janet_keyeq(key, "out")) {
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->out);
return 1;
}
if (janet_keyeq(key, "err")) {
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
return 1;
}
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
*out = janet_wrap_integer(proc->return_code);
return 1;
}
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out);
}
static const JanetAbstractType ProcAT = {
"core/process",
janet_proc_gc,
janet_proc_mark,
janet_proc_get,
JANET_ATEND_GET
};
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
janet_arity(argc, 1, 3);
/* Get flags */
uint64_t flags = 0;
if (argc > 1) {
flags = janet_getflags(argv, 1, "ep");
flags = janet_getflags(argv, 1, "epx");
}
/* Get environment */
@@ -338,43 +468,76 @@ static Janet os_execute(int32_t argc, Janet *argv) {
janet_panic("expected at least 1 command line argument");
}
/* Optional stdio redirections */
JanetFile *new_in = NULL, *new_out = NULL, *new_err = NULL;
/* Get optional redirections */
if (argc > 2) {
JanetDictView tab = janet_getdictionary(argv, 2);
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
if (!janet_checktype(maybe_stdin, JANET_NIL)) new_in = janet_getjfile(&maybe_stdin, 0);
if (!janet_checktype(maybe_stdout, JANET_NIL)) new_out = janet_getjfile(&maybe_stdout, 0);
if (!janet_checktype(maybe_stderr, JANET_NIL)) new_err = janet_getjfile(&maybe_stderr, 0);
}
/* Result */
int status = 0;
#ifdef JANET_WINDOWS
HANDLE pHandle, tHandle;
PROCESS_INFORMATION processInfo;
STARTUPINFO startupInfo;
memset(&processInfo, 0, sizeof(processInfo));
memset(&startupInfo, 0, sizeof(startupInfo));
startupInfo.cb = sizeof(startupInfo);
startupInfo.dwFlags |= STARTF_USESTDHANDLES;
JanetBuffer *buf = os_exec_escape(exargs);
if (buf->count > 8191) {
janet_panic("command line string too long (max 8191 characters)");
}
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
char *cargv[2] = {(char *) buf->data, NULL};
/* Do IO redirection */
startupInfo.hStdInput = (HANDLE) _get_osfhandle((new_in == NULL) ? 0 : _fileno(new_in->file));
startupInfo.hStdOutput = (HANDLE) _get_osfhandle((new_out == NULL) ? 1 : _fileno(new_out->file));
startupInfo.hStdError = (HANDLE) _get_osfhandle((new_err == NULL) ? 2 : _fileno(new_err->file));
/* Use _spawn family of functions. */
/* Windows docs say do this before any spawns. */
_flushall();
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
char *empty_env[1] = {NULL};
char **envp1 = (NULL == envp) ? empty_env : envp;
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
} else if (janet_flag_at(flags, 1)) {
status = (int) _spawnvp(_P_WAIT, path, cargv);
} else if (janet_flag_at(flags, 0)) {
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
} else {
status = (int) _spawnv(_P_WAIT, path, cargv);
/* TODO - redirection, :p flag */
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path, /* NULL? */
(char *) buf->data, /* Single CLI argument */
NULL, /* no proc inheritance */
NULL, /* no thread inheritance */
TRUE, /* handle inheritance */
0, /* flags */
envp, /* pass in environment */
NULL, /* use parents starting directory */
&startupInfo,
&processInfo)) {
janet_panic("failed to create process");
}
pHandle = processInfo.hProcess;
tHandle = processInfo.hThread;
os_execute_cleanup(envp, NULL);
/* Check error */
if (-1 == status) {
janet_panicf("%p: %s", argv[0], strerror(errno));
/* Wait and cleanup immedaitely */
if (!is_async) {
DWORD code;
WaitForSingleObject(pHandle, INFINITE);
GetExitCodeProcess(pHandle, &code);
status = (int) code;
CloseHandle(pHandle);
CloseHandle(tHandle);
}
return janet_wrap_integer(status);
#else
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
@@ -393,17 +556,32 @@ static Janet os_execute(int32_t argc, Janet *argv) {
janet_lock_environ();
}
/* Posix spawn setup */
posix_spawn_file_actions_t actions;
posix_spawn_file_actions_init(&actions);
if (new_in != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_in->file), 0);
}
if (new_out != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_out->file), 1);
}
if (new_err != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_err->file), 2);
}
pid_t pid;
if (janet_flag_at(flags, 1)) {
status = posix_spawnp(&pid,
child_argv[0], NULL, NULL, cargv,
child_argv[0], &actions, NULL, cargv,
use_environ ? environ : envp);
} else {
status = posix_spawn(&pid,
child_argv[0], NULL, NULL, cargv,
child_argv[0], &actions, NULL, cargv,
use_environ ? environ : envp);
}
posix_spawn_file_actions_destroy(&actions);
if (use_environ) {
janet_unlock_environ();
}
@@ -412,22 +590,51 @@ static Janet os_execute(int32_t argc, Janet *argv) {
if (status) {
os_execute_cleanup(envp, child_argv);
janet_panicf("%p: %s", argv[0], strerror(errno));
} else if (is_async) {
/* Get process handle */
os_execute_cleanup(envp, child_argv);
} else {
/* Wait to complete */
waitpid(pid, &status, 0);
os_execute_cleanup(envp, child_argv);
/* Use POSIX shell semantics for interpreting signals */
if (WIFEXITED(status)) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
status = WTERMSIG(status) + 128;
}
}
os_execute_cleanup(envp, child_argv);
/* Use POSIX shell semantics for interpreting signals */
int ret;
if (WIFEXITED(status)) {
ret = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
ret = WSTOPSIG(status) + 128;
} else {
ret = WTERMSIG(status) + 128;
}
return janet_wrap_integer(ret);
#endif
if (is_async) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
proc->return_code = -1;
#ifdef JANET_WINDOWS
proc->pHandle = pHandle;
proc->tHandle = tHandle;
#else
proc->pid = pid;
#endif
proc->in = new_in;
proc->out = new_out;
proc->err = new_err;
proc->flags = 0;
return janet_wrap_abstract(proc);
} else if (janet_flag_at(flags, 2) && status) {
janet_panicf("command failed with non-zero exit code %d", status);
} else {
return janet_wrap_integer(status);
}
}
static Janet os_execute(int32_t argc, Janet *argv) {
return os_execute_impl(argc, argv, 0);
}
static Janet os_spawn(int32_t argc, Janet *argv) {
return os_execute_impl(argc, argv, 1);
}
static Janet os_shell(int32_t argc, Janet *argv) {
@@ -557,7 +764,6 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
static Janet os_cryptorand(int32_t argc, Janet *argv) {
JanetBuffer *buffer;
const char *genericerr = "unable to get sufficient random data";
janet_arity(argc, 1, 2);
int32_t offset;
int32_t n = janet_getinteger(argv, 0);
@@ -572,44 +778,9 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
/* We could optimize here by adding setcount_uninit */
janet_buffer_setcount(buffer, offset + n);
#ifdef JANET_WINDOWS
for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
janet_panic(genericerr);
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) {
buffer->data[i + j] = v & 0xff;
v = v >> 8;
}
}
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
In these cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
if (randfd < 0)
janet_panic(genericerr);
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, buffer->data + offset, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
janet_panic(genericerr);
}
offset += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
(void) genericerr;
arc4random_buf(buffer->data + offset, n);
#else
(void) genericerr;
janet_panic("cryptorand currently unsupported on this platform");
#endif
if (janet_cryptorand(buffer->data + offset, n) != 0)
janet_panic("unable to get sufficient random data");
return janet_wrap_buffer(buffer);
}
@@ -1378,15 +1549,36 @@ static const JanetReg os_cfuns[] = {
"\t:e - enables passing an environment to the program. Without :e, the "
"current environment is inherited.\n"
"\t:p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n\n"
"env is a table or struct mapping environment variables to values. "
"Without this flag, binaries must use absolute paths.\n"
"\t:x - raise error if exit code is non-zero.\n"
"env is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"Returns the exit status of the program.")
},
{
"os/spawn", os_spawn,
JDOC("(os/spawn args &opts flags env)\n\n"
"Execute a program on the system and return a handle to the process. Otherwise, the "
"same arguments as os/execute. Does not wait for the process.")
},
{
"os/shell", os_shell,
JDOC("(os/shell str)\n\n"
"Pass a command string str directly to the system shell.")
},
{
"os/proc-wait", os_proc_wait,
JDOC("(os/proc-wait proc)\n\n"
"Block until the subprocess completes. Returns the subprocess return code.")
},
{
"os/proc-kill", os_proc_kill,
JDOC("(os/proc-kill proc &opt wait)\n\n"
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If wait is truthy, will wait for the process to finsih and "
"returns the exit code. Otherwise, returns proc.")
},
#endif
{
"os/setenv", os_setenv,

View File

@@ -454,7 +454,7 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m",
"\x1B[36m",
"\x1B[36m",
"\x1B[36m"
"\x1B[36m",
"\x1B[35m",
"\x1B[36m",
"\x1B[36m",
@@ -955,6 +955,9 @@ void janet_buffer_format(
janet_description_b(b, argv[arg]);
break;
}
case 't':
janet_buffer_push_cstring(b, typestr(argv[arg]));
break;
case 'M':
case 'm':
case 'N':

View File

@@ -28,6 +28,11 @@
#include "gc.h"
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#endif
#endif
@@ -630,3 +635,53 @@ int janet_gettime(struct timespec *spec) {
}
#endif
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
void arc4random_buf(void *buf, size_t nbytes);
#endif
int janet_cryptorand(uint8_t *out, size_t n) {
#ifdef JANET_WINDOWS
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
return -1;
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
out[i + j] = v & 0xff;
v = v >> 8;
}
}
return 0;
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
In these cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
if (randfd < 0)
return -1;
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, out, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
return -1;
}
out += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
return 0;
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
(void) n;
(void) out;
return -1;
#endif
}

View File

@@ -76,7 +76,6 @@ int32_t janet_tablen(int32_t n);
void safe_memcpy(void *dest, const void *src, size_t len);
void janet_buffer_push_types(JanetBuffer *buffer, int types);
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
@@ -108,6 +107,8 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
int janet_gettime(struct timespec *spec);
#endif
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
void janet_lib_math(JanetTable *env);

View File

@@ -271,14 +271,12 @@ int32_t janet_hash(Janet x) {
}
/* fallthrough */
default:
/* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */
uint64_t i = janet_u64(x);
hash = (int32_t)(i & 0xFFFFFFFF);
/* Get a bit more entropy by shifting the low bits out */
hash >>= 3;
hash ^= (int32_t)(i >> 32);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
} else {
/* Assuming 4 byte pointer (or smaller) */
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);

View File

@@ -95,6 +95,10 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
vm_commit(); \
return (sig); \
} while (0)
#define vm_return_no_restore(sig, val) do { \
janet_vm_return_reg[0] = (val); \
return (sig); \
} while (0)
/* Next instruction variations */
#define maybe_collect() do {\
@@ -376,7 +380,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_NEXT,
&&label_JOP_NOT_EQUALS,
&&label_JOP_NOT_EQUALS_IMMEDIATE,
&&label_unknown_op,
&&label_JOP_CANCEL,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -564,6 +568,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
register Janet *stack;
register uint32_t *pc;
register JanetFunction *func;
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
janet_vm_return_reg[0] = in;
return sig;
}
vm_restore();
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
@@ -614,7 +627,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = stack[D];
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -624,7 +637,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = janet_wrap_nil();
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -801,6 +814,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_NEXT)
vm_commit();
stack[A] = janet_next(stack[B], stack[C]);
vm_pcnext();
@@ -1001,8 +1015,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
retreg = call_nonfn(fiber, callee);
}
janet_fiber_popframe(fiber);
if (entrance_frame)
vm_return(JANET_SIGNAL_OK, retreg);
if (entrance_frame) {
vm_return_no_restore(JANET_SIGNAL_OK, retreg);
}
vm_restore();
stack[A] = retreg;
vm_checkgc_pcnext();
@@ -1049,6 +1064,25 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_return((int) sub_status, stack[B]);
}
VM_OP(JOP_CANCEL) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
vm_commit();
janet_panicv(retreg);
}
fiber->child = child;
JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
vm_checkgc_pcnext();
}
VM_OP(JOP_PUT)
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
@@ -1366,6 +1400,20 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
return janet_continue_no_check(fiber, in, out);
}
/* Enter the main vm loop but immediately raise a signal */
JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
if (tmp_signal) return tmp_signal;
if (sig != JANET_SIGNAL_OK) {
JanetFiber *child = fiber;
while (child->child) child = child->child;
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
child->flags |= JANET_FIBER_RESUME_SIGNAL;
}
return janet_continue_no_check(fiber, in, out);
}
JanetSignal janet_pcall(
JanetFunction *fun,
int32_t argc,

View File

@@ -201,7 +201,7 @@ extern "C" {
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
#else
#define JANET_NO_RETURN __attribute__ ((noreturn))
#define JANET_NO_RETURN __attribute__((noreturn))
#endif
#endif
@@ -267,11 +267,22 @@ typedef struct {
} JanetBuildConfig;
/* Get config of current compilation unit. */
#ifdef __cplusplus
/* C++11 syntax */
#define janet_config_current() (JanetBuildConfig { \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#else
/* C99 syntax */
#define janet_config_current() ((JanetBuildConfig){ \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#endif
/***** END SECTION CONFIG *****/
@@ -561,14 +572,14 @@ JANET_API Janet janet_wrap_integer(int32_t x);
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
#define janet_type(x) \
(isnan((x).number) \
? (((x).u64 >> 47) & 0xF) \
? (JanetType) (((x).u64 >> 47) & 0xF) \
: JANET_NUMBER)
#define janet_nanbox_checkauxtype(x, type) \
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
#define janet_nanbox_isnumber(x) \
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
(!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
#define janet_checktype(x, t) \
(((t) == JANET_NUMBER) \
@@ -640,7 +651,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define JANET_DOUBLE_OFFSET 0xFFFF
#define janet_u64(x) ((x).u64)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER)
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
: (x).tagged.type == (t))
@@ -1131,6 +1142,7 @@ enum JanetOpCode {
JOP_NEXT,
JOP_NOT_EQUALS,
JOP_NOT_EQUALS_IMMEDIATE,
JOP_CANCEL,
JOP_INSTRUCTION_COUNT
};
@@ -1412,6 +1424,7 @@ JANET_API int janet_symeq(Janet x, const char *cstring);
JANET_API int janet_init(void);
JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
@@ -1437,6 +1450,7 @@ typedef enum {
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
JANET_API void janet_register(const char *name, JanetCFunction cfun);
@@ -1446,14 +1460,19 @@ JANET_API Janet janet_resolve_core(const char *name);
/* New C API */
/* Allow setting entry name for static libraries */
#ifdef __cplusplus
#define JANET_MODULE_PREFIX extern "C"
#else
#define JANET_MODULE_PREFIX
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_API void _janet_init
JANET_MODULE_PREFIX JANET_API void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#endif
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
@@ -1538,13 +1557,17 @@ extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_BINARY 64
#define JANET_FILE_SERIALIZABLE 128
#define JANET_FILE_PIPED 256
#define JANET_FILE_NONIL 512
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
JANET_API JanetAbstract janet_checkfile(Janet j);
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
/* Marshal API */
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);

View File

@@ -180,7 +180,7 @@ static int rawmode(void) {
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
t.c_cc[VMIN] = 1;
t.c_cc[VTIME] = 0;
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
if (tcsetattr(STDIN_FILENO, TCSADRAIN, &t) < 0) goto fatal;
gbl_israwmode = 1;
return 0;
fatal:
@@ -193,7 +193,7 @@ fatal:
/* Disable raw mode */
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
gbl_israwmode = 0;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
@@ -763,7 +763,7 @@ static int line() {
switch (c) {
default:
if (c < 0x20) break;
if ((unsigned char) c < 0x20) break;
if (insert(c, 1)) return -1;
break;
case 1: /* ctrl-a */
@@ -1017,6 +1017,23 @@ int main(int argc, char **argv) {
atexit(norawmode);
#endif
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
char *envvar = getenv("JANET_HASHSEED");
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
}
janet_init_hash_key(hash_key);
#endif
/* Set up VM */
janet_init();

View File

@@ -9,6 +9,14 @@
:name "testmod2"
:source @["testmod2.c"])
(declare-native
:name "testmod3"
:source @["testmod3.cpp"])
(declare-native
:name "test-mod-4"
:source @["testmod4.c"])
(declare-executable
:name "testexec"
:entry "testexec.janet")

View File

@@ -1,6 +1,8 @@
(use build/testmod)
(use build/testmod2)
(use build/testmod3)
(use build/test-mod-4)
(defn main [&]
(print "Hello from executable!")
(print (+ (get5) (get6))))
(print (+ (get5) (get6) (get7) (get8))))

42
test/install/testmod3.cpp Normal file
View File

@@ -0,0 +1,42 @@
/*
* Copyright (c) 2020 Calvin Rose and 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.
*/
/* A very simple native module */
#include <janet.h>
#include <iostream>
static Janet cfun_get_seven(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
std::cout << "Hello!" << std::endl;
return janet_wrap_number(7.0);
}
static const JanetReg array_cfuns[] = {
{"get7", cfun_get_seven, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

40
test/install/testmod4.c Normal file
View File

@@ -0,0 +1,40 @@
/*
* Copyright (c) 2020 Calvin Rose and 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.
*/
/* A very simple native module */
#include <janet.h>
static Janet cfun_get_eight(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(8.0);
}
static const JanetReg array_cfuns[] = {
{"get8", cfun_get_eight, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

64
test/suite0010.janet Normal file
View File

@@ -0,0 +1,64 @@
# Copyright (c) 2020 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 10)
# index-of
(assert (= nil (index-of 10 [])) "index-of 1")
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
(assert (= nil (index-of :a {})) "index-of 5")
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
(assert (= nil (index-of (chr "a") "")) "index-of 9")
(assert (= nil (index-of 10 @[])) "index-of 10")
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
# Regression
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
# macex testing
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
# Cancel test
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1")
(assert (= 2 (resume f)) "cancel resume 2")
(assert (= :hi (cancel f :hi)) "cancel resume 3")
(assert (= :error (fiber/status f)) "cancel resume 4")
# Curenv
(assert (= (curenv) (curenv 0)) "curenv 1")
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
(assert (= nil (curenv 1000000)) "curenv 3")
(assert (= root-env (curenv 1)) "curenv 4")
# Import macro test
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
(assert (deep= ~(,import* "a" :as "b" :fresh maybe) (macex '(import a :as b :fresh maybe))) "import macro 2")
(end-suite)