1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 14:17:42 +00:00

Compare commits

..

53 Commits

Author SHA1 Message Date
Calvin Rose
d204e06e11 Use lint information in run-context. 2021-05-30 10:33:46 -05:00
Calvin Rose
f6b37dbc77 Merge branch 'master' into linting 2021-05-30 09:34:32 -05:00
Calvin Rose
ff4d49f556 Set JANET_DIST_DIR on release. 2021-05-30 09:23:52 -05:00
Calvin Rose
dfa5fa1187 Remove some stupid shell gymnastics in Makefile. 2021-05-30 09:14:34 -05:00
Calvin Rose
1f4f69a5b6 Fix windows syntax issue. 2021-05-29 20:40:26 -05:00
Calvin Rose
84f82f5465 Remove code delimtiers from defn and defmacro. 2021-05-29 20:37:30 -05:00
Calvin Rose
c911f7c47e Address #694 - Update doc-format with more features.
Also allows having doc-format print in color with
(dyn :doc-color).
2021-05-29 20:34:22 -05:00
Calvin Rose
33c000daea Expose linting array to macros.
This has a lot of possible uses, and would let users add a macro-based
type system on top of Janet that would integrate with the usual linting
and warning system.
2021-05-28 15:15:34 -05:00
Calvin Rose
7ff204ec44 Work on system for adding compiler warnings.
This is the beginning of a system for compiler warnings. This includes
linting, deprecation notices, and other compiler warnings that are best
detected by the `compile` function and don't require the partial
evalutaion of the flychecker.
2021-05-28 15:12:05 -05:00
Calvin Rose
7c757ef3bf Make jpm configurable for environments like MinGW. 2021-05-26 10:07:11 -05:00
Calvin Rose
2db7945d6f Fix peg bug when there is no default grammar set.
This could result in a segfault when we attempt to
read from a NULL pointer.
2021-05-20 21:57:22 -05:00
Calvin Rose
81186bf262 Merge branch 'master' of github.com:janet-lang/janet 2021-05-19 18:43:50 -05:00
Calvin Rose
eeef5b0896 Add as-macro and module/add-syspath 2021-05-19 18:18:00 -05:00
Calvin Rose
8189b6fc11 Merge pull request #690 from sogaiu/specials-doc
Make doc work for special forms
2021-05-09 13:54:46 -05:00
sogaiu
e5a2df93ab Make doc work for special forms 2021-05-07 08:47:33 +09:00
Calvin Rose
c3f770da27 Fix meson build. 2021-04-29 15:59:44 -05:00
Calvin Rose
49f66a936c Merge commit 'f4c9064b79d5b32fd74e5ddf25266356c22dd53b' 2021-04-29 15:58:41 -05:00
Calvin Rose
83dda98240 Update jpm to work post patch. 2021-04-29 14:28:54 -05:00
Calvin Rose
b4ddbd0097 Address #670 - Allow modifying jpm to link to extra libraries. 2021-04-29 14:04:18 -05:00
Calvin Rose
cbe92bb985 Merge branch 'master' of github.com:janet-lang/janet 2021-04-29 13:13:55 -05:00
Calvin Rose
60c6a0d334 Add :native-deps option to jpm.
Use is like:

```
(declare-native
 :name "my-nuermical-library"
 :source @["numerical_lib.c"]
 :native-deps ["tarray"])

```

