mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 14:17:42 +00:00
Compare commits
53 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d204e06e11 | ||
|
|
f6b37dbc77 | ||
|
|
ff4d49f556 | ||
|
|
dfa5fa1187 | ||
|
|
1f4f69a5b6 | ||
|
|
84f82f5465 | ||
|
|
c911f7c47e | ||
|
|
33c000daea | ||
|
|
7ff204ec44 | ||
|
|
7c757ef3bf | ||
|
|
2db7945d6f | ||
|
|
81186bf262 | ||
|
|
eeef5b0896 | ||
|
|
8189b6fc11 | ||
|
|
e5a2df93ab | ||
|
|
c3f770da27 | ||
|
|
49f66a936c | ||
|
|
83dda98240 | ||
|
|
b4ddbd0097 | ||
|
|
cbe92bb985 | ||
|
|
60c6a0d334 | ||
|
|
1baab5eb61 | ||
|
|
8fc8974b60 | ||
|
|
ecb49c2e5e | ||
|
|
29797b9eb0 | ||
|
|
e181ee586b | ||
|
|
7b7d742bec | ||
|
|
612eaff9ff | ||
|
|
d76ef187e8 | ||
|
|
e01ab86a89 | ||
|
|
89b59b4ffc | ||
|
|
e367ecf806 | ||
|
|
effc9e0f33 | ||
|
|
da06e6c6e3 | ||
|
|
c258bee54f | ||
|
|
cde4a505cf | ||
|
|
2802e66259 | ||
|
|
3a3003029a | ||
|
|
08bca8fb63 | ||
|
|
7c7ff802fa | ||
|
|
0945acc780 | ||
|
|
64ec9f9cb6 | ||
|
|
83f7de33c0 | ||
|
|
ec2d7bf349 | ||
|
|
f4c9064b79 | ||
|
|
8ede16dc26 | ||
|
|
27e400fba3 | ||
|
|
37d6cb469b | ||
|
|
100a82feb2 | ||
|
|
90e5828d5d | ||
|
|
b3e80308d4 | ||
|
|
a7abe11105 | ||
|
|
3c63a48df4 |
@@ -4,7 +4,7 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
- gcc
|
||||
|
||||
21
CHANGELOG.md
21
CHANGELOG.md
@@ -1,6 +1,27 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## ??? - Unreleased
|
||||
- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
|
||||
- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
|
||||
- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
|
||||
native libraries when building with jpm.
|
||||
- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
|
||||
that can be installed via `jpm`.
|
||||
- Add `from-pairs` to core.
|
||||
- Add `JPM_OS_WHICH` environment variable to jpm to allow changing auto-detection behavior.
|
||||
- The flychecker will consider any top-level calls of functions that start with `define-` to
|
||||
be safe to execute and execute them. This allows certain patterns (like spork/path) to be
|
||||
better processed by the flychecker.
|
||||
|
||||
## 1.15.5 - 2021-04-25
|
||||
- Add `declare-headers` to jpm.
|
||||
- Fix error using unix pipes on BSDs.
|
||||
- Support .cc and .cxx extensions in `jpm` for C++ code.
|
||||
- Change networking code to not create as many HUP errors.
|
||||
- Add `net/shutdown` to close sockets in one direction without hang ups.
|
||||
- Update code for printing the debug repl
|
||||
|
||||
## 1.15.4 - 2021-03-16
|
||||
- Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD`
|
||||
- Update meson.build
|
||||
|
||||
32
Makefile
32
Makefile
@@ -35,6 +35,7 @@ JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_DIST_DIR?=janet-dist
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
@@ -119,7 +120,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/table.c \
|
||||
src/core/thread.c \
|
||||
src/core/tuple.c \
|
||||
src/core/typedarray.c \
|
||||
src/core/util.c \
|
||||
src/core/value.c \
|
||||
src/core/vector.c \
|
||||
@@ -157,7 +157,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.15
|
||||
SONAME=libjanet.so.1.16
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
@@ -224,20 +224,20 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/c/janet.c build/c/shell.c jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
#########################
|
||||
|
||||
docs: build/doc.html
|
||||
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
README.md build/c/janet.c build/c/shell.c jpm
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
cp jpm build/$(JANET_DIST_DIR)/bin/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||
cp janet.1 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
|
||||
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||
|
||||
########################
|
||||
##### Installation #####
|
||||
|
||||
40
README.md
40
README.md
@@ -17,6 +17,9 @@ to run script files. This client program is separate from the core runtime, so
|
||||
Janet can be embedded in other programs. Try Janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
If you'd like to financially support the ongoing development of Janet, consider
|
||||
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
|
||||
|
||||
<br>
|
||||
|
||||
## Use Cases
|
||||
@@ -170,7 +173,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
|
||||
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
|
||||
|
||||
## Usage
|
||||
@@ -231,7 +234,7 @@ See the examples directory for some example janet code.
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
Gitter provides Matrix and irc bridges as well.
|
||||
|
||||
## FAQ
|
||||
|
||||
@@ -243,8 +246,35 @@ will not. If your terminal does not support ANSI escape codes, run the REPL with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
## Why Janet
|
||||
### Where is (favorite feature from other language)?
|
||||
|
||||
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
|
||||
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||
of 5 others by making the language more complicated.
|
||||
|
||||
### Where is the example code?
|
||||
|
||||
In the examples directory.
|
||||
|
||||
### Is this a Clojure port?
|
||||
|
||||
No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
|
||||
Internally, Janet is not at all like Clojure.
|
||||
|
||||
### Are the immutable data structures (tuples and structs) implemented as hash tries?
|
||||
|
||||
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
||||
and maps, instead they work well as table keys or other identifiers.
|
||||
|
||||
### Why can't we add (feature from Clojure) into the core?
|
||||
|
||||
Usually, one of a few reasons:
|
||||
- Often, it already exists in a different form and the Clojure port would be redundant.
|
||||
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
||||
Janet does not run on the JVM. We admittedly have a much more primitive GC.
|
||||
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
|
||||
without feeling "bolted on", especially when compared to ALGOL like languages.
|
||||
|
||||
## Why is it called "Janet"?
|
||||
|
||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 109 KiB |
@@ -7,13 +7,13 @@ typedef struct {
|
||||
} num_array;
|
||||
|
||||
static num_array *num_array_init(num_array *array, size_t size) {
|
||||
array->data = (double *)calloc(size, sizeof(double));
|
||||
array->data = (double *)janet_calloc(size, sizeof(double));
|
||||
array->size = size;
|
||||
return array;
|
||||
}
|
||||
|
||||
static void num_array_deinit(num_array *array) {
|
||||
free(array->data);
|
||||
janet_free(array->data);
|
||||
}
|
||||
|
||||
static int num_array_gc(void *p, size_t s) {
|
||||
|
||||
@@ -1,73 +0,0 @@
|
||||
# naive matrix implementation for testing typed array
|
||||
|
||||
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||
|
||||
(defn matrix/row [mat i]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||
|
||||
(defn matrix/column [mat j]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 nrow ncol j array))
|
||||
|
||||
(defn matrix/set [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(set (array (+ (* i ncol) j)) value))
|
||||
|
||||
(defn matrix/get [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(array (+ (* i ncol) j)))
|
||||
|
||||
|
||||
# other variants to test rows and cols views
|
||||
|
||||
(defn matrix/set* [mat i j value]
|
||||
(set ((matrix/row mat i) j) value))
|
||||
|
||||
(defn matrix/set** [mat i j value]
|
||||
(set ((matrix/column mat j) i) value))
|
||||
|
||||
|
||||
(defn matrix/get* [mat i j value]
|
||||
((matrix/row mat i) j))
|
||||
|
||||
(defn matrix/get** [mat i j value]
|
||||
((matrix/column mat j) i))
|
||||
|
||||
|
||||
(defn tarray/print [arr]
|
||||
(def size (tarray/length arr))
|
||||
(prinf "[%2i]" size)
|
||||
(for i 0 size
|
||||
(prinf " %+6.3f " (arr i)))
|
||||
(print))
|
||||
|
||||
(defn matrix/print [mat]
|
||||
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||
(for i 0 nrow
|
||||
(tarray/print (matrix/row mat i))))
|
||||
|
||||
|
||||
(def nr 5)
|
||||
(def nc 4)
|
||||
(def A (matrix nr nc))
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set* A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set** A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
|
||||
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||
(for i 0 nr
|
||||
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||
(for i 0 nc
|
||||
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||
137
jpm
137
jpm
@@ -6,14 +6,21 @@
|
||||
# Basic Path Settings
|
||||
#
|
||||
|
||||
# Windows is the OS outlier
|
||||
(def- is-win (= (os/which) :windows))
|
||||
(def- is-mac (= (os/which) :macos))
|
||||
(def- sep (if is-win "\\" "/"))
|
||||
(def- objext (if is-win ".obj" ".o"))
|
||||
(def- modext (if is-win ".dll" ".so"))
|
||||
(def- statext (if is-win ".static.lib" ".a"))
|
||||
(def- absprefix (if is-win "C:\\" "/"))
|
||||
# Allow changing the behavior via an environment variable
|
||||
(def- host-os (keyword (string/ascii-lower (os/getenv "JPM_OS_WHICH" (os/which)))))
|
||||
(defn- define-utils
|
||||
[]
|
||||
(def is-win (= host-os :windows))
|
||||
(defglobal 'is-win is-win)
|
||||
(defglobal 'is-mac (= host-os :macos))
|
||||
(def sep (if is-win "\\" "/"))
|
||||
(defglobal 'sep sep)
|
||||
(defglobal 'objext (if is-win ".obj" ".o"))
|
||||
(defglobal 'modext (if is-win ".dll" ".so"))
|
||||
(defglobal 'statext (if is-win ".static.lib" ".a"))
|
||||
(defglobal 'absprefix (if is-win "C:\\" "/")))
|
||||
|
||||
(define-utils)
|
||||
|
||||
#
|
||||
# Defaults
|
||||
@@ -51,8 +58,19 @@
|
||||
:libpath (try-real (string exe-dir "/../lib"))
|
||||
:binpath exe-dir})
|
||||
|
||||
# If janetconf.h has been modified such that core janet functions and macros require
|
||||
# linking to external libraries, modify this.
|
||||
#
|
||||
# Example - (def- extra-lflags ["-lmimalloc"])
|
||||
|
||||
###END###
|
||||
|
||||
# Redefine utils in case the above section is overriden on some installs.
|
||||
(define-utils)
|
||||
|
||||
(compwhen (not (dyn 'extra-lflags))
|
||||
(def- extra-lflags []))
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(get (install-paths) :headerpath)))
|
||||
@@ -362,11 +380,11 @@
|
||||
# flags needed for the janet binary and compiling standalone
|
||||
# executables.
|
||||
(def janet-lflags
|
||||
(case (os/which)
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
["-lm" ;thread-flags]))
|
||||
(case host-os
|
||||
:macos ["-ldl" "-lm" ;thread-flags ;extra-lflags]
|
||||
:windows [;thread-flags ;extra-lflags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags ;extra-lflags]
|
||||
["-lm" ;thread-flags ;extra-lflags]))
|
||||
(def janet-ldflags [])
|
||||
(def janet-cflags [])
|
||||
|
||||
@@ -452,6 +470,7 @@
|
||||
[opts]
|
||||
@[;(opt opts :cflags default-cflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-I" (dyn :modpath JANET_MODPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- getcppflags
|
||||
@@ -459,6 +478,7 @@
|
||||
[opts]
|
||||
@[;(opt opts :cppflags default-cppflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-I" (dyn :modpath JANET_MODPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
@@ -521,35 +541,26 @@
|
||||
(string hpath `\\janet.lib`))
|
||||
|
||||
(defn- link-c
|
||||
"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))
|
||||
"Link C or C++ object files together to make a native module."
|
||||
[has-cpp opts target & objects]
|
||||
(def linker
|
||||
(if has-cpp
|
||||
(opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
|
||||
(opt opts (if is-win :linker :compiler) default-linker)))
|
||||
(def cflags ((if has-cpp getcppflags getcflags) opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(def ldflags [;(opt opts :ldflags [])])
|
||||
(def deplibs (get opts :native-deps []))
|
||||
(def dep-ldflags (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x modext)))
|
||||
# Use import libs on windows - we need an import lib to link natives to other natives.
|
||||
(def dep-importlibs (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x ".lib")))
|
||||
(def ldflags [;(opt opts :ldflags []) ;dep-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- 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 ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;dep-importlibs ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
@@ -968,17 +979,18 @@ int main(int argc, const char **argv) {
|
||||
(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" src))))
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix objext))
|
||||
(if (= suffix ".c")
|
||||
(compile-c opts src op)
|
||||
(do (compile-cpp opts src op)
|
||||
(set has-cpp true)))
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
@@ -987,7 +999,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)))
|
||||
((if has-cpp link-cpp link-c) opts lname ;objects)
|
||||
(link-c has-cpp opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(install-rule lname path)
|
||||
|
||||
@@ -1016,16 +1028,17 @@ int main(int argc, const char **argv) {
|
||||
# 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"))))
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix sobjext))
|
||||
(if (= suffix ".c")
|
||||
(compile-c opts src op true)
|
||||
(compile-cpp opts src op true))
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
@@ -1051,6 +1064,16 @@ int main(int argc, const char **argv) {
|
||||
(each s sources
|
||||
(install-rule s path))))
|
||||
|
||||
(defn declare-headers
|
||||
"Declare headers for a library installation. Installed headers can be used by other native
|
||||
libraries."
|
||||
[&keys {:headers headers :prefix prefix}]
|
||||
(def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
|
||||
(if (bytes? headers)
|
||||
(install-rule headers path)
|
||||
(each h headers
|
||||
(install-rule h path))))
|
||||
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys {:main main}]
|
||||
|
||||
25
jpm.1
25
jpm.1
@@ -269,5 +269,30 @@ An optional path to a git executable to use to clone git dependencies. By defaul
|
||||
if you have a normal install of git.
|
||||
.RE
|
||||
|
||||
.B JPM_OS_WHICH
|
||||
.RS
|
||||
Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
|
||||
environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
|
||||
set this environment variable. Set this to one of the following
|
||||
strings:
|
||||
.IP
|
||||
\- windows
|
||||
.IP
|
||||
\- macos
|
||||
.IP
|
||||
\- linux
|
||||
.IP
|
||||
\- freebsd
|
||||
.IP
|
||||
\- openbsd
|
||||
.IP
|
||||
\- netbsd
|
||||
.IP
|
||||
\- bsd
|
||||
.IP
|
||||
\- posix
|
||||
.RE
|
||||
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
17
meson.build
17
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.15.4')
|
||||
version : '1.16.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -60,9 +60,8 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
conf.set('JANET_PRF', get_option('prf'))
|
||||
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
@@ -135,7 +134,6 @@ core_src = [
|
||||
'src/core/table.c',
|
||||
'src/core/thread.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/typedarray.c',
|
||||
'src/core/util.c',
|
||||
'src/core/value.c',
|
||||
'src/core/vector.c',
|
||||
@@ -173,9 +171,14 @@ janetc = custom_target('janetc',
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
endif
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
@@ -189,7 +192,7 @@ else
|
||||
endif
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
@@ -202,7 +205,7 @@ if meson.is_cross_build()
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_native_cflags,
|
||||
native : true)
|
||||
else
|
||||
|
||||
@@ -8,7 +8,6 @@ option('sourcemaps', type : 'boolean', value : true)
|
||||
option('reduced_os', type : 'boolean', value : false)
|
||||
option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
|
||||
@@ -93,7 +93,7 @@ int main(int argc, const char **argv) {
|
||||
fseek(boot_file, 0, SEEK_END);
|
||||
size_t boot_size = ftell(boot_file);
|
||||
fseek(boot_file, 0, SEEK_SET);
|
||||
unsigned char *boot_buffer = malloc(boot_size);
|
||||
unsigned char *boot_buffer = janet_malloc(boot_size);
|
||||
if (NULL == boot_buffer) {
|
||||
fprintf(stderr, "Failed to allocate boot buffer\n");
|
||||
exit(1);
|
||||
@@ -105,7 +105,7 @@ int main(int argc, const char **argv) {
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
free(boot_buffer);
|
||||
janet_free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
@@ -47,6 +47,14 @@
|
||||
[name & more]
|
||||
(apply defn name :macro more))
|
||||
|
||||
(defmacro as-macro
|
||||
``Use a function or macro literal `f` as a macro. This lets
|
||||
any function be used as a macro. Inside a quasiquote, the
|
||||
idiom `(as-macro ,my-custom-macro arg1 arg2...)` can be used
|
||||
to avoid unwanted variable capture.``
|
||||
[f & args]
|
||||
(f ;args))
|
||||
|
||||
(defmacro defmacro-
|
||||
"Define a private macro that will not be exported."
|
||||
[name & more]
|
||||
@@ -530,19 +538,19 @@
|
||||
Where `binding` is a binding as passed to def, `:verb` is one of a set of
|
||||
keywords, and `object` is any expression. The available verbs are:
|
||||
|
||||
* :iterate -- repeatedly evaluate and bind to the expression while it is
|
||||
* `:iterate` - repeatedly evaluate and bind to the expression while it is
|
||||
truthy.
|
||||
* :range -- loop over a range. The object should be a two-element tuple with
|
||||
* `:range` - loop over a range. The object should be a two-element tuple with
|
||||
a start and end value, and an optional positive step. The range is half
|
||||
open, [start, end).
|
||||
* :range-to -- same as :range, but the range is inclusive [start, end].
|
||||
* :down -- loop over a range, stepping downwards. The object should be a
|
||||
* `:range-to` - same as :range, but the range is inclusive [start, end].
|
||||
* `:down` - loop over a range, stepping downwards. The object should be a
|
||||
two-element tuple with a start and (exclusive) end value, and an optional
|
||||
(positive!) step size.
|
||||
* :down-to -- same as :down, but the range is inclusive [start, end].
|
||||
* :keys -- iterate over the keys in a data structure.
|
||||
* :pairs -- iterate over the key-value pairs as tuples in a data structure.
|
||||
* :in -- iterate over the values in a data structure or fiber.
|
||||
* `:down-to` - same as :down, but the range is inclusive [start, end].
|
||||
* `:keys` - iterate over the keys in a data structure.
|
||||
* `:pairs` - iterate over the key-value pairs as tuples in a data structure.
|
||||
* `:in` - iterate over the values in a data structure or fiber.
|
||||
|
||||
`loop` also accepts conditionals to refine the looping further. Conditionals are of
|
||||
the form:
|
||||
@@ -558,6 +566,7 @@
|
||||
* `:before form` - evaluates a form for a side effect before the next inner loop.
|
||||
* `:after form` - same as `:before`, but the side effect happens after the next inner loop.
|
||||
* `:repeat n` - repeats the next inner loop `n` times.
|
||||
lets try putting a loop item on multiple lines.
|
||||
* `:when condition` - only evaluates the loop body when condition is true.
|
||||
|
||||
The `loop` macro always evaluates to nil.
|
||||
@@ -1465,7 +1474,7 @@
|
||||
ret)
|
||||
|
||||
(defn partition-by
|
||||
``Partition elements of a sequential data structure by a representative function `f`. Partitions
|
||||
``Partition elements of a sequential data structure by a representative function `f`. Partitions
|
||||
split when `(f x)` changes values when iterating to the next element `x` of `ind`. Returns a new array
|
||||
of arrays.``
|
||||
[f ind]
|
||||
@@ -1525,6 +1534,15 @@
|
||||
(loop [k :keys dict] (array/push ret k (in dict k)))
|
||||
ret)
|
||||
|
||||
(defn from-pairs
|
||||
``Takes a sequence of pairs and creates a table from each pair. The inverse of
|
||||
`pairs` on a table.``
|
||||
[ps]
|
||||
(def ret @{})
|
||||
(each [k v] ps
|
||||
(put ret k v))
|
||||
ret)
|
||||
|
||||
(defn interpose
|
||||
`Returns a sequence of the elements of ind separated by
|
||||
sep. Returns a new array.`
|
||||
@@ -1767,8 +1785,8 @@
|
||||
###
|
||||
|
||||
(defn macex1
|
||||
`Expand macros in a form, but do not recursively expand macros.
|
||||
See macex docs for info on on-binding.`
|
||||
``Expand macros in a form, but do not recursively expand macros.
|
||||
See `macex` docs for info on on-binding.``
|
||||
[x &opt on-binding]
|
||||
|
||||
(when on-binding
|
||||
@@ -2079,6 +2097,21 @@
|
||||
(if ec "\e[0m" ""))
|
||||
(eflush))
|
||||
|
||||
(defn warn-compile
|
||||
"Default handler for a compile warning"
|
||||
[msg where &opt line col]
|
||||
(def ec (dyn :err-color))
|
||||
(eprin
|
||||
(if ec "\e[33m" "")
|
||||
where
|
||||
":"
|
||||
line
|
||||
":"
|
||||
col
|
||||
": compile warning: ")
|
||||
(eprint msg (if ec "\e[0m" ""))
|
||||
(eflush))
|
||||
|
||||
(defn bad-compile
|
||||
"Default handler for a compile error."
|
||||
[msg macrof where &opt line col]
|
||||
@@ -2104,6 +2137,12 @@
|
||||
(if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
|
||||
e)
|
||||
|
||||
(def- lint-levels
|
||||
{:none 0
|
||||
:relaxed 1
|
||||
:normal 2
|
||||
:strict 3})
|
||||
|
||||
(defn run-context
|
||||
```
|
||||
Run a context. This evaluates expressions in an environment,
|
||||
@@ -2111,17 +2150,21 @@
|
||||
Returns (in environment :exit-value environment) when complete.
|
||||
opts is a table or struct of options. The options are as follows:
|
||||
|
||||
* :chunks - callback to read into a buffer - default is getline
|
||||
* :on-parse-error - callback when parsing fails - default is bad-parse
|
||||
* :env - the environment to compile against - default is the current env
|
||||
* :source - string path of source for better errors - default is "<anonymous>"
|
||||
* :on-compile-error - callback when compilation fails - default is bad-compile
|
||||
* :evaluator - callback that executes thunks. Signature is (evaluator thunk source env where)
|
||||
* :on-status - callback when a value is evaluated - default is debug/stacktrace.
|
||||
* :fiber-flags - what flags to wrap the compilation fiber with. Default is :ia.
|
||||
* :expander - an optional function that is called on each top level form before being compiled.
|
||||
* :parser - provide a custom parser that implements the same interface as Janet's built-in parser.
|
||||
* :read - optional function to get the next form, called like (read env source). Overrides all parsing.
|
||||
* `:chunks` - callback to read into a buffer - default is getline
|
||||
* `:on-parse-error` - callback when parsing fails - default is bad-parse
|
||||
* `:env` - the environment to compile against - default is the current env
|
||||
* `:source` - string path of source for better errors - default is "<anonymous>"
|
||||
* `:on-compile-error` - callback when compilation fails - default is bad-compile
|
||||
* `:on-compile-warning` - callback for any linting error - default is warn-compile
|
||||
* `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
|
||||
* `:on-status` - callback when a value is evaluated - default is debug/stacktrace.
|
||||
* `:fiber-flags` - what flags to wrap the compilation fiber with. Default is :ia.
|
||||
* `:expander` - an optional function that is called on each top level form before being compiled.
|
||||
* `:parser` - provide a custom parser that implements the same interface as Janet's built-in parser.
|
||||
* `:read` - optional function to get the next form, called like `(read env source)`.
|
||||
* `:lint-error` - set the minimal lint level to trigger a compilation error. Default is :none.
|
||||
* `:lint-warning` - set minimal lint level to trigger a compilation wanring. Default is :normal.
|
||||
Overrides all parsing.
|
||||
```
|
||||
[opts]
|
||||
|
||||
@@ -2129,25 +2172,34 @@
|
||||
:chunks chunks
|
||||
:on-status onstatus
|
||||
:on-compile-error on-compile-error
|
||||
:on-compile-warning on-compile-warning
|
||||
:on-parse-error on-parse-error
|
||||
:fiber-flags guard
|
||||
:evaluator evaluator
|
||||
:source default-where
|
||||
:parser parser
|
||||
:read read
|
||||
:lint-error lint-error
|
||||
:lint-warning lint-warning
|
||||
:expander expand} opts)
|
||||
(default env (or (fiber/getenv (fiber/current)) @{}))
|
||||
(default chunks (fn [buf p] (getline "" buf env)))
|
||||
(default onstatus debug/stacktrace)
|
||||
(default on-compile-error bad-compile)
|
||||
(default on-compile-warning warn-compile)
|
||||
(default on-parse-error bad-parse)
|
||||
(default evaluator (fn evaluate [x &] (x)))
|
||||
(default default-where "<anonymous>")
|
||||
(default guard :ydt)
|
||||
|
||||
# Convert lint levels to numbers.
|
||||
(def lint-error (or (get lint-levels lint-error lint-error) 0))
|
||||
(def lint-warning (or (get lint-levels lint-warning lint-warning) 2))
|
||||
|
||||
(var where default-where)
|
||||
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(def lints @[])
|
||||
(defn eval1 [source &opt l c]
|
||||
(def source (if expand (expand source) source))
|
||||
(var good true)
|
||||
@@ -2155,13 +2207,22 @@
|
||||
(def f
|
||||
(fiber/new
|
||||
(fn []
|
||||
(def res (compile source env where))
|
||||
(if (= (type res) :function)
|
||||
(evaluator res source env where)
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :line line :column column :fiber errf} res)
|
||||
(on-compile-error err errf where (or line l) (or column c)))))
|
||||
(array/clear lints)
|
||||
(def res (compile source env where lints))
|
||||
(each [level line col msg] lints
|
||||
(def l (get lint-levels level 0))
|
||||
(cond
|
||||
(<= l lint-error) (do
|
||||
(set good false)
|
||||
(on-compile-error msg nil where (or line l) (or col c)))
|
||||
(<= l lint-warning) (on-compile-warning msg where (or line l) (or col c))))
|
||||
(when good
|
||||
(if (= (type res) :function)
|
||||
(evaluator res source env where)
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :line line :column column :fiber errf} res)
|
||||
(on-compile-error err errf where (or line l) (or column c))))))
|
||||
guard))
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
@@ -2247,8 +2308,9 @@
|
||||
nil)
|
||||
|
||||
(defn eval-string
|
||||
`Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use run-context.`
|
||||
``
|
||||
Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[str]
|
||||
(var state (string str))
|
||||
(defn chunks [buf _]
|
||||
@@ -2272,8 +2334,8 @@
|
||||
returnval)
|
||||
|
||||
(defn eval
|
||||
`Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use run-context.`
|
||||
``Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[form]
|
||||
(def res (compile form (fiber/getenv (fiber/current)) "eval"))
|
||||
(if (= (type res) :function)
|
||||
@@ -2333,6 +2395,7 @@
|
||||
(unmarshal image load-image-dict))
|
||||
|
||||
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
|
||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
|
||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||
|
||||
@@ -2379,7 +2442,7 @@
|
||||
(module/add-paths "/init.janet" :source)
|
||||
(module/add-paths ".janet" :source)
|
||||
(module/add-paths ".jimage" :image)
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep])
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(defn- fexists
|
||||
@@ -2627,229 +2690,255 @@
|
||||
`Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
|
||||
or a subset of markdown. This allows a long single line of prose or formatted text to be
|
||||
a well-formed docstring. Returns a buffer containing the formatted text.`
|
||||
[str &opt width indent]
|
||||
[str &opt width indent colorize]
|
||||
|
||||
(default indent 4)
|
||||
(def max-width (- (or width (dyn :doc-width 80)) 8))
|
||||
(def len (length str))
|
||||
(def res @"")
|
||||
(var pos 0)
|
||||
(def line @"")
|
||||
(var line-width 0)
|
||||
(def levels @[0])
|
||||
(var leading 0)
|
||||
(var c nil)
|
||||
(def has-color (if (not= nil colorize)
|
||||
colorize
|
||||
(dyn :doc-color)))
|
||||
|
||||
(set pos 0)
|
||||
# Terminal codes for emission/tokenization
|
||||
(def delimiters
|
||||
(if has-color
|
||||
{:underline ["\e[4m" "\e[24m"]
|
||||
:code ["\e[3;97m" "\e[39;23m"]
|
||||
:italics ["\e[3m" "\e[23m"]
|
||||
:bold ["\e[1m" "\e[22m"]}
|
||||
{:underline ["_" "_"]
|
||||
:code ["`" "`"]
|
||||
:italics ["*" "*"]
|
||||
:bold ["**" "**"]}))
|
||||
(def modes @{})
|
||||
(defn toggle [mode]
|
||||
(def active (get modes mode))
|
||||
(def delims (get delimiters mode))
|
||||
(put modes mode (not active))
|
||||
(delims (if active 1 0)))
|
||||
|
||||
(defn skip-line-indent []
|
||||
(var pos* pos)
|
||||
(set c (get str pos*))
|
||||
(while (and c
|
||||
(not= 10 c)
|
||||
(= 32 c))
|
||||
(set c (get str (++ pos*))))
|
||||
(set leading (- pos* pos))
|
||||
(set pos pos*))
|
||||
# Parse state
|
||||
(var cursor 0) # indexes into string for parsing
|
||||
(var stack @[]) # return value for this block.
|
||||
|
||||
(defn update-levels []
|
||||
(while (< leading (array/peek levels))
|
||||
(array/pop levels)
|
||||
(if (empty? levels) (break))))
|
||||
# Traversal helpers
|
||||
(defn c [] (get str cursor))
|
||||
(defn cn [n] (get str (+ n cursor)))
|
||||
(defn c++ [] (let [ret (get str cursor)] (++ cursor) ret))
|
||||
(defn c+=n [n] (let [ret (get str cursor)] (+= cursor n) ret))
|
||||
# skip* functions return number of characters matched and advance the cursor.
|
||||
(defn skipwhite []
|
||||
(def x cursor)
|
||||
(while (= (c) (chr " ")) (++ cursor))
|
||||
(- cursor x))
|
||||
(defn skipline []
|
||||
(def x cursor)
|
||||
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
|
||||
(c++)
|
||||
(- cursor x))
|
||||
|
||||
(defn start-nl? []
|
||||
(= 10 (get str pos)))
|
||||
# Detection helpers - return number of characters natched
|
||||
(defn ul? []
|
||||
(let [x (c) x1 (cn 1)]
|
||||
(and
|
||||
(= x1 (chr " "))
|
||||
(or (= x (chr "*")) (= x (chr "-")))
|
||||
2)))
|
||||
(defn ol? []
|
||||
(def old cursor)
|
||||
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (c++))
|
||||
(let [c1 (c) c2 (cn 1) c* cursor]
|
||||
(set cursor old)
|
||||
(if (and (= c1 (chr ".")) (= c2 (chr " ")))
|
||||
(- c* cursor -2))))
|
||||
(defn fcb? [] (if (= (chr "`") (c) (cn 1) (cn 2)) 3))
|
||||
(defn nl? [] (= (chr "\n") (c)))
|
||||
|
||||
(defn start-fcb? []
|
||||
(and (= 96 (get str (+ pos)))
|
||||
(= 96 (get str (+ pos 1)))
|
||||
(= 96 (get str (+ pos 2)))))
|
||||
# Parse helper
|
||||
# parse-* functions push nodes to `stack`, and return
|
||||
# the indentation they leave the cursor on.
|
||||
|
||||
(defn end-fcb? []
|
||||
(and (= 96 (get str (+ pos)))
|
||||
(= 96 (get str (+ pos 1)))
|
||||
(= 96 (get str (+ pos 2)))
|
||||
(= 10 (get str (+ pos 3)))))
|
||||
(var parse-blocks nil) # mutual recursion
|
||||
(defn getslice [from to]
|
||||
(def to (min to (length str)))
|
||||
(string/slice str from to))
|
||||
(defn push [x] (array/push stack x))
|
||||
|
||||
(defn start-icb? []
|
||||
(and (not= leading (array/peek levels))
|
||||
(or (= 4 leading)
|
||||
(= 4 (- leading (array/peek levels))))))
|
||||
(defn parse-list [bullet-check initial indent]
|
||||
(def temp-stack @[initial])
|
||||
(def old-stack stack)
|
||||
(set stack temp-stack)
|
||||
(var current-indent indent)
|
||||
(while (and (c) (>= current-indent indent))
|
||||
(def item-indent
|
||||
(when-let [x (bullet-check)]
|
||||
(c+=n x)
|
||||
(+ indent (skipwhite) x)))
|
||||
(unless item-indent
|
||||
(set current-indent (skipwhite))
|
||||
(break))
|
||||
(def item-stack @[])
|
||||
(set stack item-stack)
|
||||
(set current-indent (parse-blocks item-indent))
|
||||
(set stack temp-stack)
|
||||
(push item-stack))
|
||||
(set stack old-stack)
|
||||
(push temp-stack)
|
||||
current-indent)
|
||||
|
||||
(defn start-ul? []
|
||||
(var pos* pos)
|
||||
(var c* (get str pos*))
|
||||
(while (and c* (= 32 c*))
|
||||
(set c* (get str (++ pos*))))
|
||||
(and (or (= 42 c*)
|
||||
(= 43 c*)
|
||||
(= 45 c*))
|
||||
(= 32 (get str (+ pos* 1)))))
|
||||
(defn add-codeblock [indent start end]
|
||||
(def replace-chunk (string "\n" (string/repeat " " indent)))
|
||||
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
|
||||
(skipline)
|
||||
(skipwhite))
|
||||
|
||||
(defn start-ol? []
|
||||
(var pos* pos)
|
||||
(var c* (get str pos*))
|
||||
(while (and c* (= 32 c*))
|
||||
(set c* (get str (++ pos*))))
|
||||
(while (and c*
|
||||
(<= 48 c*)
|
||||
(>= 57 c*))
|
||||
(set c* (get str (++ pos*))))
|
||||
(set c* (get str (-- pos*)))
|
||||
(and (<= 48 c*)
|
||||
(>= 57 c*)
|
||||
(= 46 (get str (+ pos* 1)))
|
||||
(= 32 (get str (+ pos* 2)))))
|
||||
(defn parse-fcb [indent]
|
||||
(c+=n 3)
|
||||
(skipline)
|
||||
(c+=n indent)
|
||||
(def start cursor)
|
||||
(var end cursor)
|
||||
(while (c)
|
||||
(if (fcb?) (break))
|
||||
(skipline)
|
||||
(set end cursor)
|
||||
(skipwhite))
|
||||
(add-codeblock indent start end))
|
||||
|
||||
(defn push-line []
|
||||
(buffer/push-string res (buffer/new-filled indent 32))
|
||||
(set c (get str pos))
|
||||
(while (and c (not= 10 c))
|
||||
(buffer/push-byte res c)
|
||||
(set c (get str (++ pos))))
|
||||
(buffer/push-byte res 10)
|
||||
(++ pos))
|
||||
(defn parse-icb [indent]
|
||||
(var current-indent indent)
|
||||
(def start cursor)
|
||||
(var end cursor)
|
||||
(while (c)
|
||||
(skipline)
|
||||
(set end cursor)
|
||||
(set current-indent (skipwhite))
|
||||
(if (< current-indent indent) (break)))
|
||||
(add-codeblock indent start end))
|
||||
|
||||
(defn push-bullet []
|
||||
(var pos* pos)
|
||||
(buffer/push-string line (buffer/new-filled leading 32))
|
||||
(set c (get str pos*))
|
||||
# Add bullet
|
||||
(while (and c (not= 32 c))
|
||||
(buffer/push-byte line c)
|
||||
(set c (get str (++ pos*))))
|
||||
# Add item indentation
|
||||
(while (= 32 c)
|
||||
(buffer/push-byte line c)
|
||||
(set c (get str (++ pos*))))
|
||||
# Record indentation if necessary
|
||||
(def item-indent (+ leading (- pos* pos)))
|
||||
(when (not= item-indent (array/peek levels))
|
||||
(array/push levels item-indent))
|
||||
# Update line width
|
||||
(+= line-width item-indent)
|
||||
# Update position
|
||||
(set pos pos*))
|
||||
(defn tokenize-line [line]
|
||||
(def tokens @[])
|
||||
(def token @"")
|
||||
(var token-length 0)
|
||||
(defn delim [mode]
|
||||
(def d (toggle mode))
|
||||
(if-not has-color (+= token-length (length d)))
|
||||
(buffer/push token d))
|
||||
(defn endtoken []
|
||||
(if (first token) (array/push tokens [(string token) token-length]))
|
||||
(buffer/clear token)
|
||||
(set token-length 0))
|
||||
(forv i 0 (length line)
|
||||
(def b (get line i))
|
||||
(cond
|
||||
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
|
||||
(= b (chr `\`)) (do
|
||||
(++ token-length)
|
||||
(buffer/push token (get line (++ i))))
|
||||
(= b (chr "_")) (delim :underline)
|
||||
(= b (chr "`")) (delim :code)
|
||||
(= b (chr "*"))
|
||||
(if (= (chr "*") (get line (+ i 1)))
|
||||
(do (++ i)
|
||||
(delim :bold))
|
||||
(delim :italics))
|
||||
(do (++ token-length) (buffer/push token b))))
|
||||
(endtoken)
|
||||
(tuple/slice tokens))
|
||||
|
||||
(defn push-word [hang-indent]
|
||||
(def word @"")
|
||||
(var word-len 0)
|
||||
# Build a word
|
||||
(while (and c
|
||||
(not= 10 c)
|
||||
(not= 32 c))
|
||||
(buffer/push-byte word c)
|
||||
(++ word-len)
|
||||
(set c (get str (++ pos))))
|
||||
# Start new line if necessary
|
||||
(when (> (+ line-width word-len) max-width)
|
||||
# Push existing line
|
||||
(buffer/push-byte line 10)
|
||||
(buffer/push-string res line)
|
||||
(buffer/clear line)
|
||||
# Indent new line
|
||||
(buffer/push-string line (buffer/new-filled hang-indent 32))
|
||||
(set line-width hang-indent))
|
||||
# Add single space if not beginning of line
|
||||
(when (not= line-width hang-indent)
|
||||
(buffer/push-byte line 32)
|
||||
(++ line-width))
|
||||
# Push word onto line
|
||||
(buffer/push-string line word)
|
||||
(set line-width (+ line-width word-len)))
|
||||
(set parse-blocks (fn parse-blocks [indent]
|
||||
(var new-indent indent)
|
||||
(var p-start nil)
|
||||
(var p-end nil)
|
||||
(defn p-line []
|
||||
(unless p-start
|
||||
(set p-start cursor))
|
||||
(skipline)
|
||||
(set p-end cursor)
|
||||
(set new-indent (skipwhite)))
|
||||
(defn finish-p []
|
||||
(when (and p-start (> p-end p-start))
|
||||
(push (tokenize-line (getslice p-start p-end)))
|
||||
(set p-start nil)))
|
||||
(while (and (c) (>= new-indent indent))
|
||||
(cond
|
||||
(nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
|
||||
(ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
|
||||
(ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
|
||||
(fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
|
||||
(>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
|
||||
(p-line)))
|
||||
(finish-p)
|
||||
new-indent))
|
||||
|
||||
(defn push-nl []
|
||||
(when (< pos len)
|
||||
(buffer/push-byte res 10)
|
||||
(++ pos)))
|
||||
(parse-blocks 0)
|
||||
|
||||
(defn push-list []
|
||||
(update-levels)
|
||||
# Indent first line
|
||||
(buffer/push-string line (buffer/new-filled indent 32))
|
||||
(set line-width indent)
|
||||
# Add bullet
|
||||
(push-bullet)
|
||||
# Add words
|
||||
(set c (get str pos))
|
||||
(while (and c
|
||||
(not= 10 c))
|
||||
# Skip spaces
|
||||
(while (= 32 c)
|
||||
(set c (get str (++ pos))))
|
||||
# Add word
|
||||
(push-word (+ indent (array/peek levels)))
|
||||
(def old-c c)
|
||||
(set c (get str (++ pos)))
|
||||
# Check if next line is a new item
|
||||
(when (and (= 10 old-c)
|
||||
(or (start-ul?)
|
||||
(start-ol?)))
|
||||
(set c (get str (-- pos)))))
|
||||
# Add final line
|
||||
(buffer/push-string res line)
|
||||
(buffer/clear line)
|
||||
# Move position back for newline
|
||||
(-- pos)
|
||||
(push-nl))
|
||||
# Emission state
|
||||
(def buf @"")
|
||||
(var current-column 0)
|
||||
|
||||
(defn push-fcb []
|
||||
(update-levels)
|
||||
(push-line)
|
||||
(while (and (< pos len) (not (end-fcb?)))
|
||||
(push-line))
|
||||
(push-line))
|
||||
# Emission
|
||||
(defn emit-indent [indent]
|
||||
(def delta (- indent current-column))
|
||||
(when (< 0 delta)
|
||||
(buffer/push buf (string/repeat " " delta))
|
||||
(set current-column indent)))
|
||||
|
||||
(defn push-icb []
|
||||
(buffer/push-string res (buffer/new-filled leading 32))
|
||||
(push-line)
|
||||
(while (and (< pos len) (not (start-nl?)))
|
||||
(push-line))
|
||||
(push-nl))
|
||||
(defn emit-nl [&opt indent]
|
||||
(buffer/push buf "\n")
|
||||
(set current-column 0))
|
||||
|
||||
(defn push-p []
|
||||
(update-levels)
|
||||
# Set up the indentation
|
||||
(def para-indent (+ indent (array/peek levels)))
|
||||
# Indent first line
|
||||
(buffer/push-string line (buffer/new-filled para-indent 32))
|
||||
(set line-width para-indent)
|
||||
# Add words
|
||||
(set c (get str pos))
|
||||
(while (and c (not= 10 c))
|
||||
# Skip spaces
|
||||
(while (= 32 c)
|
||||
(set c (get str (++ pos))))
|
||||
# Add word
|
||||
(push-word para-indent)
|
||||
(set c (get str (++ pos))))
|
||||
# Add final line
|
||||
(buffer/push-string res line)
|
||||
(buffer/clear line)
|
||||
# Move position back for newline
|
||||
(-- pos)
|
||||
(push-nl)
|
||||
(push-nl))
|
||||
(defn emit-word [word indent &opt len]
|
||||
(def last-byte (last buf))
|
||||
(when (and
|
||||
last-byte
|
||||
(not= last-byte (chr "\n"))
|
||||
(not= last-byte (chr " ")))
|
||||
(buffer/push buf " ")
|
||||
(++ current-column))
|
||||
(default len (length word))
|
||||
(when (and indent (> (+ 1 current-column len) max-width))
|
||||
(emit-nl)
|
||||
(emit-indent indent))
|
||||
(buffer/push buf word)
|
||||
(+= current-column len))
|
||||
|
||||
(while (< pos len)
|
||||
(skip-line-indent)
|
||||
(cond
|
||||
(start-nl?)
|
||||
(push-nl)
|
||||
(defn emit-code
|
||||
[code indent]
|
||||
(def replacement (string "\n" (string/repeat " " (+ 4 indent))))
|
||||
(emit-indent (+ 4 indent))
|
||||
(buffer/push buf (string/replace-all "\n" replacement code))
|
||||
(if (= (chr "\n") (last code))
|
||||
(set current-column 0)
|
||||
(emit-nl)))
|
||||
|
||||
(start-ul?)
|
||||
(push-list)
|
||||
(defn emit-node
|
||||
[el indent]
|
||||
(emit-indent indent)
|
||||
(if (tuple? el)
|
||||
(let [rep (string "\n" (string/repeat " " indent))]
|
||||
(each [word len] el
|
||||
(emit-word
|
||||
(string/replace-all "\n" rep word)
|
||||
indent
|
||||
len))
|
||||
(emit-nl))
|
||||
(case (first el)
|
||||
:ul (for i 1 (length el)
|
||||
(if (> i 1) (emit-indent indent))
|
||||
(emit-word "* " nil)
|
||||
(each subel (get el i) (emit-node subel (+ 2 indent))))
|
||||
:ol (for i 1 (length el)
|
||||
(if (> i 1) (emit-indent indent))
|
||||
(def lab (string/format "%d. " i))
|
||||
(emit-word lab nil)
|
||||
(each subel (get el i) (emit-node subel (+ (length lab) indent))))
|
||||
:cb (emit-code (get el 1) indent))))
|
||||
|
||||
(start-ol?)
|
||||
(push-list)
|
||||
(each el stack
|
||||
(emit-nl)
|
||||
(emit-node el indent))
|
||||
|
||||
(start-fcb?)
|
||||
(push-fcb)
|
||||
|
||||
(start-icb?)
|
||||
(push-icb)
|
||||
|
||||
(push-p)))
|
||||
res)
|
||||
buf)
|
||||
|
||||
(defn- print-index
|
||||
"Print bindings in the current environment given a filter function"
|
||||
@@ -2877,10 +2966,17 @@
|
||||
(print "\n\n"
|
||||
(when d bind-type)
|
||||
(when-let [[path line col] sm]
|
||||
(string " " path (when (and line col) (string " on line " line ", column " col)) "\n"))
|
||||
(when (or d sm) "\n")
|
||||
(if d (doc-format d) " no documentation found.")
|
||||
"\n\n"))
|
||||
(string " " path (when (and line col) (string " on line " line ", column " col))))
|
||||
(when sm "\n")
|
||||
(if d (doc-format d) "\n no documentation found.\n")
|
||||
"\n"))
|
||||
|
||||
(defn- print-special-form-entry
|
||||
[x]
|
||||
(print "\n\n"
|
||||
(string " special form\n\n")
|
||||
(string " (" x " ...)\n\n")
|
||||
(string " See https://janet-lang.org/docs/specials.html\n\n")))
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment. Function form of doc."
|
||||
@@ -2894,14 +2990,17 @@
|
||||
(do
|
||||
(def x (dyn sym))
|
||||
(if (not x)
|
||||
(do
|
||||
(def [fullpath mod-kind] (module/find (string sym)))
|
||||
(if-let [mod-env (in module/cache fullpath)]
|
||||
(print-module-entry {:module true
|
||||
:kind mod-kind
|
||||
:source-map [fullpath nil nil]
|
||||
:doc (in mod-env :doc)})
|
||||
(print "symbol " sym " not found.")))
|
||||
(if (index-of sym '[break def do fn if quasiquote quote
|
||||
set splice unquote upscope var while])
|
||||
(print-special-form-entry sym)
|
||||
(do
|
||||
(def [fullpath mod-kind] (module/find (string sym)))
|
||||
(if-let [mod-env (in module/cache fullpath)]
|
||||
(print-module-entry {:module true
|
||||
:kind mod-kind
|
||||
:source-map [fullpath nil nil]
|
||||
:doc (in mod-env :doc)})
|
||||
(print "symbol " sym " not found."))))
|
||||
(print-module-entry x)))
|
||||
|
||||
# else
|
||||
@@ -3100,12 +3199,13 @@
|
||||
###
|
||||
|
||||
(defn repl
|
||||
`Run a repl. The first parameter is an optional function to call to
|
||||
``Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code that should return nil for end of file.
|
||||
The second parameter is a function that is called when a signal is
|
||||
caught. One can provide an optional environment table to run
|
||||
the repl in, as well as an optional parser or read function to pass
|
||||
to run-context.`
|
||||
to `run-context.`
|
||||
``
|
||||
[&opt chunks onsignal env parser read]
|
||||
(default env (make-env))
|
||||
(default chunks
|
||||
@@ -3127,8 +3227,6 @@
|
||||
(put nextenv :debug-level level)
|
||||
(put nextenv :signal x)
|
||||
(merge-into nextenv debugger-env)
|
||||
(debug/stacktrace f x)
|
||||
(eflush)
|
||||
(defn debugger-chunks [buf p]
|
||||
(def status (:state p :delimiters))
|
||||
(def c ((:where p) 0))
|
||||
@@ -3142,14 +3240,18 @@
|
||||
(nextenv :resume-value))
|
||||
|
||||
(fn [f x]
|
||||
(if (= :dead (fiber/status f))
|
||||
(def fs (fiber/status f))
|
||||
(if (= :dead fs)
|
||||
(do
|
||||
(put e '_ @{:value x})
|
||||
(printf (get e :pretty-format "%q") x)
|
||||
(flush))
|
||||
(if (e :debug)
|
||||
(enter-debugger f x)
|
||||
(do (debug/stacktrace f x) (eflush))))))
|
||||
(do
|
||||
(def ec (dyn :err-color))
|
||||
(eprint (if ec "\e[31m" "") fs ": " x)
|
||||
(debug/stacktrace f)
|
||||
(eflush)
|
||||
(if (e :debug) (enter-debugger f x))))))
|
||||
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
@@ -3266,7 +3368,11 @@
|
||||
[thunk source env where]
|
||||
(when (tuple? source)
|
||||
(def head (source 0))
|
||||
(def safe-check (safe-forms head))
|
||||
(def safe-check
|
||||
(or
|
||||
(safe-forms head)
|
||||
(if (symbol? head)
|
||||
(if (string/has-prefix? "define-" head) is-safe-def))))
|
||||
(cond
|
||||
# Sometimes safe form
|
||||
(function? safe-check)
|
||||
@@ -3425,6 +3531,7 @@
|
||||
(getter (getprompt p) buf env))
|
||||
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(setdyn :doc-color (if *colorize* true))
|
||||
(repl getchunk nil env)))))
|
||||
|
||||
###
|
||||
@@ -3526,7 +3633,6 @@
|
||||
"src/core/table.c"
|
||||
"src/core/thread.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/typedarray.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
"src/core/vector.c"
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 15
|
||||
#define JANET_VERSION_PATCH 4
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.15.4"
|
||||
#define JANET_VERSION_MINOR 16
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.16.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -27,7 +27,6 @@
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_EV */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
@@ -49,6 +48,13 @@
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_EPOLL */
|
||||
|
||||
/* Custom vm allocator support */
|
||||
/* #include <mimalloc.h> */
|
||||
/* #define janet_malloc(X) mi_malloc((X)) */
|
||||
/* #define janet_realloc(X, Y) mi_realloc((X), (Y)) */
|
||||
/* #define janet_calloc(X, Y) mi_calloc((X), (Y)) */
|
||||
/* #define janet_free(X) mi_free((X)) */
|
||||
|
||||
/* Main client settings, does not affect library code */
|
||||
/* #define JANET_SIMPLE_GETLINE */
|
||||
|
||||
|
||||
@@ -36,7 +36,7 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -52,7 +52,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
array->capacity = n;
|
||||
array->count = n;
|
||||
array->data = malloc(sizeof(Janet) * (size_t) n);
|
||||
array->data = janet_malloc(sizeof(Janet) * (size_t) n);
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -68,7 +68,7 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
int64_t new_capacity = ((int64_t) capacity) * growth;
|
||||
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
|
||||
capacity = (int32_t) new_capacity;
|
||||
newData = realloc(old, capacity * sizeof(Janet));
|
||||
newData = janet_realloc(old, capacity * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -275,7 +275,7 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
if (array->count < array->capacity) {
|
||||
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
|
||||
Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -284,7 +284,7 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
}
|
||||
} else {
|
||||
array->capacity = 0;
|
||||
free(array->data);
|
||||
janet_free(array->data);
|
||||
array->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
|
||||
@@ -224,7 +224,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
||||
janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
|
||||
if (envindex >= a->environments_capacity) {
|
||||
int32_t newcap = 2 * envindex;
|
||||
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
|
||||
def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -582,7 +582,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
|
||||
if (NULL == def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -614,7 +614,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
newlen = def->defs_length + 1;
|
||||
if (a.defs_capacity < newlen) {
|
||||
int32_t newcap = newlen;
|
||||
def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
if (NULL == def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -643,7 +643,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
/* Allocate bytecode array */
|
||||
def->bytecode_length = blength;
|
||||
def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -685,7 +685,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -711,7 +711,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -33,7 +33,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -45,7 +45,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
free(buffer->data);
|
||||
janet_free(buffer->data);
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
@@ -62,7 +62,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -92,7 +92,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -201,7 +201,7 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = realloc(buffer->data, newcap);
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -53,6 +53,36 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
|
||||
janetc_error(c, janet_cstring(m));
|
||||
}
|
||||
|
||||
static const char *janet_lint_level_names[] = {
|
||||
"relaxed",
|
||||
"normal",
|
||||
"strict"
|
||||
};
|
||||
|
||||
/* Emit compiler linter messages */
|
||||
void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
|
||||
if (NULL != c->lints) {
|
||||
/* format message */
|
||||
va_list args;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
const uint8_t *str = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
/* construct linting payload */
|
||||
Janet *payload = janet_tuple_begin(4);
|
||||
payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
|
||||
payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line);
|
||||
payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column);
|
||||
payload[3] = janet_wrap_string(str);
|
||||
janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
|
||||
}
|
||||
}
|
||||
|
||||
/* Free a slot */
|
||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
|
||||
@@ -199,24 +229,41 @@ JanetSlot janetc_resolve(
|
||||
|
||||
/* Symbol not found - check for global */
|
||||
{
|
||||
Janet check;
|
||||
JanetBindingType btype = janet_resolve(c->env, sym, &check);
|
||||
switch (btype) {
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
switch (binding.type) {
|
||||
default:
|
||||
case JANET_BINDING_NONE:
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
case JANET_BINDING_DEF:
|
||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||
return janetc_cslot(check);
|
||||
ret = janetc_cslot(binding.value);
|
||||
break;
|
||||
case JANET_BINDING_VAR: {
|
||||
JanetSlot ret = janetc_cslot(check);
|
||||
/* TODO save type info */
|
||||
ret = janetc_cslot(binding.value);
|
||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||
ret.flags &= ~JANET_SLOT_CONSTANT;
|
||||
return ret;
|
||||
break;
|
||||
}
|
||||
}
|
||||
JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
|
||||
switch (binding.deprecation) {
|
||||
case JANET_BINDING_DEP_NONE:
|
||||
break;
|
||||
case JANET_BINDING_DEP_RELAXED:
|
||||
depLevel = JANET_C_LINT_RELAXED;
|
||||
break;
|
||||
case JANET_BINDING_DEP_NORMAL:
|
||||
depLevel = JANET_C_LINT_NORMAL;
|
||||
break;
|
||||
case JANET_BINDING_DEP_STRICT:
|
||||
depLevel = JANET_C_LINT_STRICT;
|
||||
break;
|
||||
}
|
||||
if (binding.deprecation != JANET_BINDING_DEP_NONE) {
|
||||
janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Symbol was found */
|
||||
@@ -399,6 +446,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
||||
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
|
||||
janetc_value(opts, x);
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
|
||||
janetc_popscope(c);
|
||||
if (c->buffer) {
|
||||
janet_v__cnt(c->buffer) = bufstart;
|
||||
@@ -504,10 +552,40 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetSlot retslot;
|
||||
janetc_pushslots(c, slots);
|
||||
janetc_freeslots(c, slots);
|
||||
retslot = janetc_gettarget(opts);
|
||||
janetc_emit_s(c, op, retslot, 1);
|
||||
|
||||
/* Check if this structure is composed entirely of constants */
|
||||
int can_inline = 1;
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i++) {
|
||||
if (!(slots[i].flags & JANET_SLOT_CONSTANT) ||
|
||||
(slots[i].flags & JANET_SLOT_SPLICED)) {
|
||||
can_inline = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (can_inline && (op == JOP_MAKE_STRUCT)) {
|
||||
JanetKV *st = janet_struct_begin(janet_v_count(slots) / 2);
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i += 2) {
|
||||
Janet k = slots[i].constant;
|
||||
Janet v = slots[i + 1].constant;
|
||||
janet_struct_put(st, k, v);
|
||||
}
|
||||
retslot = janetc_cslot(janet_wrap_struct(janet_struct_end(st)));
|
||||
janetc_freeslots(c, slots);
|
||||
} else if (can_inline && (op == JOP_MAKE_TUPLE)) {
|
||||
Janet *tup = janet_tuple_begin(janet_v_count(slots));
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i++) {
|
||||
tup[i] = slots[i].constant;
|
||||
}
|
||||
retslot = janetc_cslot(janet_wrap_tuple(janet_tuple_end(tup)));
|
||||
janetc_freeslots(c, slots);
|
||||
} else {
|
||||
janetc_pushslots(c, slots);
|
||||
janetc_freeslots(c, slots);
|
||||
retslot = janetc_gettarget(opts);
|
||||
janetc_emit_s(c, op, retslot, 1);
|
||||
}
|
||||
|
||||
return retslot;
|
||||
}
|
||||
|
||||
@@ -601,6 +679,9 @@ static int macroexpand1(
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
if (c->lints) {
|
||||
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
|
||||
}
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@@ -745,7 +826,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
|
||||
if (def->bytecode_length) {
|
||||
size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
|
||||
def->bytecode = malloc(s);
|
||||
def->bytecode = janet_malloc(s);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -753,7 +834,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
|
||||
def->sourcemap = malloc(s);
|
||||
def->sourcemap = janet_malloc(s);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -778,7 +859,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||
/* numchunks is min of slotchunks and scope->ua.count */
|
||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||
uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
|
||||
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -795,7 +876,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Initialize a compiler */
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
c->scope = NULL;
|
||||
c->buffer = NULL;
|
||||
c->mapbuffer = NULL;
|
||||
@@ -804,6 +885,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
|
||||
c->source = where;
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
c->lints = lints;
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
@@ -821,12 +903,13 @@ static void janetc_deinit(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Compile a form. */
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
JanetCompileResult janet_compile_lint(Janet source,
|
||||
JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
JanetCompiler c;
|
||||
JanetScope rootscope;
|
||||
JanetFopts fopts;
|
||||
|
||||
janetc_init(&c, env, where);
|
||||
janetc_init(&c, env, where, lints);
|
||||
|
||||
/* Push a function scope */
|
||||
janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
|
||||
@@ -854,19 +937,24 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
return c.result;
|
||||
}
|
||||
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
return janet_compile_lint(source, env, where, NULL);
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm_fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc == 3) {
|
||||
if (argc >= 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
} else {
|
||||
@@ -888,11 +976,13 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
JDOC("(compile ast &opt env source lints)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||
"struct with keys :line, :column, and :error if compilation fails.")
|
||||
"struct with keys :line, :column, and :error if compilation fails. "
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -29,6 +29,13 @@
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
/* Levels for compiler warnings */
|
||||
typedef enum {
|
||||
JANET_C_LINT_RELAXED,
|
||||
JANET_C_LINT_NORMAL,
|
||||
JANET_C_LINT_STRICT
|
||||
} JanetCompileLintLevel;
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
#define JANET_FUN_ERROR 2
|
||||
@@ -78,10 +85,10 @@ typedef struct JanetSpecial JanetSpecial;
|
||||
#define JANET_SLOT_MUTABLE 0x40000
|
||||
#define JANET_SLOT_REF 0x80000
|
||||
#define JANET_SLOT_RETURNED 0x100000
|
||||
/* Needed for handling single element arrays as global vars. */
|
||||
|
||||
/* Used for unquote-splicing */
|
||||
#define JANET_SLOT_SPLICED 0x200000
|
||||
#define JANET_SLOT_DEP_NOTE 0x200000
|
||||
#define JANET_SLOT_DEP_WARN 0x400000
|
||||
#define JANET_SLOT_DEP_ERROR 0x800000
|
||||
#define JANET_SLOT_SPLICED 0x1000000
|
||||
|
||||
#define JANET_SLOTTYPE_ANY 0xFFFF
|
||||
|
||||
@@ -164,6 +171,9 @@ struct JanetCompiler {
|
||||
|
||||
/* Prevent unbounded recursion */
|
||||
int recursion_guard;
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@@ -230,6 +240,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_error(JanetCompiler *c, const uint8_t *m);
|
||||
void janetc_cerror(JanetCompiler *c, const char *m);
|
||||
|
||||
/* Linting */
|
||||
void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
|
||||
|
||||
/* Dispatch to correct form compiler */
|
||||
JanetSlot janetc_value(JanetFopts opts, Janet x);
|
||||
|
||||
|
||||
@@ -70,7 +70,7 @@ static char *get_processed_name(const char *name) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = malloc(l + 3);
|
||||
char *ret = janet_malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -85,7 +85,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (name != processed_name) free(processed_name);
|
||||
if (name != processed_name) janet_free(processed_name);
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
@@ -754,7 +754,7 @@ static void janet_quick_asm(
|
||||
def->max_arity = max_arity;
|
||||
def->flags = flags;
|
||||
def->slotcount = slots;
|
||||
def->bytecode = malloc(bytecode_size);
|
||||
def->bytecode = janet_malloc(bytecode_size);
|
||||
def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
|
||||
def->name = janet_cstring(name);
|
||||
if (!def->bytecode) {
|
||||
@@ -1026,9 +1026,6 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_ASSEMBLER
|
||||
janet_lib_asm(env);
|
||||
#endif
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
janet_lib_typed_array(env);
|
||||
#endif
|
||||
#ifdef JANET_INT_TYPES
|
||||
janet_lib_inttypes(env);
|
||||
#endif
|
||||
|
||||
@@ -90,7 +90,7 @@ static void janet_q_init(JanetQueue *q) {
|
||||
}
|
||||
|
||||
static void janet_q_deinit(JanetQueue *q) {
|
||||
free(q->data);
|
||||
janet_free(q->data);
|
||||
}
|
||||
|
||||
static int32_t janet_q_count(JanetQueue *q) {
|
||||
@@ -106,7 +106,7 @@ static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
|
||||
if (count + 1 >= JANET_MAX_Q_CAPACITY) return 1;
|
||||
int32_t newcap = (count + 2) * 2;
|
||||
if (newcap > JANET_MAX_Q_CAPACITY) newcap = JANET_MAX_Q_CAPACITY;
|
||||
q->data = realloc(q->data, itemsize * newcap);
|
||||
q->data = janet_realloc(q->data, itemsize * newcap);
|
||||
if (NULL == q->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -213,7 +213,7 @@ static void add_timeout(JanetTimeout to) {
|
||||
size_t newcount = oldcount + 1;
|
||||
if (newcount > janet_vm_tq_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
JanetTimeout *tq = realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
|
||||
JanetTimeout *tq = janet_realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
|
||||
if (NULL == tq) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -247,7 +247,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
|
||||
}
|
||||
if (size < sizeof(JanetListenerState))
|
||||
size = sizeof(JanetListenerState);
|
||||
JanetListenerState *state = malloc(size);
|
||||
JanetListenerState *state = janet_malloc(size);
|
||||
if (NULL == state) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -264,7 +264,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
|
||||
int resize = janet_vm_listener_cap == janet_vm_listener_count;
|
||||
if (resize) {
|
||||
size_t newcap = janet_vm_listener_count ? janet_vm_listener_cap * 2 : 16;
|
||||
janet_vm_listeners = realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
|
||||
janet_vm_listeners = janet_realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
|
||||
if (NULL == janet_vm_listeners) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -301,7 +301,7 @@ static void janet_unlisten_impl(JanetListenerState *state) {
|
||||
size_t index = state->_index;
|
||||
janet_vm_listeners[index] = janet_vm_listeners[--janet_vm_listener_count];
|
||||
janet_vm_listeners[index]->_index = index;
|
||||
free(state);
|
||||
janet_free(state);
|
||||
}
|
||||
|
||||
static const JanetMethod ev_default_stream_methods[] = {
|
||||
@@ -557,8 +557,8 @@ void janet_ev_init_common(void) {
|
||||
/* Common deinit code */
|
||||
void janet_ev_deinit_common(void) {
|
||||
janet_q_deinit(&janet_vm_spawn);
|
||||
free(janet_vm_tq);
|
||||
free(janet_vm_listeners);
|
||||
janet_free(janet_vm_tq);
|
||||
janet_free(janet_vm_listeners);
|
||||
janet_vm_listeners = NULL;
|
||||
}
|
||||
|
||||
@@ -1042,7 +1042,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
/* Custom event */
|
||||
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
|
||||
response->cb(response->msg);
|
||||
free(response);
|
||||
janet_free(response);
|
||||
janet_ev_dec_refcount();
|
||||
} else {
|
||||
/* Normal event */
|
||||
@@ -1080,7 +1080,7 @@ static JanetTimestamp ts_now(void) {
|
||||
}
|
||||
|
||||
static int make_epoll_events(int mask) {
|
||||
int events = EPOLLET;
|
||||
int events = 0;
|
||||
if (mask & JANET_ASYNC_LISTEN_READ)
|
||||
events |= EPOLLIN;
|
||||
if (mask & JANET_ASYNC_LISTEN_WRITE)
|
||||
@@ -1176,7 +1176,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
|
||||
if (mask & EPOLLERR)
|
||||
status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
|
||||
if (mask & EPOLLHUP)
|
||||
if ((mask & EPOLLHUP) && !(mask & (EPOLLOUT | EPOLLIN)))
|
||||
status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
|
||||
if (status1 == JANET_ASYNC_STATUS_DONE ||
|
||||
status2 == JANET_ASYNC_STATUS_DONE ||
|
||||
@@ -1249,7 +1249,7 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
|
||||
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
|
||||
size_t newsize = janet_vm_listener_cap;
|
||||
if (newsize > oldsize) {
|
||||
janet_vm_fds = realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
|
||||
janet_vm_fds = janet_realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1306,7 +1306,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
|
||||
if (mask & POLLERR)
|
||||
status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
|
||||
if (mask & POLLHUP)
|
||||
if ((mask & POLLHUP) && !(mask & (POLLIN | POLLOUT)))
|
||||
status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
|
||||
if (status1 == JANET_ASYNC_STATUS_DONE ||
|
||||
status2 == JANET_ASYNC_STATUS_DONE ||
|
||||
@@ -1320,7 +1320,7 @@ void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
janet_vm_fds = NULL;
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm_fds = malloc(sizeof(struct pollfd));
|
||||
janet_vm_fds = janet_malloc(sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1333,7 +1333,7 @@ void janet_ev_init(void) {
|
||||
void janet_ev_deinit(void) {
|
||||
janet_ev_deinit_common();
|
||||
janet_ev_cleanup_selfpipe();
|
||||
free(janet_vm_fds);
|
||||
janet_free(janet_vm_fds);
|
||||
janet_vm_fds = NULL;
|
||||
}
|
||||
|
||||
@@ -1371,7 +1371,7 @@ static void *janet_thread_body(void *ptr) {
|
||||
JanetThreadedSubroutine subr = init->subr;
|
||||
JanetThreadedCallback cb = init->cb;
|
||||
int fd = init->write_pipe;
|
||||
free(init);
|
||||
janet_free(init);
|
||||
JanetSelfPipeEvent response;
|
||||
response.msg = subr(msg);
|
||||
response.cb = cb;
|
||||
@@ -1391,7 +1391,7 @@ static void *janet_thread_body(void *ptr) {
|
||||
#endif
|
||||
|
||||
void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb) {
|
||||
JanetEVThreadInit *init = malloc(sizeof(JanetEVThreadInit));
|
||||
JanetEVThreadInit *init = janet_malloc(sizeof(JanetEVThreadInit));
|
||||
if (NULL == init) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1403,7 +1403,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
init->write_pipe = janet_vm_iocp;
|
||||
HANDLE thread_handle = CreateThread(NULL, 0, janet_thread_body, init, 0, NULL);
|
||||
if (NULL == thread_handle) {
|
||||
free(init);
|
||||
janet_free(init);
|
||||
janet_panic("failed to create thread");
|
||||
}
|
||||
CloseHandle(thread_handle); /* detach from thread */
|
||||
@@ -1412,7 +1412,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
pthread_t waiter_thread;
|
||||
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
|
||||
if (err) {
|
||||
free(init);
|
||||
janet_free(init);
|
||||
janet_panicf("%s", strerror(err));
|
||||
}
|
||||
pthread_detach(waiter_thread);
|
||||
@@ -1435,7 +1435,7 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
case JANET_EV_TCTAG_STRING:
|
||||
case JANET_EV_TCTAG_STRINGF:
|
||||
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_KEYWORD:
|
||||
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
@@ -1443,7 +1443,7 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
case JANET_EV_TCTAG_ERR_STRING:
|
||||
case JANET_EV_TCTAG_ERR_STRINGF:
|
||||
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_ERR_KEYWORD:
|
||||
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
@@ -2092,7 +2092,7 @@ static Janet cfun_ev_thread(int32_t argc, Janet *argv) {
|
||||
janet_getfiber(argv, 0);
|
||||
Janet value = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
/* Marshal arguments for the new thread. */
|
||||
JanetBuffer *buffer = malloc(sizeof(JanetBuffer));
|
||||
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
||||
if (NULL == buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -53,7 +53,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
capacity = 32;
|
||||
}
|
||||
fiber->capacity = capacity;
|
||||
data = malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -100,12 +100,12 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
|
||||
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
int32_t n = fiber->capacity;
|
||||
if (n) {
|
||||
Janet *newData = malloc(sizeof(Janet) * n);
|
||||
Janet *newData = janet_malloc(sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
|
||||
free(fiber->data);
|
||||
janet_free(fiber->data);
|
||||
fiber->data = newData;
|
||||
}
|
||||
}
|
||||
@@ -115,7 +115,7 @@ static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
int32_t old_size = fiber->capacity;
|
||||
int32_t diff = n - old_size;
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -254,7 +254,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = malloc(s);
|
||||
Janet *vmem = janet_malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
@@ -290,13 +290,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_ARRAY:
|
||||
free(((JanetArray *) mem)->data);
|
||||
janet_free(((JanetArray *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_TABLE:
|
||||
free(((JanetTable *) mem)->data);
|
||||
janet_free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
free(((JanetFiber *)mem)->data);
|
||||
janet_free(((JanetFiber *)mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
@@ -311,18 +311,18 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
case JANET_MEMORY_FUNCENV: {
|
||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||
if (0 == env->offset)
|
||||
free(env->as.values);
|
||||
janet_free(env->as.values);
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_FUNCDEF: {
|
||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||
/* TODO - get this all with one alloc and one free */
|
||||
free(def->defs);
|
||||
free(def->environments);
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
janet_free(def->defs);
|
||||
janet_free(def->environments);
|
||||
janet_free(def->constants);
|
||||
janet_free(def->bytecode);
|
||||
janet_free(def->sourcemap);
|
||||
janet_free(def->closure_bitset);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -347,7 +347,7 @@ void janet_sweep() {
|
||||
} else {
|
||||
janet_vm_blocks = next;
|
||||
}
|
||||
free(current);
|
||||
janet_free(current);
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
@@ -359,7 +359,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
|
||||
/* Make sure everything is inited */
|
||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||
mem = malloc(size);
|
||||
mem = janet_malloc(size);
|
||||
|
||||
/* Check for bad malloc */
|
||||
if (NULL == mem) {
|
||||
@@ -382,7 +382,7 @@ static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
free(s);
|
||||
janet_free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
@@ -434,7 +434,7 @@ void janet_gcroot(Janet root) {
|
||||
size_t newcount = janet_vm_root_count + 1;
|
||||
if (newcount > janet_vm_root_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm_roots) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -494,12 +494,12 @@ void janet_clear_memory(void) {
|
||||
while (NULL != current) {
|
||||
janet_deinit_block(current);
|
||||
JanetGCObject *next = current->next;
|
||||
free(current);
|
||||
janet_free(current);
|
||||
current = next;
|
||||
}
|
||||
janet_vm_blocks = NULL;
|
||||
janet_free_all_scratch();
|
||||
free(janet_scratch_mem);
|
||||
janet_free(janet_scratch_mem);
|
||||
}
|
||||
|
||||
/* Primitives for suspending GC. */
|
||||
@@ -513,14 +513,14 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
s->finalize = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -547,7 +547,7 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
|
||||
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -544,7 +544,7 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
/* Clear buffer to make things easier for GC */
|
||||
buf->count = 0;
|
||||
buf->capacity = 0;
|
||||
free(buf->data);
|
||||
janet_free(buf->data);
|
||||
buf->data = NULL;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -738,7 +738,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -834,7 +834,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal constants */
|
||||
if (constants_length) {
|
||||
def->constants = malloc(sizeof(Janet) * constants_length);
|
||||
def->constants = janet_malloc(sizeof(Janet) * constants_length);
|
||||
if (!def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -846,7 +846,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->constants_length = constants_length;
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -855,7 +855,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal environments */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
|
||||
def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
if (!def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -869,7 +869,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal sub funcdefs */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
|
||||
def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
if (!def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -884,7 +884,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
/* Unmarshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
int32_t current = 0;
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
if (!def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -900,7 +900,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
/* Unmarshal closure bitset if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
int32_t n = (def->slotcount + 31) >> 5;
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
|
||||
def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -961,7 +961,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -265,19 +265,20 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
#ifndef JANET_WINDOWS
|
||||
if (janet_keyeq(argv[offset], "unix")) {
|
||||
const char *path = janet_getcstring(argv, offset + 1);
|
||||
struct sockaddr_un *saddr = calloc(1, sizeof(struct sockaddr_un));
|
||||
struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un));
|
||||
if (saddr == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
saddr->sun_family = AF_UNIX;
|
||||
size_t path_size = sizeof(saddr->sun_path);
|
||||
#ifdef JANET_LINUX
|
||||
if (path[0] == '@') {
|
||||
saddr->sun_path[0] = '\0';
|
||||
snprintf(saddr->sun_path + 1, 107, "%s", path + 1);
|
||||
snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
snprintf(saddr->sun_path, 108, "%s", path);
|
||||
snprintf(saddr->sun_path, path_size, "%s", path);
|
||||
}
|
||||
*is_unix = 1;
|
||||
return (struct addrinfo *) saddr;
|
||||
@@ -397,7 +398,7 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
int status = connect(sock, addr, addrlen);
|
||||
if (is_unix) {
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
} else {
|
||||
freeaddrinfo(ai);
|
||||
}
|
||||
@@ -431,6 +432,47 @@ static const char *serverify_socket(JSock sfd) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_SHUTDOWN_RW SD_BOTH
|
||||
#define JANET_SHUTDOWN_R SD_RECEIVE
|
||||
#define JANET_SHUTDOWN_W SD_SEND
|
||||
#else
|
||||
#define JANET_SHUTDOWN_RW SHUT_RDWR
|
||||
#define JANET_SHUTDOWN_R SHUT_RD
|
||||
#define JANET_SHUTDOWN_W SHUT_WR
|
||||
#endif
|
||||
|
||||
static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
||||
int shutdown_type = JANET_SHUTDOWN_RW;
|
||||
if (argc == 2) {
|
||||
const uint8_t *kw = janet_getkeyword(argv, 1);
|
||||
if (0 == janet_cstrcmp(kw, "rw")) {
|
||||
shutdown_type = JANET_SHUTDOWN_RW;
|
||||
} else if (0 == janet_cstrcmp(kw, "r")) {
|
||||
shutdown_type = JANET_SHUTDOWN_R;
|
||||
} else if (0 == janet_cstrcmp(kw, "w")) {
|
||||
shutdown_type = JANET_SHUTDOWN_W;
|
||||
} else {
|
||||
janet_panicf("unexpected keyword %v", argv[1]);
|
||||
}
|
||||
}
|
||||
int status;
|
||||
#ifdef JANET_WINDOWS
|
||||
status = shutdown((SOCKET) stream->handle, shutdown_type);
|
||||
#else
|
||||
do {
|
||||
status = shutdown(stream->handle, shutdown_type);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
#endif
|
||||
if (status) {
|
||||
janet_panicf("could not shutdown socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
@@ -444,20 +486,20 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
if (is_unix) {
|
||||
sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sfd)) {
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
|
||||
JSOCKCLOSE(sfd);
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
if (err) {
|
||||
janet_panic(err);
|
||||
} else {
|
||||
janet_panicf("could not bind socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
}
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
@@ -622,6 +664,7 @@ static const JanetMethod net_stream_methods[] = {
|
||||
{"evread", janet_cfun_stream_read},
|
||||
{"evchunk", janet_cfun_stream_chunk},
|
||||
{"evwrite", janet_cfun_stream_write},
|
||||
{"shutdown", cfun_net_shutdown},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -709,6 +752,16 @@ static const JanetReg net_cfuns[] = {
|
||||
"that can be used to communicate with the server. Type is an optional keyword "
|
||||
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
|
||||
},
|
||||
{
|
||||
"net/shutdown", cfun_net_shutdown,
|
||||
JDOC("(net/shutdown stream &opt mode)\n\n"
|
||||
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
||||
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
||||
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
||||
"* `:r` disables reading new data from the socket.\n"
|
||||
"* `:w` disable writing data to the socket.\n\n"
|
||||
"Returns the original socket.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -56,7 +56,12 @@
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
#ifdef JANET_APPLE
|
||||
#include <crt_externs.h>
|
||||
#define environ (*_NSGetEnviron())
|
||||
#else
|
||||
extern char **environ;
|
||||
#endif
|
||||
#ifdef JANET_THREADS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
@@ -998,7 +1003,7 @@ static Janet os_spawn(int32_t argc, Janet *argv) {
|
||||
/* Runs in a separate thread */
|
||||
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
int stat = system((const char *) args.argp);
|
||||
free(args.argp);
|
||||
janet_free(args.argp);
|
||||
if (args.argi) {
|
||||
args.tag = JANET_EV_TCTAG_INTEGER;
|
||||
} else {
|
||||
@@ -1761,7 +1766,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
||||
Janet ret = janet_cstringv(dest);
|
||||
free(dest);
|
||||
janet_free(dest);
|
||||
return ret;
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -123,7 +123,7 @@ static void NAME(JanetParser *p, T x) { \
|
||||
if (newcount > p->STACKCAP) { \
|
||||
T *next; \
|
||||
size_t newcap = 2 * newcount; \
|
||||
next = realloc(p->STACK, sizeof(T) * newcap); \
|
||||
next = janet_realloc(p->STACK, sizeof(T) * newcap); \
|
||||
if (NULL == next) { \
|
||||
JANET_OUT_OF_MEMORY; \
|
||||
} \
|
||||
@@ -783,9 +783,9 @@ void janet_parser_init(JanetParser *parser) {
|
||||
}
|
||||
|
||||
void janet_parser_deinit(JanetParser *parser) {
|
||||
free(parser->args);
|
||||
free(parser->buf);
|
||||
free(parser->states);
|
||||
janet_free(parser->args);
|
||||
janet_free(parser->buf);
|
||||
janet_free(parser->states);
|
||||
}
|
||||
|
||||
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
@@ -812,17 +812,17 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
dest->states = NULL;
|
||||
dest->buf = NULL;
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
dest->buf = janet_malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
dest->args = janet_malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
@@ -943,7 +943,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
size_t newcount = p->bufcount + slen;
|
||||
if (p->bufcap < newcount) {
|
||||
size_t newcap = 2 * newcount;
|
||||
p->buf = realloc(p->buf, newcap);
|
||||
p->buf = janet_realloc(p->buf, newcap);
|
||||
if (p->buf == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1148,7 +1148,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
|
||||
nextPeg = janet_table_get(b->default_grammar, peg);
|
||||
nextPeg = (b->default_grammar == NULL)
|
||||
? janet_wrap_nil()
|
||||
: janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
@@ -1335,7 +1337,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
* bytecode. */
|
||||
uint32_t blen = (int32_t) peg->bytecode_len;
|
||||
uint32_t clen = peg->num_constants;
|
||||
uint8_t *op_flags = calloc(1, blen);
|
||||
uint8_t *op_flags = janet_calloc(1, blen);
|
||||
if (NULL == op_flags) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1466,11 +1468,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
peg->bytecode = bytecode;
|
||||
peg->constants = constants;
|
||||
peg->has_backref = has_backref;
|
||||
free(op_flags);
|
||||
janet_free(op_flags);
|
||||
return peg;
|
||||
|
||||
bad:
|
||||
free(op_flags);
|
||||
janet_free(op_flags);
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
|
||||
@@ -617,7 +617,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (mincap >= INT32_MAX / 2) {
|
||||
S->keysort_capacity = INT32_MAX;
|
||||
} else {
|
||||
S->keysort_capacity = mincap * 2;
|
||||
S->keysort_capacity = (int32_t)(mincap * 2);
|
||||
}
|
||||
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
|
||||
if (NULL == S->keysort_buffer) {
|
||||
|
||||
@@ -36,7 +36,7 @@ void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||
}
|
||||
|
||||
void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
|
||||
free(ra->chunks);
|
||||
janet_free(ra->chunks);
|
||||
}
|
||||
|
||||
/* Fallbacks for when ctz not available */
|
||||
@@ -70,7 +70,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
|
||||
size = sizeof(uint32_t) * (size_t) dest->capacity;
|
||||
dest->regtemps = 0;
|
||||
if (size) {
|
||||
dest->chunks = malloc(size);
|
||||
dest->chunks = janet_malloc(size);
|
||||
if (!dest->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -87,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
|
||||
int32_t newcount = ra->count + 1;
|
||||
if (newcount > ra->capacity) {
|
||||
int32_t newcapacity = newcount * 2;
|
||||
ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
if (!ra->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -251,6 +251,9 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
case JANET_STRING:
|
||||
janet_table_put(tab, janet_ckeywordv("doc"), attr);
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
janet_table_merge_struct(tab, janet_unwrap_struct(attr));
|
||||
break;
|
||||
}
|
||||
}
|
||||
return tab;
|
||||
|
||||
@@ -108,7 +108,7 @@ static void kmp_init(
|
||||
if (patlen == 0) {
|
||||
janet_panic("expected non-empty pattern");
|
||||
}
|
||||
int32_t *lookup = calloc(patlen, sizeof(int32_t));
|
||||
int32_t *lookup = janet_calloc(patlen, sizeof(int32_t));
|
||||
if (!lookup) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -131,7 +131,7 @@ static void kmp_init(
|
||||
}
|
||||
|
||||
static void kmp_deinit(struct kmp_state *state) {
|
||||
free(state->lookup);
|
||||
janet_free(state->lookup);
|
||||
}
|
||||
|
||||
static void kmp_seti(struct kmp_state *state, int32_t i) {
|
||||
@@ -589,14 +589,14 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/find", cfun_string_find,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
JDOC("(string/find patt str &opt start-index)\n\n"
|
||||
"Searches for the first instance of pattern patt in string "
|
||||
"str. Returns the index of the first character in patt if found, "
|
||||
"otherwise returns nil.")
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find-all patt str)\n\n"
|
||||
JDOC("(string/find-all patt str &opt start-index)\n\n"
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are counted individually, meaning a byte in str "
|
||||
|
||||
@@ -87,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||
int32_t newn = oldn + n;
|
||||
if (mant->cap < newn) {
|
||||
int32_t newcap = 2 * newn;
|
||||
uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -368,11 +368,11 @@ int janet_scan_number(
|
||||
goto error;
|
||||
|
||||
*out = convert(neg, &mant, base, ex);
|
||||
free(mant.digits);
|
||||
janet_free(mant.digits);
|
||||
return 0;
|
||||
|
||||
error:
|
||||
free(mant.digits);
|
||||
janet_free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@@ -45,7 +45,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
||||
/* Initialize the cache (allocate cache memory) */
|
||||
void janet_symcache_init() {
|
||||
janet_vm_cache_capacity = 1024;
|
||||
janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm_cache) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -55,7 +55,7 @@ void janet_symcache_init() {
|
||||
|
||||
/* Deinitialize the cache (free the cache memory) */
|
||||
void janet_symcache_deinit() {
|
||||
free((void *)janet_vm_cache);
|
||||
janet_free((void *)janet_vm_cache);
|
||||
janet_vm_cache = NULL;
|
||||
janet_vm_cache_capacity = 0;
|
||||
janet_vm_cache_count = 0;
|
||||
@@ -122,7 +122,7 @@ notfound:
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm_cache;
|
||||
const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -145,7 +145,7 @@ static void janet_cache_resize(uint32_t newCapacity) {
|
||||
}
|
||||
}
|
||||
/* Free the old cache */
|
||||
free((void *)oldCache);
|
||||
janet_free((void *)oldCache);
|
||||
}
|
||||
|
||||
/* Add an item to the cache */
|
||||
|
||||
@@ -117,7 +117,7 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
if (islocal) {
|
||||
janet_sfree(olddata);
|
||||
} else {
|
||||
free(olddata);
|
||||
janet_free(olddata);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -237,7 +237,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
|
||||
newTable->capacity = table->capacity;
|
||||
newTable->deleted = table->deleted;
|
||||
newTable->proto = table->proto;
|
||||
newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
|
||||
newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV));
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -93,7 +93,7 @@ static JanetTable *janet_thread_get_decode(void) {
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -126,7 +126,7 @@ static void janet_mailbox_destroy(JanetMailbox *mailbox) {
|
||||
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
|
||||
janet_buffer_deinit(mailbox->messages + i);
|
||||
}
|
||||
free(mailbox);
|
||||
janet_free(mailbox);
|
||||
}
|
||||
|
||||
static void janet_mailbox_lock(JanetMailbox *mailbox) {
|
||||
@@ -185,7 +185,7 @@ static int thread_mark(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -199,7 +199,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flag
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
free(pair);
|
||||
janet_free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
|
||||
@@ -1,614 +0,0 @@
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
static char *ta_type_names[] = {
|
||||
"uint8",
|
||||
"int8",
|
||||
"uint16",
|
||||
"int16",
|
||||
"uint32",
|
||||
"int32",
|
||||
"uint64",
|
||||
"int64",
|
||||
"float32",
|
||||
"float64",
|
||||
"?"
|
||||
};
|
||||
|
||||
static size_t ta_type_sizes[] = {
|
||||
sizeof(uint8_t),
|
||||
sizeof(int8_t),
|
||||
sizeof(uint16_t),
|
||||
sizeof(int16_t),
|
||||
sizeof(uint32_t),
|
||||
sizeof(int32_t),
|
||||
sizeof(uint64_t),
|
||||
sizeof(int64_t),
|
||||
sizeof(float),
|
||||
sizeof(double),
|
||||
0
|
||||
};
|
||||
|
||||
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
|
||||
#define TA_ATOM_MAXSIZE 8
|
||||
#define TA_FLAG_BIG_ENDIAN 1
|
||||
|
||||
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
|
||||
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||
if (!janet_cstrcmp(name, ta_type_names[i]))
|
||||
return i;
|
||||
}
|
||||
janet_panicf("invalid typed array type %S", name);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
|
||||
buf->data = NULL;
|
||||
if (size > 0) {
|
||||
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
|
||||
if (buf->data == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
buf->size = size;
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
buf->flags = TA_FLAG_BIG_ENDIAN;
|
||||
#else
|
||||
buf->flags = 0;
|
||||
#endif
|
||||
return buf;
|
||||
}
|
||||
|
||||
static int ta_buffer_gc(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
free(buf->data);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_size(ctx, buf->size);
|
||||
janet_marshal_int(ctx, buf->flags);
|
||||
janet_marshal_bytes(ctx, buf->data, buf->size);
|
||||
}
|
||||
|
||||
static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayBuffer));
|
||||
size_t size = janet_unmarshal_size(ctx);
|
||||
int32_t flags = janet_unmarshal_int(ctx);
|
||||
ta_buffer_init(buf, size);
|
||||
buf->flags = flags;
|
||||
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_buffer_type = {
|
||||
"ta/buffer",
|
||||
ta_buffer_gc,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
janet_mark(janet_wrap_abstract(view->buffer));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
size_t offset = (view->buffer->data - view->as.u8);
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_size(ctx, view->size);
|
||||
janet_marshal_size(ctx, view->stride);
|
||||
janet_marshal_int(ctx, view->type);
|
||||
janet_marshal_size(ctx, offset);
|
||||
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||
}
|
||||
|
||||
static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
|
||||
size_t offset;
|
||||
int32_t atype;
|
||||
Janet buffer;
|
||||
JanetTArrayView *view = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayView));
|
||||
view->size = janet_unmarshal_size(ctx);
|
||||
view->stride = janet_unmarshal_size(ctx);
|
||||
atype = janet_unmarshal_int(ctx);
|
||||
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||
janet_panic("bad typed array type");
|
||||
view->type = atype;
|
||||
offset = janet_unmarshal_size(ctx);
|
||||
buffer = janet_unmarshal_janet(ctx);
|
||||
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
|
||||
janet_panicf("expected typed array buffer");
|
||||
}
|
||||
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||
size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
|
||||
if (view->buffer->size < buf_need_size)
|
||||
janet_panic("bad typed array offset in marshalled data");
|
||||
view->as.u8 = view->buffer->data + offset;
|
||||
return view;
|
||||
}
|
||||
|
||||
static JanetMethod tarray_view_methods[6];
|
||||
|
||||
static int ta_getter(void *p, Janet key, Janet *out) {
|
||||
size_t index, i;
|
||||
JanetTArrayView *array = p;
|
||||
if (janet_checktype(key, JANET_KEYWORD)) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods, out);
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
return 0;
|
||||
} else {
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
*out = janet_wrap_number(array->as.u8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
*out = janet_wrap_number(array->as.s8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
*out = janet_wrap_number(array->as.u16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
*out = janet_wrap_number(array->as.s16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
*out = janet_wrap_number(array->as.u32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
*out = janet_wrap_number(array->as.s32[i]);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
*out = janet_wrap_u64(array->as.u64[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
*out = janet_wrap_s64(array->as.s64[i]);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
*out = janet_wrap_number_safe(array->as.f32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
*out = janet_wrap_number_safe(array->as.f64[i]);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot get from typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void ta_setter(void *p, Janet key, Janet value) {
|
||||
size_t index, i;
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
JanetTArrayView *array = p;
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
janet_panic("index out of bounds");
|
||||
}
|
||||
if (!janet_checktype(value, JANET_NUMBER) &&
|
||||
array->type != JANET_TARRAY_TYPE_U64 &&
|
||||
array->type != JANET_TARRAY_TYPE_S64) {
|
||||
janet_panic("expected number value");
|
||||
}
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
array->as.u64[i] = janet_unwrap_u64(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
array->as.s64[i] = janet_unwrap_s64(value);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
array->as.f32[i] = (float) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
array->as.f64[i] = janet_unwrap_number(value);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot set typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static Janet ta_view_next(void *p, Janet key) {
|
||||
JanetTArrayView *view = p;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
if (view->size > 0) {
|
||||
return janet_wrap_number(0);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
size_t index = (size_t) janet_unwrap_number(key);
|
||||
index++;
|
||||
if (index < view->size) {
|
||||
return janet_wrap_number((double) index);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
ta_getter,
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ta_view_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buf, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_tarray_view(
|
||||
JanetTArrayType type,
|
||||
size_t size,
|
||||
size_t stride,
|
||||
size_t offset,
|
||||
JanetTArrayBuffer *buffer) {
|
||||
|
||||
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
|
||||
|
||||
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, buf_size);
|
||||
}
|
||||
|
||||
if (buffer->size < buf_size) {
|
||||
janet_panicf("bad buffer size, %i bytes allocated < %i required",
|
||||
buffer->size,
|
||||
buf_size);
|
||||
}
|
||||
|
||||
view->buffer = buffer;
|
||||
view->stride = stride;
|
||||
view->size = size;
|
||||
view->as.u8 = buffer->data + offset;
|
||||
view->type = type;
|
||||
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_ta_buffer_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
if (view->type != type) {
|
||||
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||
n, ta_type_names[type], argv[n]);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 5);
|
||||
size_t offset = 0;
|
||||
size_t stride = 1;
|
||||
JanetTArrayBuffer *buffer = NULL;
|
||||
const uint8_t *keyw = janet_getkeyword(argv, 0);
|
||||
JanetTArrayType type = get_ta_type_by_name(keyw);
|
||||
size_t size = janet_getsize(argv, 1);
|
||||
if (argc > 2)
|
||||
stride = janet_getsize(argv, 2);
|
||||
if (argc > 3)
|
||||
offset = janet_getsize(argv, 3);
|
||||
if (argc > 4) {
|
||||
int32_t blen;
|
||||
const uint8_t *bytes;
|
||||
if (janet_bytes_view(argv[4], &bytes, &blen)) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, (size_t) blen);
|
||||
memcpy(buffer->data, bytes, blen);
|
||||
} else {
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &janet_ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
return janet_wrap_abstract(view);
|
||||
}
|
||||
|
||||
static JanetTArrayView *ta_is_view(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
|
||||
return (JanetTArrayView *)abst;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_abstract(view->buffer);
|
||||
}
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
|
||||
return janet_wrap_abstract(buf);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_number((double) view->size);
|
||||
}
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
|
||||
return janet_wrap_number((double) buf->size);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
|
||||
JanetKV *props = janet_struct_begin(6);
|
||||
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
|
||||
janet_struct_put(props, janet_ckeywordv("size"),
|
||||
janet_wrap_number((double) view->size));
|
||||
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||
janet_wrap_number((double) boffset));
|
||||
janet_struct_put(props, janet_ckeywordv("stride"),
|
||||
janet_wrap_number((double) view->stride));
|
||||
janet_struct_put(props, janet_ckeywordv("type"),
|
||||
janet_ckeywordv(ta_type_names[view->type]));
|
||||
janet_struct_put(props, janet_ckeywordv("type-size"),
|
||||
janet_wrap_number((double) ta_type_sizes[view->type]));
|
||||
janet_struct_put(props, janet_ckeywordv("buffer"),
|
||||
janet_wrap_abstract(view->buffer));
|
||||
return janet_wrap_struct(janet_struct_end(props));
|
||||
} else {
|
||||
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
|
||||
JanetKV *props = janet_struct_begin(2);
|
||||
janet_struct_put(props, janet_ckeywordv("size"),
|
||||
janet_wrap_number((double) buffer->size));
|
||||
janet_struct_put(props, janet_ckeywordv("big-endian"),
|
||||
janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
|
||||
return janet_wrap_struct(janet_struct_end(props));
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
JanetRange range;
|
||||
int32_t length = (int32_t)src->size;
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = length;
|
||||
} else {
|
||||
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
}
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
if (array->data) {
|
||||
for (int32_t i = range.start; i < range.end; i++) {
|
||||
if (!ta_getter(src, janet_wrap_number(i), &array->data[i - range.start]))
|
||||
array->data[i - range.start] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
array->count = range.end - range.start;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
memmove(pd, ps, src_atom_size);
|
||||
pd += step_dst;
|
||||
ps += step_src;
|
||||
}
|
||||
} else {
|
||||
janet_panic("typed array copy out of bounds");
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
memcpy(temp, ps, src_atom_size);
|
||||
memcpy(ps, pd, src_atom_size);
|
||||
memcpy(pd, temp, src_atom_size);
|
||||
pd += step_dst;
|
||||
ps += step_src;
|
||||
}
|
||||
} else {
|
||||
janet_panic("typed array swap out of bounds");
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetReg ta_cfuns[] = {
|
||||
{
|
||||
"tarray/new", cfun_typed_array_new,
|
||||
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
|
||||
"Create new typed array.")
|
||||
},
|
||||
{
|
||||
"tarray/buffer", cfun_typed_array_buffer,
|
||||
JDOC("(tarray/buffer array|size)\n\n"
|
||||
"Return typed array buffer or create a new buffer.")
|
||||
},
|
||||
{
|
||||
"tarray/length", cfun_typed_array_size,
|
||||
JDOC("(tarray/length array|buffer)\n\n"
|
||||
"Return typed array or buffer size.")
|
||||
},
|
||||
{
|
||||
"tarray/properties", cfun_typed_array_properties,
|
||||
JDOC("(tarray/properties array)\n\n"
|
||||
"Return typed array properties as a struct.")
|
||||
},
|
||||
{
|
||||
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Copy count elements (default 1) of src array from index sindex "
|
||||
"to dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Swap count elements (default 1) between src array from index sindex "
|
||||
"and dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/slice", cfun_typed_array_slice,
|
||||
JDOC("(tarray/slice tarr &opt start end)\n\n"
|
||||
"Takes a slice of a typed array from start to end. The range is half "
|
||||
"open, [start, end). Indexes can also be negative, indicating indexing "
|
||||
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||
"the size of the typed array. Returns a new janet array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod tarray_view_methods[] = {
|
||||
{"length", cfun_typed_array_size},
|
||||
{"properties", cfun_typed_array_properties},
|
||||
{"copy-bytes", cfun_typed_array_copy_bytes},
|
||||
{"swap-bytes", cfun_typed_array_swap_bytes},
|
||||
{"slice", cfun_typed_array_slice},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
janet_register_abstract_type(&janet_ta_buffer_type);
|
||||
janet_register_abstract_type(&janet_ta_view_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -397,7 +397,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
if (NULL != regprefix) {
|
||||
prefixlen = strlen(regprefix);
|
||||
bufsize = prefixlen + 256;
|
||||
longname_buffer = malloc(bufsize);
|
||||
longname_buffer = janet_malloc(bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -413,7 +413,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
int32_t totallen = (int32_t) prefixlen + nmlen;
|
||||
if ((size_t) totallen > bufsize) {
|
||||
bufsize = (size_t)(totallen) + 128;
|
||||
longname_buffer = realloc(longname_buffer, bufsize);
|
||||
longname_buffer = janet_realloc(longname_buffer, bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -436,7 +436,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
janet_free(longname_buffer);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
@@ -487,27 +487,60 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Resolve a symbol in the environment */
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
|
||||
Janet ref;
|
||||
JanetTable *entry_table;
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
JanetBinding binding = {
|
||||
JANET_BINDING_NONE,
|
||||
janet_wrap_nil(),
|
||||
JANET_BINDING_DEP_NONE
|
||||
};
|
||||
|
||||
/* Check environment for entry */
|
||||
if (!janet_checktype(entry, JANET_TABLE))
|
||||
return JANET_BINDING_NONE;
|
||||
return binding;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
|
||||
/* deprecation check */
|
||||
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
|
||||
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
||||
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
||||
if (!janet_cstrcmp(depkw, "relaxed")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_RELAXED;
|
||||
} else if (!janet_cstrcmp(depkw, "normal")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
} else if (!janet_cstrcmp(depkw, "strict")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_STRICT;
|
||||
}
|
||||
} else if (!janet_checktype(deprecate, JANET_NIL)) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
}
|
||||
|
||||
if (!janet_checktype(
|
||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||
JANET_NIL)) {
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_MACRO;
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_MACRO;
|
||||
return binding;
|
||||
}
|
||||
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
binding.value = ref;
|
||||
binding.type = JANET_BINDING_VAR;
|
||||
return binding;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_DEF;
|
||||
return binding;
|
||||
}
|
||||
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding binding = janet_resolve_ext(env, sym);
|
||||
*out = binding.value;
|
||||
return binding.type;
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the core environment. */
|
||||
@@ -720,3 +753,21 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/* Alloc function macro fills */
|
||||
void *(janet_malloc)(size_t size) {
|
||||
return janet_malloc(size);
|
||||
}
|
||||
|
||||
void (janet_free)(void *ptr) {
|
||||
return janet_free(ptr);
|
||||
}
|
||||
|
||||
void *(janet_calloc)(size_t nmemb, size_t size) {
|
||||
return janet_calloc(nmemb, size);
|
||||
}
|
||||
|
||||
void *(janet_realloc)(void *ptr, size_t size) {
|
||||
return janet_realloc(ptr, size);
|
||||
}
|
||||
|
||||
@@ -52,12 +52,6 @@
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
|
||||
@@ -47,7 +47,7 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
if (tn == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -43,7 +43,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
int32_t *p;
|
||||
if (NULL == v) return NULL;
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = malloc(size);
|
||||
p = janet_malloc(size);
|
||||
if (NULL != p) {
|
||||
safe_memcpy(p, v, size);
|
||||
return p;
|
||||
|
||||
@@ -275,11 +275,16 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
|
||||
}
|
||||
|
||||
/* Method lookup could potentially handle tables specially... */
|
||||
static Janet method_to_fun(Janet method, Janet obj) {
|
||||
return janet_get(obj, method);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
Janet callee = janet_get(fiber->data[fiber->stackstart], name);
|
||||
Janet callee = method_to_fun(name, fiber->data[fiber->stackstart]);
|
||||
if (janet_checktype(callee, JANET_NIL))
|
||||
janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
|
||||
return callee;
|
||||
@@ -287,8 +292,7 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
return janet_get(x, kname);
|
||||
return method_to_fun(janet_ckeywordv(name), x);
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
@@ -1542,7 +1546,7 @@ int janet_init(void) {
|
||||
void janet_deinit(void) {
|
||||
janet_clear_memory();
|
||||
janet_symcache_deinit();
|
||||
free(janet_vm_roots);
|
||||
janet_free(janet_vm_roots);
|
||||
janet_vm_roots = NULL;
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
@@ -1550,7 +1554,7 @@ void janet_deinit(void) {
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm_top_dyns = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
@@ -162,7 +162,7 @@ Janet(janet_wrap_number)(double x) {
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc((size_t) count * sizeof(JanetKV));
|
||||
void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
@@ -288,15 +288,21 @@ typedef struct {
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
// Must be defined before including stdlib.h
|
||||
/* Must be defined before including stdlib.h */
|
||||
#define _CRT_RAND_S
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
@@ -1404,6 +1410,11 @@ struct JanetCompileResult {
|
||||
enum JanetCompileStatus status;
|
||||
};
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
|
||||
JANET_API JanetCompileResult janet_compile_lint(
|
||||
Janet source,
|
||||
JanetTable *env,
|
||||
JanetString where,
|
||||
JanetArray *lints);
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
@@ -1659,11 +1670,24 @@ typedef enum {
|
||||
JANET_BINDING_VAR,
|
||||
JANET_BINDING_MACRO
|
||||
} JanetBindingType;
|
||||
|
||||
typedef struct {
|
||||
JanetBindingType type;
|
||||
Janet value;
|
||||
enum {
|
||||
JANET_BINDING_DEP_NONE,
|
||||
JANET_BINDING_DEP_RELAXED,
|
||||
JANET_BINDING_DEP_NORMAL,
|
||||
JANET_BINDING_DEP_STRICT,
|
||||
} deprecation;
|
||||
} JanetBinding;
|
||||
|
||||
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 JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* Get values from the core environment. */
|
||||
@@ -1856,59 +1880,6 @@ typedef struct {
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_ta_view_type;
|
||||
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_TARRAY_TYPE_U8,
|
||||
JANET_TARRAY_TYPE_S8,
|
||||
JANET_TARRAY_TYPE_U16,
|
||||
JANET_TARRAY_TYPE_S16,
|
||||
JANET_TARRAY_TYPE_U32,
|
||||
JANET_TARRAY_TYPE_S32,
|
||||
JANET_TARRAY_TYPE_U64,
|
||||
JANET_TARRAY_TYPE_S64,
|
||||
JANET_TARRAY_TYPE_F32,
|
||||
JANET_TARRAY_TYPE_F64
|
||||
} JanetTArrayType;
|
||||
|
||||
typedef struct {
|
||||
uint8_t *data;
|
||||
size_t size;
|
||||
int32_t flags;
|
||||
} JanetTArrayBuffer;
|
||||
|
||||
typedef struct {
|
||||
union {
|
||||
void *pointer;
|
||||
uint8_t *u8;
|
||||
int8_t *s8;
|
||||
uint16_t *u16;
|
||||
int16_t *s16;
|
||||
uint32_t *u32;
|
||||
int32_t *s32;
|
||||
uint64_t *u64;
|
||||
int64_t *s64;
|
||||
float *f32;
|
||||
double *f64;
|
||||
} as;
|
||||
JanetTArrayBuffer *buffer;
|
||||
size_t size;
|
||||
size_t stride;
|
||||
JanetTArrayType type;
|
||||
} JanetTArrayView;
|
||||
|
||||
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
|
||||
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
|
||||
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
|
||||
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_s64_type;
|
||||
@@ -1940,6 +1911,24 @@ JANET_API JanetThread *janet_thread_current(void);
|
||||
|
||||
#endif
|
||||
|
||||
/* Custom allocator support */
|
||||
JANET_API void *(janet_malloc)(size_t);
|
||||
JANET_API void *(janet_realloc)(void *, size_t);
|
||||
JANET_API void *(janet_calloc)(size_t, size_t);
|
||||
JANET_API void (janet_free)(void *);
|
||||
#ifndef janet_malloc
|
||||
#define janet_malloc(X) malloc((X))
|
||||
#endif
|
||||
#ifndef janet_realloc
|
||||
#define janet_realloc(X, Y) realloc((X), (Y))
|
||||
#endif
|
||||
#ifndef janet_calloc
|
||||
#define janet_calloc(X, Y) calloc((X), (Y))
|
||||
#endif
|
||||
#ifndef janet_free
|
||||
#define janet_free(X) free((X))
|
||||
#endif
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/* Re-enable popped variable length array warnings */
|
||||
|
||||
@@ -152,7 +152,7 @@ static const char *badterms[] = {
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = malloc(len);
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
@@ -300,7 +300,7 @@ static int insert(char c, int draw) {
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (gbl_history_count > 1) {
|
||||
free(gbl_history[gbl_historyi]);
|
||||
janet_free(gbl_history[gbl_historyi]);
|
||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
||||
|
||||
gbl_historyi += delta;
|
||||
@@ -326,7 +326,7 @@ static void addhistory(void) {
|
||||
gbl_history[gbl_history_count++] = newline;
|
||||
len++;
|
||||
} else {
|
||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
janet_free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
}
|
||||
for (i = len - 1; i > 0; i--) {
|
||||
gbl_history[i] = gbl_history[i - 1];
|
||||
@@ -338,7 +338,7 @@ static void replacehistory(void) {
|
||||
/* History count is always > 0 here */
|
||||
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
|
||||
/* Delete history */
|
||||
free(gbl_history[0]);
|
||||
janet_free(gbl_history[0]);
|
||||
for (int i = 1; i < gbl_history_count; i++) {
|
||||
gbl_history[i - 1] = gbl_history[i];
|
||||
}
|
||||
@@ -346,7 +346,7 @@ static void replacehistory(void) {
|
||||
} else {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
janet_free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
}
|
||||
@@ -934,7 +934,7 @@ void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
free(gbl_history[i]);
|
||||
janet_free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
|
||||
@@ -2,20 +2,24 @@
|
||||
:name "testmod")
|
||||
|
||||
(declare-native
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
|
||||
(declare-native
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod5"
|
||||
:source @["testmod5.cc"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
|
||||
@@ -2,7 +2,8 @@
|
||||
(use /build/testmod2)
|
||||
(use /build/testmod3)
|
||||
(use /build/test-mod-4)
|
||||
(use /build/testmod5)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (+ (get5) (get6) (get7) (get8))))
|
||||
(print (+ (get5) (get6) (get7) (get8) (get9))))
|
||||
|
||||
42
test/install/testmod5.cc
Normal file
42
test/install/testmod5.cc
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_nine(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
std::cout << "Hello!" << std::endl;
|
||||
return janet_wrap_number(9.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get9", cfun_get_nine, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -70,5 +70,17 @@
|
||||
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||
|
||||
# Metadata
|
||||
|
||||
(def foo-with-tags :a-tag :bar)
|
||||
(assert (get (dyn 'foo-with-tags) :a-tag) "extra keywords in def are metadata tags")
|
||||
|
||||
(def foo-with-meta {:baz :quux} :bar)
|
||||
(assert (= :quux (get (dyn 'foo-with-meta) :baz)) "extra struct in def is metadata")
|
||||
|
||||
(defn foo-fn-with-meta {:baz :quux} "This is a function" [x] (identity x))
|
||||
(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz)) "extra struct in defn is metadata")
|
||||
(assert (= "(foo-fn-with-meta x)\n\nThis is a function" (get (dyn 'foo-fn-with-meta) :doc)) "extra string in defn is docstring")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -21,54 +21,6 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 5)
|
||||
|
||||
# some tests typed array
|
||||
|
||||
(defn inspect-tarray
|
||||
[x]
|
||||
(def a @[])
|
||||
(for i 0 (tarray/length x) (array/push a (x i)))
|
||||
(pp a))
|
||||
|
||||
(assert-no-error
|
||||
"create some typed arrays"
|
||||
(do
|
||||
(def a (tarray/new :float64 10))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
(def c (tarray/new :uint32 20))))
|
||||
|
||||
(assert-no-error
|
||||
"create some typed arrays from a buffer"
|
||||
(do
|
||||
(def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8))))
|
||||
(def b (tarray/new :float64 10 2 64 buf))))
|
||||
|
||||
(def a (tarray/new :float64 10))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
|
||||
(assert-no-error
|
||||
"fill tarray"
|
||||
(for i 0 (tarray/length a)
|
||||
(set (a i) i)))
|
||||
|
||||
(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer")
|
||||
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
||||
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= (:length a) (length a)) "length method and function")
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
# Issue 408
|
||||
(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
|
||||
(def ta (tarray/new :int32 10))
|
||||
(assert (= (next a nil) 0) "tarray next 1")
|
||||
(assert (= (next a 0) 1) "tarray next 2")
|
||||
(assert (= (next a 8) 9) "tarray next 3")
|
||||
(assert (nil? (next a 9)) "tarray next 4")
|
||||
(put ta 3 7)
|
||||
(put ta 9 7)
|
||||
(assert (= 2 (count |(= $ 7) ta)) "tarray count")
|
||||
|
||||
# Array remove
|
||||
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
|
||||
@@ -72,22 +72,6 @@
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
(set (t 0) 1000)
|
||||
(set (t 1) b)
|
||||
(set (t 2) "1000")
|
||||
(set (t 3) (t 0))
|
||||
(set (t 4) (u64 1000))
|
||||
(and
|
||||
(= (t 0) (t 1))
|
||||
(= (t 1) (t 2))
|
||||
(= (t 2) (t 3))
|
||||
(= (t 3) (t 4))
|
||||
))
|
||||
"int64 typed arrays")
|
||||
|
||||
# Dynamic bindings
|
||||
(setdyn :a 10)
|
||||
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
|
||||
|
||||
@@ -112,19 +112,6 @@
|
||||
(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
|
||||
(check-table-clone @{} "table/clone 1")
|
||||
|
||||
# Issue #142
|
||||
|
||||
(def buffer (tarray/buffer 8))
|
||||
(def buffer-float64-view (tarray/new :float64 1 1 0 buffer))
|
||||
(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer))
|
||||
|
||||
(set (buffer-uint32-view 1) 0xfffe9234)
|
||||
(set (buffer-uint32-view 0) 0x56789abc)
|
||||
|
||||
(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1")
|
||||
(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2")
|
||||
(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3")
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings.
|
||||
|
||||
(assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc ""))) "no \\r in doc strings")
|
||||
|
||||
Reference in New Issue
Block a user