mirror of
https://github.com/janet-lang/janet
synced 2025-11-06 18:43:04 +00:00
Compare commits
57 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2bf5e341d3 | ||
|
|
b53890ddae | ||
|
|
93602ad9ea | ||
|
|
ff57b3eb72 | ||
|
|
1837e89fe4 | ||
|
|
24b8b0e382 | ||
|
|
321a758ab9 | ||
|
|
1a9c14acde | ||
|
|
e8734c77b4 | ||
|
|
1eb00a9f74 | ||
|
|
922a21d359 | ||
|
|
4a4f314768 | ||
|
|
3c64596ea1 | ||
|
|
33283b1b6e | ||
|
|
2f89bdc672 | ||
|
|
2d275c4782 | ||
|
|
25156eb83e | ||
|
|
39032b45c9 | ||
|
|
821a8dca3b | ||
|
|
0145b133a1 | ||
|
|
b0b137d7f0 | ||
|
|
b0c09153c2 | ||
|
|
0485078c6c | ||
|
|
7079cc43c9 | ||
|
|
e7fca0051e | ||
|
|
6273e56886 | ||
|
|
8b9ad2dce8 | ||
|
|
301cbb0e68 | ||
|
|
5313963baf | ||
|
|
f60348eee4 | ||
|
|
a31e079f93 | ||
|
|
556edc9f0d | ||
|
|
5dda83dc73 | ||
|
|
28439d822a | ||
|
|
b1d8ee19ca | ||
|
|
f7c556ed8d | ||
|
|
5377e10532 | ||
|
|
58374623b7 | ||
|
|
7e7498350f | ||
|
|
06c268c274 | ||
|
|
9b36e2b145 | ||
|
|
ca75f8dc20 | ||
|
|
6f2f3fdb68 | ||
|
|
c903e49a4f | ||
|
|
9121feb44f | ||
|
|
7b42ed66f2 | ||
|
|
c3af30d520 | ||
|
|
2598123140 | ||
|
|
40627191f3 | ||
|
|
38dc844e85 | ||
|
|
abc4405a76 | ||
|
|
243c66442d | ||
|
|
9afcec77f6 | ||
|
|
70ad98cc6f | ||
|
|
76cfbde933 | ||
|
|
f200bd9594 | ||
|
|
4d4ca7bb36 |
15
.builds/meson2.yml
Normal file
15
.builds/meson2.yml
Normal 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
|
||||
@@ -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
4
.gitignore
vendored
@@ -61,6 +61,10 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
|
||||
33
CHANGELOG.md
33
CHANGELOG.md
@@ -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.
|
||||
|
||||
|
||||
5
Makefile
5
Makefile
@@ -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 $< $@
|
||||
|
||||
@@ -2,10 +2,10 @@
|
||||
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
|
||||
[](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">
|
||||
|
||||
|
||||
8
janet.1
8
janet.1
@@ -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
153
jpm
@@ -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
6
jpm.1
@@ -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
|
||||
|
||||
48
meson.build
48
meson.build
@@ -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())
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
@@ -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) */
|
||||
|
||||
191
src/core/asm.c
191
src/core/asm.c
@@ -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}
|
||||
};
|
||||
|
||||
@@ -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 */
|
||||
|
||||
@@ -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) {
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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 */
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 */
|
||||
|
||||
@@ -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
|
||||
|
||||
135
src/core/io.c
135
src/core/io.c
@@ -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."));
|
||||
|
||||
}
|
||||
|
||||
@@ -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,
|
||||
|
||||
356
src/core/os.c
356
src/core/os.c
@@ -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,
|
||||
|
||||
@@ -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':
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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();
|
||||
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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
42
test/install/testmod3.cpp
Normal 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
40
test/install/testmod4.c
Normal 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
64
test/suite0010.janet
Normal 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)
|
||||
Reference in New Issue
Block a user