Where `tarray` is a native generated by o ne of the project
dependencies. This will lets us move more C functionality out of the
core of Janet while still allowing it's use from natives.
2021-04-29 13:11:46 -05:00
Calvin Rose
1baab5eb61 Remove typed arrays from the core.
Typed arrays will instead live in an external jpm nodule.
Also, changes have been made to `jpm` to allow other natives to use the
typedarray headers.
2021-04-29 12:33:49 -05:00
Calvin Rose
8fc8974b60 Add from-pairs to core. #683
This always creates a table, use `table/to-struct` to
create a struct.
2021-04-29 12:06:24 -05:00
Calvin Rose
ecb49c2e5e Merge pull request #688 from cjones051073/use-nsgetenviron-on-apple
Use _NSGetEnviron() on Apple
2021-04-29 12:00:35 -05:00
Chris Jones
29797b9eb0 Use _NSGetEnviron() on Apple 2021-04-27 11:54:24 +01:00
Calvin Rose
e181ee586b Prepare for 1.15.5 release. 2021-04-25 14:00:16 -05:00
Calvin Rose
7b7d742bec Add declare-headers to jpm. 2021-04-25 13:38:24 -05:00
Calvin Rose
612eaff9ff Fix #682 - Don't hardcode size of sun_path. 2021-04-15 14:57:40 -05:00
Calvin Rose
d76ef187e8 Merge pull request #681 from pyrmont/patch-2
Fix link to Introduction
2021-04-09 20:04:42 -05:00
Michael Camilleri
e01ab86a89 Fix link to Introduction 2021-04-08 16:10:24 +09:00
Calvin Rose
89b59b4ffc Merge branch 'master' of github.com:janet-lang/janet 2021-04-06 23:36:11 -05:00
Calvin Rose
e367ecf806 Update cannonical link. 2021-04-06 23:35:57 -05:00
Calvin Rose
effc9e0f33 Merge pull request #677 from uvtc/patch-1
Add note about sponsorship to README
2021-04-02 15:00:21 -05:00
John Gabriele
da06e6c6e3 Update README.md
Co-authored-by: Michael Camilleri <mike@inqk.net>
2021-03-31 21:40:30 -04:00
John Gabriele
c258bee54f Add note about sponsorship to README 2021-03-31 21:27:03 -04:00
Calvin Rose
cde4a505cf Fix #673 - check typed array index bounds as well as buffer count. 2021-03-30 21:14:42 -05:00
Calvin Rose
2802e66259 Merge branch 'master' of github.com:janet-lang/janet 2021-03-26 15:45:14 -05:00
Calvin Rose
3a3003029a Merge branch 'master' of github.com:janet-lang/janet 2021-03-26 15:44:43 -05:00
Calvin Rose
08bca8fb63 Merge branch 'master' of github.com:janet-lang/janet 2021-03-26 15:36:50 -05:00
Calvin Rose
7c7ff802fa Add net/shutdown to allow better networking with streams. 2021-03-26 15:36:25 -05:00
Calvin Rose
0945acc780 Merge pull request #672 from Luewd/cc-file-ext
Allow .cc file extension in jpm declare-native
2021-03-26 15:13:12 -05:00
Lue
64ec9f9cb6 Allow .cc file extension in jpm declare-native 2021-03-25 13:19:05 -04:00
Calvin Rose
83f7de33c0 Merge pull request #671 from pyrmont/feature.metadata
Support adding arbitrary metadata to bindings
2021-03-24 16:56:25 -05:00
Michael Camilleri
ec2d7bf349 Support adding arbitrary metadata to bindings 2021-03-24 09:38:12 +09:00
Andrew Chambers
f4c9064b79 Add config support for custom allocators. 2021-03-23 23:00:48 +13:00
Calvin Rose
8ede16dc26 Merge pull request #669 from dbready/dist_layout
Create Folder Hierarchy for Linux Release
2021-03-22 11:51:21 -05:00
Damien Ready
27e400fba3 Prepare the .tar distribution with folder layout 2021-03-20 10:53:51 -05:00
Calvin Rose
37d6cb469b Merge pull request #668 from ffontaine/master
meson.build: fix build without threads
2021-03-19 15:44:25 -05:00
Calvin Rose
100a82feb2 Version bump (development version). 2021-03-19 15:41:34 -05:00
Calvin Rose
90e5828d5d Update printing when entering debugger. 2021-03-19 15:38:46 -05:00
Calvin Rose
b3e80308d4 Change inheritance rule. 2021-03-19 15:18:19 -05:00
Fabrice Fontaine
a7abe11105 meson.build: fix build without threads
Fix the following build failure with -Dsingle_threaded=true on embedded
toolchains without pthread:

FAILED: janet.p/meson-generated_.._janet.c.o
/home/buildroot/autobuild/run/instance-3/output-1/host/bin/arm-linux-gcc -Ijanet.p -I. -I.. -I../src/include -fdiagnostics-color=always -pipe -Wall -Winvalid-pch -std=c99 -O3 -D_LARGEFILE_SOURCE -D_LARGEFILE64_SOURCE -D_FILE_OFFSET_BITS=64 -Os -pthread -fvisibility=hidden -MD -MQ janet.p/meson-generated_.._janet.c.o -MF janet.p/meson-generated_.._janet.c.o.d -o janet.p/meson-generated_.._janet.c.o -c janet.c
In file included from /home/buildroot/autobuild/run/instance-3/output-1/host/arm-buildroot-linux-uclibcgnueabihf/sysroot/usr/include/stdlib.h:24,
                 from ../src/include/janet.h:300,
                 from src/core/features.h:57:
/home/buildroot/autobuild/run/instance-3/output-1/host/arm-buildroot-linux-uclibcgnueabihf/sysroot/usr/include/features.h:218:5: warning: #warning requested reentrant code, but thread support was disabled [-Wcpp]
  218 | #   warning requested reentrant code, but thread support was disabled
      |     ^~~~~~~
src/core/ev.c:39:10: fatal error: pthread.h: No such file or directory

Signed-off-by: Fabrice Fontaine <fontaine.fabrice@gmail.com>
2021-03-18 09:13:22 +01:00
Calvin Rose
3c63a48df4 (#667) Add constant inlining for tuples and structs.
Structs and tuples composed entirely out of constant values
will themselves be considered constant values during compilation.
This reduces the amount of generated code.
2021-03-16 20:52:55 -05:00
53 changed files with 1065 additions and 1356 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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 #####

View File

@@ -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

View File

@@ -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) {

View File

@@ -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
View File

@@ -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
View File

@@ -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>

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.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

View File

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

View File

@@ -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();

View File

@@ -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"

View File

@@ -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 */

View File

@@ -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];

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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}
};

View File

@@ -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);

View File

@@ -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

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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;
}

View File

@@ -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();
}

View File

@@ -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;
}

View File

@@ -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}
};

View File

@@ -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
}

View File

@@ -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;
}

View File

@@ -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");
}

View File

@@ -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) {

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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 "

View File

@@ -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;
}

View File

@@ -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 */

View File

@@ -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;
}

View File

@@ -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 */

View File

@@ -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

View File

@@ -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);
}

View File

@@ -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

View File

@@ -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;
}

View File

@@ -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;

View File

@@ -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

View File

@@ -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;

View File

@@ -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 */

View File

@@ -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;
}

View File

@@ -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"

View File

@@ -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
View File

@@ -0,0 +1,42 @@
/*
* Copyright (c) 2020 Calvin Rose and contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/* A very simple native module */
#include <janet.h>
#include <iostream>
static Janet cfun_get_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);
}

View File

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

View File

@@ -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")

View File

@@ -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")

View File

@@ -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")