mirror of
https://github.com/janet-lang/janet
synced 2025-02-04 19:29:10 +00:00
Merge branch 'master' into ev
This commit is contained in:
commit
a0abf307b4
1
.gitattributes
vendored
Normal file
1
.gitattributes
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
*.janet linguist-language=Clojure
|
10
CHANGELOG.md
10
CHANGELOG.md
@ -2,6 +2,16 @@
|
|||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## Unreleased - ???
|
## Unreleased - ???
|
||||||
|
- The gc interval is now autotuned, to prevent very bad gc behavior.
|
||||||
|
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
|
||||||
|
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
|
||||||
|
- Add `math/nan`
|
||||||
|
- Add `forv` macro
|
||||||
|
- Add `symbol/slice`
|
||||||
|
- Add `keyword/slice`
|
||||||
|
- Allow cross compilation with Makefile.
|
||||||
|
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||||
|
- Add `reverse!` for reversing an array or buffer in place.
|
||||||
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
||||||
- Add `repeat` macro for iterating something n times.
|
- Add `repeat` macro for iterating something n times.
|
||||||
- Add `eachy` (each yield) macro for iterating a fiber.
|
- Add `eachy` (each yield) macro for iterating a fiber.
|
||||||
|
24
Makefile
24
Makefile
@ -38,8 +38,15 @@ PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
|||||||
DEBUGGER=gdb
|
DEBUGGER=gdb
|
||||||
SONAME_SETTER=-Wl,-soname,
|
SONAME_SETTER=-Wl,-soname,
|
||||||
|
|
||||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
# For cross compilation
|
||||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
HOSTCC?=$(CC)
|
||||||
|
HOSTAR?=$(AR)
|
||||||
|
CFLAGS?=-fPIC -O2
|
||||||
|
LDFLAGS?=-rdynamic
|
||||||
|
|
||||||
|
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden
|
||||||
|
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||||
|
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||||
|
|
||||||
# For installation
|
# For installation
|
||||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||||
@ -132,7 +139,6 @@ JANET_BOOT_HEADERS=src/boot/tests.h
|
|||||||
##########################################################
|
##########################################################
|
||||||
|
|
||||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
||||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
|
|
||||||
|
|
||||||
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
||||||
|
|
||||||
@ -162,24 +168,26 @@ build/janetconf.h: src/conf/janetconf.h
|
|||||||
cp $< $@
|
cp $< $@
|
||||||
|
|
||||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||||
|
|
||||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||||
|
|
||||||
$(JANET_TARGET): build/janet.o build/shell.o
|
$(JANET_TARGET): build/janet.o build/shell.o
|
||||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||||
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||||
$(AR) rcs $@ $^
|
$(HOSTAR) rcs $@ $^
|
||||||
|
|
||||||
###################
|
###################
|
||||||
##### Testing #####
|
##### Testing #####
|
||||||
###################
|
###################
|
||||||
|
|
||||||
|
# Testing assumes HOSTCC=CC
|
||||||
|
|
||||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||||
|
|
||||||
repl: $(JANET_TARGET)
|
repl: $(JANET_TARGET)
|
||||||
|
45
jpm
45
jpm
@ -757,7 +757,7 @@ int main(int argc, const char **argv) {
|
|||||||
(os/execute [(git-path) "reset" "--hard" tag] :p))
|
(os/execute [(git-path) "reset" "--hard" tag] :p))
|
||||||
(unless (dyn :offline)
|
(unless (dyn :offline)
|
||||||
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
|
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
|
||||||
(import-rules "./project.janet")
|
(import-rules "./project.janet" true)
|
||||||
(unless no-deps (do-rule "install-deps"))
|
(unless no-deps (do-rule "install-deps"))
|
||||||
(do-rule "build")
|
(do-rule "build")
|
||||||
(do-rule "install"))
|
(do-rule "install"))
|
||||||
@ -1069,36 +1069,47 @@ usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
|
|||||||
|
|
||||||
Run from a directory containing a project.janet file to perform operations
|
Run from a directory containing a project.janet file to perform operations
|
||||||
on a project, or from anywhere to do operations on the global module cache (modpath).
|
on a project, or from anywhere to do operations on the global module cache (modpath).
|
||||||
|
Commands that need write permission to the modpath are considered privileged commands - in
|
||||||
|
some environments they may require super user privileges.
|
||||||
|
Other project-level commands need to have a ./project.janet file in the current directory.
|
||||||
|
|
||||||
Subcommands are:
|
Unprivileged global subcommands:
|
||||||
build : build all artifacts
|
|
||||||
help : show this help text
|
help : show this help text
|
||||||
|
show-paths : prints the paths that will be used to install things.
|
||||||
|
quickbin entry executable : Create an executable from a janet script with a main function.
|
||||||
|
|
||||||
|
Privileged global subcommands:
|
||||||
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
|
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
|
||||||
git repository, assuming that the repository is a jpm project. If not, build
|
git repository, assuming that the repository is a jpm project. If not, build
|
||||||
and install the current project.
|
and install the current project.
|
||||||
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
|
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
|
||||||
defined by the current directory.
|
defined by the current directory.
|
||||||
show-paths : prints the paths that will be used to install things.
|
|
||||||
clean : remove any generated files or artifacts
|
|
||||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
|
||||||
deps : install dependencies for the current project.
|
|
||||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
clear-cache : clear the git cache. Useful for updating dependencies.
|
||||||
clear-manifest : clear the manifest. Useful for fixing broken installs.
|
clear-manifest : clear the manifest. Useful for fixing broken installs.
|
||||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
|
||||||
or (rule "ouput.file" [deps...] ...).
|
|
||||||
rules : list rules available with run.
|
|
||||||
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
|
|
||||||
Optinally provide a root rule to start printing from, and a
|
|
||||||
max depth to print. Without these options, all rules will print
|
|
||||||
their full dependency tree.
|
|
||||||
update-pkgs : Update the current package listing from the remote git repository selected.
|
|
||||||
quickbin entry executable : Create an executable from a janet script with a main function.
|
|
||||||
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
|
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
|
||||||
lockfile will record the exact versions of dependencies used to ensure a reproducible
|
lockfile will record the exact versions of dependencies used to ensure a reproducible
|
||||||
build. Lockfiles are best used with applications, not libraries. The default lockfile
|
build. Lockfiles are best used with applications, not libraries. The default lockfile
|
||||||
name is lockfile.jdn.
|
name is lockfile.jdn.
|
||||||
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
|
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
|
||||||
default lockfile name is lockfile.jdn.
|
default lockfile name is lockfile.jdn.
|
||||||
|
update-pkgs : Update the current package listing from the remote git repository selected.
|
||||||
|
|
||||||
|
Privileged project subcommands:
|
||||||
|
deps : install dependencies for the current project.
|
||||||
|
install : install artifacts of the current project.
|
||||||
|
uninstall : uninstall the current project's artifacts.
|
||||||
|
|
||||||
|
Unprivileged project subcommands:
|
||||||
|
build : build all artifacts
|
||||||
|
clean : remove any generated files or artifacts
|
||||||
|
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||||
|
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
||||||
|
or (rule "ouput.file" [deps...] ...).
|
||||||
|
rules : list rules available with run.
|
||||||
|
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
|
||||||
|
Optionally provide a root rule to start printing from, and a
|
||||||
|
max depth to print. Without these options, all rules will print
|
||||||
|
their full dependency tree.
|
||||||
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
|
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
|
||||||
otherwise debug the current project.janet file.
|
otherwise debug the current project.janet file.
|
||||||
|
|
||||||
@ -1171,7 +1182,7 @@ Flags are:
|
|||||||
|
|
||||||
(defn list-rules
|
(defn list-rules
|
||||||
[&opt ctx]
|
[&opt ctx]
|
||||||
(import-rules "./project.janet" true)
|
(import-rules "./project.janet")
|
||||||
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
||||||
(each k ks (print k)))
|
(each k ks (print k)))
|
||||||
|
|
||||||
|
@ -99,7 +99,7 @@
|
|||||||
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
||||||
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
||||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||||
(defn bytes? "Check if x is a string, symbol, or buffer." [x]
|
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
|
||||||
(def t (type x))
|
(def t (type x))
|
||||||
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
|
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
|
||||||
(defn dictionary? "Check if x a table or struct." [x]
|
(defn dictionary? "Check if x a table or struct." [x]
|
||||||
@ -112,7 +112,7 @@
|
|||||||
(defn true? "Check if x is true." [x] (= x true))
|
(defn true? "Check if x is true." [x] (= x true))
|
||||||
(defn false? "Check if x is false." [x] (= x false))
|
(defn false? "Check if x is false." [x] (= x false))
|
||||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||||
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
|
(defn empty? "Check if xs is empty." [xs] (= (length xs) 0))
|
||||||
|
|
||||||
(def idempotent?
|
(def idempotent?
|
||||||
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
||||||
@ -379,16 +379,23 @@
|
|||||||
,(apply defer [(or dtor :close) binding] [truthy])
|
,(apply defer [(or dtor :close) binding] [truthy])
|
||||||
,falsey))
|
,falsey))
|
||||||
|
|
||||||
(defn- for-template
|
(defn- for-var-template
|
||||||
[binding start stop step comparison delta body]
|
[i start stop step comparison delta body]
|
||||||
(with-syms [i s]
|
(with-syms [s]
|
||||||
|
(def st (if (idempotent? step) step (gensym)))
|
||||||
~(do
|
~(do
|
||||||
(var ,i ,start)
|
(var ,i ,start)
|
||||||
(def ,s ,stop)
|
(def ,s ,stop)
|
||||||
|
,;(if (= st step) [] [~(def ,st ,step)])
|
||||||
(while (,comparison ,i ,s)
|
(while (,comparison ,i ,s)
|
||||||
(def ,binding ,i)
|
|
||||||
,;body
|
,;body
|
||||||
(set ,i (,delta ,i ,step))))))
|
(set ,i (,delta ,i ,st))))))
|
||||||
|
|
||||||
|
(defn- for-template
|
||||||
|
[binding start stop step comparison delta body]
|
||||||
|
(def i (gensym))
|
||||||
|
(for-var-template i start stop step comparison delta
|
||||||
|
[~(def ,binding ,i) ;body]))
|
||||||
|
|
||||||
(defn- check-indexed [x]
|
(defn- check-indexed [x]
|
||||||
(if (indexed? x)
|
(if (indexed? x)
|
||||||
@ -401,26 +408,18 @@
|
|||||||
(for-template binding start stop (or step 1) comparison op [rest])))
|
(for-template binding start stop (or step 1) comparison op [rest])))
|
||||||
|
|
||||||
(defn- each-template
|
(defn- each-template
|
||||||
[binding inx body]
|
[binding inx kind body]
|
||||||
(with-syms [k]
|
(with-syms [k]
|
||||||
(def ds (if (idempotent? inx) inx (gensym)))
|
(def ds (if (idempotent? inx) inx (gensym)))
|
||||||
~(do
|
~(do
|
||||||
,(unless (= ds inx) ~(def ,ds ,inx))
|
,(unless (= ds inx) ~(def ,ds ,inx))
|
||||||
(var ,k (,next ,ds nil))
|
(var ,k (,next ,ds nil))
|
||||||
(while (,not= nil ,k)
|
(while (,not= nil ,k)
|
||||||
(def ,binding (,in ,ds ,k))
|
(def ,binding
|
||||||
,;body
|
,(case kind
|
||||||
(set ,k (,next ,ds ,k))))))
|
:each ~(,in ,ds ,k)
|
||||||
|
:keys k
|
||||||
(defn- keys-template
|
:pairs ~(,tuple ,k (,in ,ds ,k))))
|
||||||
[binding in pair? body]
|
|
||||||
(with-syms [k]
|
|
||||||
(def ds (if (idempotent? in) in (gensym)))
|
|
||||||
~(do
|
|
||||||
,(unless (= ds in) ~(def ,ds ,in))
|
|
||||||
(var ,k (,next ,ds nil))
|
|
||||||
(while (,not= nil ,k)
|
|
||||||
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
|
|
||||||
,;body
|
,;body
|
||||||
(set ,k (,next ,ds ,k))))))
|
(set ,k (,next ,ds ,k))))))
|
||||||
|
|
||||||
@ -477,13 +476,19 @@
|
|||||||
:range-to (range-template binding object rest + <=)
|
:range-to (range-template binding object rest + <=)
|
||||||
:down (range-template binding object rest - >)
|
:down (range-template binding object rest - >)
|
||||||
:down-to (range-template binding object rest - >=)
|
:down-to (range-template binding object rest - >=)
|
||||||
:keys (keys-template binding object false [rest])
|
:keys (each-template binding object :keys [rest])
|
||||||
:pairs (keys-template binding object true [rest])
|
:pairs (each-template binding object :pairs [rest])
|
||||||
:in (each-template binding object [rest])
|
:in (each-template binding object :each [rest])
|
||||||
:iterate (iterate-template binding object rest)
|
:iterate (iterate-template binding object rest)
|
||||||
:generate (loop-fiber-template binding object [rest])
|
:generate (loop-fiber-template binding object [rest])
|
||||||
(error (string "unexpected loop verb " verb)))))
|
(error (string "unexpected loop verb " verb)))))
|
||||||
|
|
||||||
|
(defmacro forv
|
||||||
|
"Do a c style for loop for side effects. The iteration variable i
|
||||||
|
can be mutated in the loop, unlike normal for. Returns nil."
|
||||||
|
[i start stop & body]
|
||||||
|
(for-var-template i start stop 1 < + body))
|
||||||
|
|
||||||
(defmacro for
|
(defmacro for
|
||||||
"Do a c style for loop for side effects. Returns nil."
|
"Do a c style for loop for side effects. Returns nil."
|
||||||
[i start stop & body]
|
[i start stop & body]
|
||||||
@ -492,12 +497,12 @@
|
|||||||
(defmacro eachk
|
(defmacro eachk
|
||||||
"Loop over each key in ds. Returns nil."
|
"Loop over each key in ds. Returns nil."
|
||||||
[x ds & body]
|
[x ds & body]
|
||||||
(keys-template x ds false body))
|
(each-template x ds :each body))
|
||||||
|
|
||||||
(defmacro eachp
|
(defmacro eachp
|
||||||
"Loop over each (key, value) pair in ds. Returns nil."
|
"Loop over each (key, value) pair in ds. Returns nil."
|
||||||
[x ds & body]
|
[x ds & body]
|
||||||
(keys-template x ds true body))
|
(each-template x ds :pairs body))
|
||||||
|
|
||||||
(defmacro eachy
|
(defmacro eachy
|
||||||
"Resume a fiber in a loop until it has errored or died. Evaluate the body
|
"Resume a fiber in a loop until it has errored or died. Evaluate the body
|
||||||
@ -514,7 +519,7 @@
|
|||||||
(defmacro each
|
(defmacro each
|
||||||
"Loop over each value in ds. Returns nil."
|
"Loop over each value in ds. Returns nil."
|
||||||
[x ds & body]
|
[x ds & body]
|
||||||
(each-template x ds body))
|
(each-template x ds :each body))
|
||||||
|
|
||||||
(defmacro loop
|
(defmacro loop
|
||||||
"A general purpose loop macro. This macro is similar to the Common Lisp
|
"A general purpose loop macro. This macro is similar to the Common Lisp
|
||||||
@ -556,9 +561,9 @@
|
|||||||
(put _env 'loop1 nil)
|
(put _env 'loop1 nil)
|
||||||
(put _env 'check-indexed nil)
|
(put _env 'check-indexed nil)
|
||||||
(put _env 'for-template nil)
|
(put _env 'for-template nil)
|
||||||
|
(put _env 'for-var-template nil)
|
||||||
(put _env 'iterate-template nil)
|
(put _env 'iterate-template nil)
|
||||||
(put _env 'each-template nil)
|
(put _env 'each-template nil)
|
||||||
(put _env 'keys-template nil)
|
|
||||||
(put _env 'range-template nil)
|
(put _env 'range-template nil)
|
||||||
(put _env 'loop-fiber-template nil)
|
(put _env 'loop-fiber-template nil)
|
||||||
|
|
||||||
@ -688,18 +693,8 @@
|
|||||||
|
|
||||||
## Polymorphic comparisons
|
## Polymorphic comparisons
|
||||||
|
|
||||||
(defn compare-primitive
|
|
||||||
"Compare x and y using primitive operators.
|
|
||||||
Returns -1,0,1 for x < y, x = y, x > y respectively.
|
|
||||||
Present mostly for constructing 'compare' methods in prototypes."
|
|
||||||
[x y]
|
|
||||||
(cond
|
|
||||||
(= x y) 0
|
|
||||||
(< x y) -1
|
|
||||||
(> x y) 1))
|
|
||||||
|
|
||||||
(defn compare
|
(defn compare
|
||||||
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
|
"Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||||
Differs from the primitive comparators in that it first checks to
|
Differs from the primitive comparators in that it first checks to
|
||||||
see whether either x or y implement a 'compare' method which can
|
see whether either x or y implement a 'compare' method which can
|
||||||
compare x and y. If so it uses that compare method. If not, it
|
compare x and y. If so it uses that compare method. If not, it
|
||||||
@ -707,9 +702,8 @@
|
|||||||
[x y]
|
[x y]
|
||||||
(or
|
(or
|
||||||
(when-let [f (get x :compare)] (f x y))
|
(when-let [f (get x :compare)] (f x y))
|
||||||
(when-let [f (get y :compare)
|
(when-let [f (get y :compare)] (- (f y x)))
|
||||||
fyx (f y x)] (- fyx))
|
(cmp x y)))
|
||||||
(compare-primitive x y)))
|
|
||||||
|
|
||||||
(defn- compare-reduce [op xs]
|
(defn- compare-reduce [op xs]
|
||||||
(var r true)
|
(var r true)
|
||||||
@ -758,7 +752,7 @@
|
|||||||
[a lo hi by]
|
[a lo hi by]
|
||||||
(def pivot (in a hi))
|
(def pivot (in a hi))
|
||||||
(var i lo)
|
(var i lo)
|
||||||
(for j lo hi
|
(forv j lo hi
|
||||||
(def aj (in a j))
|
(def aj (in a j))
|
||||||
(when (by aj pivot)
|
(when (by aj pivot)
|
||||||
(def ai (in a i))
|
(def ai (in a i))
|
||||||
@ -856,19 +850,19 @@
|
|||||||
(def ninds (length inds))
|
(def ninds (length inds))
|
||||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
||||||
(var limit (length (in inds 0)))
|
(var limit (length (in inds 0)))
|
||||||
(for i 0 ninds
|
(forv i 0 ninds
|
||||||
(def l (length (in inds i)))
|
(def l (length (in inds i)))
|
||||||
(if (< l limit) (set limit l)))
|
(if (< l limit) (set limit l)))
|
||||||
(def [i1 i2 i3 i4] inds)
|
(def [i1 i2 i3 i4] inds)
|
||||||
(def res (array/new limit))
|
(def res (array/new limit))
|
||||||
(case ninds
|
(case ninds
|
||||||
1 (for i 0 limit (set (res i) (f (in i1 i))))
|
1 (forv i 0 limit (set (res i) (f (in i1 i))))
|
||||||
2 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
|
2 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
|
||||||
3 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
|
3 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
|
||||||
4 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
|
4 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
|
||||||
(for i 0 limit
|
(forv i 0 limit
|
||||||
(def args (array/new ninds))
|
(def args (array/new ninds))
|
||||||
(for j 0 ninds (set (args j) (in (in inds j) i)))
|
(forv j 0 ninds (set (args j) (in (in inds j) i)))
|
||||||
(set (res i) (f ;args))))
|
(set (res i) (f ;args))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
@ -920,12 +914,12 @@
|
|||||||
1 (do
|
1 (do
|
||||||
(def [n] args)
|
(def [n] args)
|
||||||
(def arr (array/new n))
|
(def arr (array/new n))
|
||||||
(for i 0 n (put arr i i))
|
(forv i 0 n (put arr i i))
|
||||||
arr)
|
arr)
|
||||||
2 (do
|
2 (do
|
||||||
(def [n m] args)
|
(def [n m] args)
|
||||||
(def arr (array/new (- m n)))
|
(def arr (array/new (- m n)))
|
||||||
(for i n m (put arr (- i n) i))
|
(forv i n m (put arr (- i n) i))
|
||||||
arr)
|
arr)
|
||||||
3 (do
|
3 (do
|
||||||
(def [n m s] args)
|
(def [n m s] args)
|
||||||
@ -1208,19 +1202,34 @@
|
|||||||
(if x nil (set res x)))
|
(if x nil (set res x)))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
|
(defn reverse!
|
||||||
|
"Reverses the order of the elements in a given array or buffer and returns it
|
||||||
|
mutated."
|
||||||
|
[t]
|
||||||
|
(def len-1 (- (length t) 1))
|
||||||
|
(def half (/ len-1 2))
|
||||||
|
(forv i 0 half
|
||||||
|
(def j (- len-1 i))
|
||||||
|
(def l (in t i))
|
||||||
|
(def r (in t j))
|
||||||
|
(put t i r)
|
||||||
|
(put t j l))
|
||||||
|
t)
|
||||||
|
|
||||||
(defn reverse
|
(defn reverse
|
||||||
"Reverses the order of the elements in a given array or tuple and returns a new array."
|
"Reverses the order of the elements in a given array or tuple and returns
|
||||||
|
a new array. If string or buffer is provided function returns array of chars reversed."
|
||||||
[t]
|
[t]
|
||||||
(def len (length t))
|
(def len (length t))
|
||||||
(var n (- len 1))
|
(var n (- len 1))
|
||||||
(def reversed (array/new len))
|
(def ret (array/new len))
|
||||||
(while (>= n 0)
|
(while (>= n 0)
|
||||||
(array/push reversed (in t n))
|
(array/push ret (in t n))
|
||||||
(-- n))
|
(-- n))
|
||||||
reversed)
|
ret)
|
||||||
|
|
||||||
(defn invert
|
(defn invert
|
||||||
"Returns a table of where the keys of an associative data structure
|
"Returns a table where the keys of an associative data structure
|
||||||
are the values, and the values of the keys. If multiple keys have the same
|
are the values, and the values of the keys. If multiple keys have the same
|
||||||
value, one key will be ignored."
|
value, one key will be ignored."
|
||||||
[ds]
|
[ds]
|
||||||
@ -1234,11 +1243,14 @@
|
|||||||
Returns a new table."
|
Returns a new table."
|
||||||
[ks vs]
|
[ks vs]
|
||||||
(def res @{})
|
(def res @{})
|
||||||
(def lk (length ks))
|
(var kk nil)
|
||||||
(def lv (length vs))
|
(var vk nil)
|
||||||
(def len (if (< lk lv) lk lv))
|
(while true
|
||||||
(for i 0 len
|
(set kk (next ks kk))
|
||||||
(put res (in ks i) (in vs i)))
|
(if (= nil kk) (break))
|
||||||
|
(set vk (next vs vk))
|
||||||
|
(if (= nil vk) (break))
|
||||||
|
(put res (in ks kk) (in vs vk)))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn get-in
|
(defn get-in
|
||||||
@ -1258,7 +1270,7 @@
|
|||||||
(var d ds)
|
(var d ds)
|
||||||
(def len-1 (- (length ks) 1))
|
(def len-1 (- (length ks) 1))
|
||||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
||||||
(for i 0 len-1
|
(forv i 0 len-1
|
||||||
(def k (get ks i))
|
(def k (get ks i))
|
||||||
(def v (get d k))
|
(def v (get d k))
|
||||||
(if (= nil v)
|
(if (= nil v)
|
||||||
@ -1280,7 +1292,7 @@
|
|||||||
(var d ds)
|
(var d ds)
|
||||||
(def len-1 (- (length ks) 1))
|
(def len-1 (- (length ks) 1))
|
||||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
||||||
(for i 0 len-1
|
(forv i 0 len-1
|
||||||
(def k (get ks i))
|
(def k (get ks i))
|
||||||
(def v (get d k))
|
(def v (get d k))
|
||||||
(if (= nil v)
|
(if (= nil v)
|
||||||
@ -1953,20 +1965,24 @@
|
|||||||
that should make it easier to write more complex patterns."
|
that should make it easier to write more complex patterns."
|
||||||
~@{:d (range "09")
|
~@{:d (range "09")
|
||||||
:a (range "az" "AZ")
|
:a (range "az" "AZ")
|
||||||
:s (set " \t\r\n\0\f")
|
:s (set " \t\r\n\0\f\v")
|
||||||
:w (range "az" "AZ" "09")
|
:w (range "az" "AZ" "09")
|
||||||
|
:h (range "09" "af")
|
||||||
:S (if-not :s 1)
|
:S (if-not :s 1)
|
||||||
:W (if-not :w 1)
|
:W (if-not :w 1)
|
||||||
:A (if-not :a 1)
|
:A (if-not :a 1)
|
||||||
:D (if-not :d 1)
|
:D (if-not :d 1)
|
||||||
|
:H (if-not :h 1)
|
||||||
:d+ (some :d)
|
:d+ (some :d)
|
||||||
:a+ (some :a)
|
:a+ (some :a)
|
||||||
:s+ (some :s)
|
:s+ (some :s)
|
||||||
:w+ (some :w)
|
:w+ (some :w)
|
||||||
|
:h+ (some :h)
|
||||||
:d* (any :d)
|
:d* (any :d)
|
||||||
:a* (any :a)
|
:a* (any :a)
|
||||||
:w* (any :w)
|
:w* (any :w)
|
||||||
:s* (any :s)})
|
:s* (any :s)
|
||||||
|
:h* (any :h)})
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@ -2522,7 +2538,7 @@
|
|||||||
[&opt n]
|
[&opt n]
|
||||||
(def fun (.fn n))
|
(def fun (.fn n))
|
||||||
(def bytecode (.bytecode n))
|
(def bytecode (.bytecode n))
|
||||||
(for i 0 (length bytecode)
|
(forv i 0 (length bytecode)
|
||||||
(debug/fbreak fun i))
|
(debug/fbreak fun i))
|
||||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||||
|
|
||||||
@ -2531,7 +2547,7 @@
|
|||||||
[&opt n]
|
[&opt n]
|
||||||
(def fun (.fn n))
|
(def fun (.fn n))
|
||||||
(def bytecode (.bytecode n))
|
(def bytecode (.bytecode n))
|
||||||
(for i 0 (length bytecode)
|
(forv i 0 (length bytecode)
|
||||||
(debug/unfbreak fun i))
|
(debug/unfbreak fun i))
|
||||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||||
|
|
||||||
@ -2573,7 +2589,7 @@
|
|||||||
"Go to the next breakpoint."
|
"Go to the next breakpoint."
|
||||||
[&opt n]
|
[&opt n]
|
||||||
(var res nil)
|
(var res nil)
|
||||||
(for i 0 (or n 1)
|
(forv i 0 (or n 1)
|
||||||
(set res (resume (.fiber))))
|
(set res (resume (.fiber))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
@ -2587,7 +2603,7 @@
|
|||||||
"Execute the next n instructions."
|
"Execute the next n instructions."
|
||||||
[&opt n]
|
[&opt n]
|
||||||
(var res nil)
|
(var res nil)
|
||||||
(for i 0 (or n 1)
|
(forv i 0 (or n 1)
|
||||||
(set res (debug/step (.fiber))))
|
(set res (debug/step (.fiber))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
|
@ -41,7 +41,8 @@
|
|||||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||||
|
|
||||||
/* These settings should be specified before amalgamation is
|
/* These settings should be specified before amalgamation is
|
||||||
* built. */
|
* built. Any build with these set should be considered non-standard, and
|
||||||
|
* certain Janet libraries should be expected not to work. */
|
||||||
/* #define JANET_NO_DOCSTRINGS */
|
/* #define JANET_NO_DOCSTRINGS */
|
||||||
/* #define JANET_NO_SOURCEMAPS */
|
/* #define JANET_NO_SOURCEMAPS */
|
||||||
/* #define JANET_REDUCED_OS */
|
/* #define JANET_REDUCED_OS */
|
||||||
@ -52,13 +53,13 @@
|
|||||||
/* #define JANET_NO_TYPED_ARRAY */
|
/* #define JANET_NO_TYPED_ARRAY */
|
||||||
/* #define JANET_NO_INT_TYPES */
|
/* #define JANET_NO_INT_TYPES */
|
||||||
/* #define JANET_NO_EV */
|
/* #define JANET_NO_EV */
|
||||||
|
/* #define JANET_NO_REALPATH */
|
||||||
|
/* #define JANET_NO_SYMLINKS */
|
||||||
|
/* #define JANET_NO_UMASK */
|
||||||
|
|
||||||
/* Other settings */
|
/* Other settings */
|
||||||
/* #define JANET_NO_PRF */
|
/* #define JANET_NO_PRF */
|
||||||
/* #define JANET_NO_UTC_MKTIME */
|
/* #define JANET_NO_UTC_MKTIME */
|
||||||
/* #define JANET_NO_REALPATH */
|
|
||||||
/* #define JANET_NO_SYMLINKS */
|
|
||||||
/* #define JANET_NO_UMASK */
|
|
||||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||||
@ -69,4 +70,7 @@
|
|||||||
/* #define JANET_OS_NAME my-custom-os */
|
/* #define JANET_OS_NAME my-custom-os */
|
||||||
/* #define JANET_ARCH_NAME pdp-8 */
|
/* #define JANET_ARCH_NAME pdp-8 */
|
||||||
|
|
||||||
|
/* Main client settings, does not affect library code */
|
||||||
|
/* #define JANET_SIMPLE_GETLINE */
|
||||||
|
|
||||||
#endif /* end of include guard: JANETCONF_H */
|
#endif /* end of include guard: JANETCONF_H */
|
||||||
|
@ -112,6 +112,8 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"movn", JOP_MOVE_NEAR},
|
{"movn", JOP_MOVE_NEAR},
|
||||||
{"mul", JOP_MULTIPLY},
|
{"mul", JOP_MULTIPLY},
|
||||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||||
|
{"neq", JOP_NOT_EQUALS},
|
||||||
|
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
|
||||||
{"next", JOP_NEXT},
|
{"next", JOP_NEXT},
|
||||||
{"noop", JOP_NOOP},
|
{"noop", JOP_NOOP},
|
||||||
{"prop", JOP_PROPAGATE},
|
{"prop", JOP_PROPAGATE},
|
||||||
|
@ -101,10 +101,12 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||||
JINT_SSS, /* JOP_NEXT */
|
JINT_SSS, /* JOP_NEXT */
|
||||||
|
JINT_SSS, /* JOP_NOT_EQUALS, */
|
||||||
|
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Verify some bytecode */
|
/* Verify some bytecode */
|
||||||
int32_t janet_verify(JanetFuncDef *def) {
|
int janet_verify(JanetFuncDef *def) {
|
||||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||||
int32_t i;
|
int32_t i;
|
||||||
int32_t maxslot = def->arity + vargs;
|
int32_t maxslot = def->arity + vargs;
|
||||||
|
120
src/core/cfuns.c
120
src/core/cfuns.c
@ -33,6 +33,11 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
|
|||||||
int32_t arity = janet_v_count(args);
|
int32_t arity = janet_v_count(args);
|
||||||
return arity == 1 || arity == 2;
|
return arity == 1 || arity == 2;
|
||||||
}
|
}
|
||||||
|
static int arity2or3(JanetFopts opts, JanetSlot *args) {
|
||||||
|
(void) opts;
|
||||||
|
int32_t arity = janet_v_count(args);
|
||||||
|
return arity == 2 || arity == 3;
|
||||||
|
}
|
||||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) == 1;
|
return janet_v_count(args) == 1;
|
||||||
@ -90,34 +95,67 @@ static JanetSlot opfunction(
|
|||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Check if a value can be coerced to an immediate value */
|
||||||
|
static int can_be_imm(Janet x, int8_t *out) {
|
||||||
|
if (!janet_checkint(x)) return 0;
|
||||||
|
int32_t integer = janet_unwrap_integer(x);
|
||||||
|
if (integer > 127 || integer < -127) return 0;
|
||||||
|
*out = (int8_t) integer;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Check if a slot can be coerced to an immediate value */
|
||||||
|
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
|
||||||
|
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
|
||||||
|
return can_be_imm(s.constant, out);
|
||||||
|
}
|
||||||
|
|
||||||
/* Emit a series of instructions instead of a function call to a math op */
|
/* Emit a series of instructions instead of a function call to a math op */
|
||||||
static JanetSlot opreduce(
|
static JanetSlot opreduce(
|
||||||
JanetFopts opts,
|
JanetFopts opts,
|
||||||
JanetSlot *args,
|
JanetSlot *args,
|
||||||
int op,
|
int op,
|
||||||
|
int opim,
|
||||||
Janet nullary) {
|
Janet nullary) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
|
int8_t imm = 0;
|
||||||
|
int neg = opim < 0;
|
||||||
|
if (opim < 0) opim = -opim;
|
||||||
len = janet_v_count(args);
|
len = janet_v_count(args);
|
||||||
JanetSlot t;
|
JanetSlot t;
|
||||||
if (len == 0) {
|
if (len == 0) {
|
||||||
return janetc_cslot(nullary);
|
return janetc_cslot(nullary);
|
||||||
} else if (len == 1) {
|
} else if (len == 1) {
|
||||||
t = janetc_gettarget(opts);
|
t = janetc_gettarget(opts);
|
||||||
|
/* Special case subtract to be times -1 */
|
||||||
|
if (op == JOP_SUBTRACT) {
|
||||||
|
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||||
|
} else {
|
||||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||||
|
}
|
||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
t = janetc_gettarget(opts);
|
t = janetc_gettarget(opts);
|
||||||
|
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||||
|
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||||
|
} else {
|
||||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||||
for (i = 2; i < len; i++)
|
}
|
||||||
|
for (i = 2; i < len; i++) {
|
||||||
|
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||||
|
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||||
|
} else {
|
||||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||||
|
}
|
||||||
|
}
|
||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Function optimizers */
|
/* Function optimizers */
|
||||||
|
|
||||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||||
@ -134,19 +172,40 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
|||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
|
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
if (janet_v_count(args) == 3) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
JanetSlot t = janetc_gettarget(opts);
|
||||||
|
int target_is_default = janetc_sequal(t, args[2]);
|
||||||
|
JanetSlot dflt_slot = args[2];
|
||||||
|
if (target_is_default) {
|
||||||
|
dflt_slot = janetc_farslot(c);
|
||||||
|
janetc_copy(c, dflt_slot, t);
|
||||||
|
}
|
||||||
|
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
|
||||||
|
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
|
||||||
|
janetc_copy(c, t, dflt_slot);
|
||||||
|
if (target_is_default) janetc_freeslot(c, dflt_slot);
|
||||||
|
int32_t current = janet_v_count(c->buffer);
|
||||||
|
c->buffer[label] |= (current - label) << 16;
|
||||||
|
return t;
|
||||||
|
} else {
|
||||||
|
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||||
|
}
|
||||||
}
|
}
|
||||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
|
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
|
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||||
|
}
|
||||||
|
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||||
|
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||||
if (opts.flags & JANET_FOPTS_DROP) {
|
if (opts.flags & JANET_FOPTS_DROP) {
|
||||||
@ -200,34 +259,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||||||
/* Variadic operators specialization */
|
/* Variadic operators specialization */
|
||||||
|
|
||||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
|
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||||
return genericSS(opts, JOP_BNOT, args[0]);
|
return genericSS(opts, JOP_BNOT, args[0]);
|
||||||
@ -238,9 +297,11 @@ static JanetSlot compreduce(
|
|||||||
JanetFopts opts,
|
JanetFopts opts,
|
||||||
JanetSlot *args,
|
JanetSlot *args,
|
||||||
int op,
|
int op,
|
||||||
|
int opim,
|
||||||
int invert) {
|
int invert) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
|
int8_t imm = 0;
|
||||||
len = janet_v_count(args);
|
len = janet_v_count(args);
|
||||||
int32_t *labels = NULL;
|
int32_t *labels = NULL;
|
||||||
JanetSlot t;
|
JanetSlot t;
|
||||||
@ -251,19 +312,17 @@ static JanetSlot compreduce(
|
|||||||
}
|
}
|
||||||
t = janetc_gettarget(opts);
|
t = janetc_gettarget(opts);
|
||||||
for (i = 1; i < len; i++) {
|
for (i = 1; i < len; i++) {
|
||||||
|
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||||
|
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
|
||||||
|
} else {
|
||||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||||
|
}
|
||||||
if (i != (len - 1)) {
|
if (i != (len - 1)) {
|
||||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
|
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
|
||||||
janet_v_push(labels, label);
|
janet_v_push(labels, label);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
int32_t end = janet_v_count(c->buffer);
|
int32_t end = janet_v_count(c->buffer);
|
||||||
if (invert) {
|
|
||||||
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
|
|
||||||
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
|
|
||||||
janetc_emit(c, JOP_JUMP | (2 << 8));
|
|
||||||
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
|
|
||||||
}
|
|
||||||
for (i = 0; i < janet_v_count(labels); i++) {
|
for (i = 0; i < janet_v_count(labels); i++) {
|
||||||
int32_t label = labels[i];
|
int32_t label = labels[i];
|
||||||
c->buffer[label] |= ((end - label) << 16);
|
c->buffer[label] |= ((end - label) << 16);
|
||||||
@ -273,22 +332,22 @@ static JanetSlot compreduce(
|
|||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_GREATER_THAN, 0);
|
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
|
||||||
}
|
}
|
||||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_LESS_THAN, 0);
|
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
|
||||||
}
|
}
|
||||||
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
|
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
|
||||||
}
|
}
|
||||||
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
|
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
|
||||||
}
|
}
|
||||||
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
|
||||||
}
|
}
|
||||||
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Arranged by tag */
|
/* Arranged by tag */
|
||||||
@ -319,10 +378,11 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{NULL, do_eq},
|
{NULL, do_eq},
|
||||||
{NULL, do_neq},
|
{NULL, do_neq},
|
||||||
{fixarity2, do_propagate},
|
{fixarity2, do_propagate},
|
||||||
{fixarity2, do_get},
|
{arity2or3, do_get},
|
||||||
{arity1or2, do_next},
|
{arity1or2, do_next},
|
||||||
{fixarity2, do_modulo},
|
{fixarity2, do_modulo},
|
||||||
{fixarity2, do_remainder},
|
{fixarity2, do_remainder},
|
||||||
|
{fixarity2, do_cmp},
|
||||||
};
|
};
|
||||||
|
|
||||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||||
|
@ -60,6 +60,7 @@
|
|||||||
#define JANET_FUN_NEXT 28
|
#define JANET_FUN_NEXT 28
|
||||||
#define JANET_FUN_MODULO 29
|
#define JANET_FUN_MODULO 29
|
||||||
#define JANET_FUN_REMAINDER 30
|
#define JANET_FUN_REMAINDER 30
|
||||||
|
#define JANET_FUN_CMP 31
|
||||||
|
|
||||||
/* Compiler typedefs */
|
/* Compiler typedefs */
|
||||||
typedef struct JanetCompiler JanetCompiler;
|
typedef struct JanetCompiler JanetCompiler;
|
||||||
|
@ -404,9 +404,11 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
|||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
size_t s = janet_getsize(argv, 0);
|
size_t s = janet_getsize(argv, 0);
|
||||||
/* limit interval to 48 bits */
|
/* limit interval to 48 bits */
|
||||||
if (s > 0xFFFFFFFFFFFFUl) {
|
#ifdef JANET_64
|
||||||
|
if (s >> 48) {
|
||||||
janet_panic("interval too large");
|
janet_panic("interval too large");
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
janet_vm_gc_interval = s;
|
janet_vm_gc_interval = s;
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
@ -968,6 +970,10 @@ static const uint32_t remainder_asm[] = {
|
|||||||
JOP_REMAINDER | (1 << 24),
|
JOP_REMAINDER | (1 << 24),
|
||||||
JOP_RETURN
|
JOP_RETURN
|
||||||
};
|
};
|
||||||
|
static const uint32_t cmp_asm[] = {
|
||||||
|
JOP_COMPARE | (1 << 24),
|
||||||
|
JOP_RETURN
|
||||||
|
};
|
||||||
#endif /* ifdef JANET_BOOTSTRAP */
|
#endif /* ifdef JANET_BOOTSTRAP */
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@ -1024,6 +1030,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||||
JDOC("(% dividend divisor)\n\n"
|
JDOC("(% dividend divisor)\n\n"
|
||||||
"Returns the remainder of dividend / divisor."));
|
"Returns the remainder of dividend / divisor."));
|
||||||
|
janet_quick_asm(env, JANET_FUN_CMP,
|
||||||
|
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||||
|
JDOC("(cmp x y)\n\n"
|
||||||
|
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||||
|
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||||
JDOC("(next ds &opt key)\n\n"
|
JDOC("(next ds &opt key)\n\n"
|
||||||
|
@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
|
|||||||
return reg;
|
return reg;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get a register less than 256 */
|
/* Get a register less than 256 for temporary use. */
|
||||||
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
|
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
|
||||||
return janetc_regalloc_temp(&c->scope->ra, tag);
|
return janetc_regalloc_temp(&c->scope->ra, tag);
|
||||||
}
|
}
|
||||||
@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Check if two slots are equal */
|
/* Check if two slots are equal */
|
||||||
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||||
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
|
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
|
||||||
lhs.index == rhs.index &&
|
lhs.index == rhs.index &&
|
||||||
lhs.envindex == rhs.envindex) {
|
lhs.envindex == rhs.envindex) {
|
||||||
@ -245,8 +245,8 @@ void janetc_copy(
|
|||||||
janetc_moveback(c, dest, nearreg);
|
janetc_moveback(c, dest, nearreg);
|
||||||
/* Cleanup */
|
/* Cleanup */
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Instruction templated emitters */
|
/* Instruction templated emitters */
|
||||||
|
|
||||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||||
|
@ -42,6 +42,9 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
|||||||
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
|
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
|
||||||
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
|
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
|
||||||
|
|
||||||
|
/* Check if two slots are equivalent */
|
||||||
|
int janetc_sequal(JanetSlot x, JanetSlot y);
|
||||||
|
|
||||||
/* Move value from one slot to another. Cannot copy to constant slots. */
|
/* Move value from one slot to another. Cannot copy to constant slots. */
|
||||||
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
|
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
|
||||||
|
|
||||||
|
@ -39,6 +39,7 @@ struct JanetScratch {
|
|||||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||||
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||||
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||||
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
||||||
|
|
||||||
/* Roots */
|
/* Roots */
|
||||||
@ -327,6 +328,7 @@ void janet_sweep() {
|
|||||||
previous = current;
|
previous = current;
|
||||||
current->flags &= ~JANET_MEM_REACHABLE;
|
current->flags &= ~JANET_MEM_REACHABLE;
|
||||||
} else {
|
} else {
|
||||||
|
janet_vm_block_count--;
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
if (NULL != previous) {
|
if (NULL != previous) {
|
||||||
previous->next = next;
|
previous->next = next;
|
||||||
@ -359,6 +361,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
|||||||
janet_vm_next_collection += size;
|
janet_vm_next_collection += size;
|
||||||
mem->next = janet_vm_blocks;
|
mem->next = janet_vm_blocks;
|
||||||
janet_vm_blocks = mem;
|
janet_vm_blocks = mem;
|
||||||
|
janet_vm_block_count++;
|
||||||
|
|
||||||
return (void *)mem;
|
return (void *)mem;
|
||||||
}
|
}
|
||||||
@ -388,6 +391,14 @@ void janet_collect(void) {
|
|||||||
uint32_t i;
|
uint32_t i;
|
||||||
if (janet_vm_gc_suspend) return;
|
if (janet_vm_gc_suspend) return;
|
||||||
depth = JANET_RECURSION_GUARD;
|
depth = JANET_RECURSION_GUARD;
|
||||||
|
/* Try and prevent many major collections back to back.
|
||||||
|
* A full collection will take O(janet_vm_block_count) time.
|
||||||
|
* If we have a large heap, make sure our interval is not too
|
||||||
|
* small so we won't make many collections over it. This is just a
|
||||||
|
* heuristic for automatically changing the gc interval */
|
||||||
|
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
|
||||||
|
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
|
||||||
|
}
|
||||||
orig_rootcount = janet_vm_root_count;
|
orig_rootcount = janet_vm_root_count;
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
janet_ev_mark();
|
janet_ev_mark();
|
||||||
|
@ -499,5 +499,11 @@ void janet_lib_math(JanetTable *env) {
|
|||||||
JDOC("The number representing positive infinity"));
|
JDOC("The number representing positive infinity"));
|
||||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||||
JDOC("The number representing negative infinity"));
|
JDOC("The number representing negative infinity"));
|
||||||
|
#ifdef NAN
|
||||||
|
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||||
|
#else
|
||||||
|
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
|
||||||
|
#endif
|
||||||
|
JDOC("Not a number (IEEE-754 NaN)"));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -113,7 +113,7 @@ static JanetStream *make_stream(SOCKET fd, uint32_t flags) {
|
|||||||
static JanetStream *make_stream(int fd, uint32_t flags) {
|
static JanetStream *make_stream(int fd, uint32_t flags) {
|
||||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||||
janet_pollable_init(stream, fd);
|
janet_pollable_init(stream, fd);
|
||||||
#ifndef SOCK_CLOEXEC
|
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
|
||||||
int extra = O_CLOEXEC;
|
int extra = O_CLOEXEC;
|
||||||
#else
|
#else
|
||||||
int extra = 0;
|
int extra = 0;
|
||||||
|
@ -39,6 +39,10 @@
|
|||||||
|
|
||||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||||
|
|
||||||
|
#ifdef JANET_APPLE
|
||||||
|
#include <AvailabilityMacros.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#include <direct.h>
|
#include <direct.h>
|
||||||
@ -66,7 +70,7 @@ extern char **environ;
|
|||||||
|
|
||||||
/* Setting C99 standard makes this not available, but it should
|
/* Setting C99 standard makes this not available, but it should
|
||||||
* work/link properly if we detect a BSD */
|
* work/link properly if we detect a BSD */
|
||||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||||
void arc4random_buf(void *buf, size_t nbytes);
|
void arc4random_buf(void *buf, size_t nbytes);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@ -159,6 +163,8 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
|||||||
return janet_ckeywordv("arm");
|
return janet_ckeywordv("arm");
|
||||||
#elif (defined(__sparc__))
|
#elif (defined(__sparc__))
|
||||||
return janet_ckeywordv("sparc");
|
return janet_ckeywordv("sparc");
|
||||||
|
#elif (defined(__ppc__))
|
||||||
|
return janet_ckeywordv("ppc");
|
||||||
#else
|
#else
|
||||||
return janet_ckeywordv("unknown");
|
return janet_ckeywordv("unknown");
|
||||||
#endif
|
#endif
|
||||||
@ -508,39 +514,11 @@ static Janet os_time(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_number(dtime);
|
return janet_wrap_number(dtime);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Clock shims */
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
static int gettime(struct timespec *spec) {
|
|
||||||
FILETIME ftime;
|
|
||||||
GetSystemTimeAsFileTime(&ftime);
|
|
||||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
|
||||||
/* Windows epoch is January 1, 1601 apparently */
|
|
||||||
wintime -= 116444736000000000LL;
|
|
||||||
spec->tv_sec = wintime / 10000000LL;
|
|
||||||
/* Resolution is 100 nanoseconds. */
|
|
||||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
#elif defined(__MACH__)
|
|
||||||
static int gettime(struct timespec *spec) {
|
|
||||||
clock_serv_t cclock;
|
|
||||||
mach_timespec_t mts;
|
|
||||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
|
||||||
clock_get_time(cclock, &mts);
|
|
||||||
mach_port_deallocate(mach_task_self(), cclock);
|
|
||||||
spec->tv_sec = mts.tv_sec;
|
|
||||||
spec->tv_nsec = mts.tv_nsec;
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static Janet os_clock(int32_t argc, Janet *argv) {
|
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
struct timespec tv;
|
struct timespec tv;
|
||||||
if (gettime(&tv)) janet_panic("could not get time");
|
if (janet_gettime(&tv)) janet_panic("could not get time");
|
||||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||||
return janet_wrap_number(dtime);
|
return janet_wrap_number(dtime);
|
||||||
}
|
}
|
||||||
@ -604,10 +582,11 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
|||||||
v = v >> 8;
|
v = v >> 8;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#elif defined(JANET_LINUX)
|
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||||
to be uniformly supported on linux distros.
|
to be uniformly supported on linux distros.
|
||||||
In both cases, use this fallback path for now... */
|
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||||
|
In these cases, use this fallback path for now... */
|
||||||
int rc;
|
int rc;
|
||||||
int randfd;
|
int randfd;
|
||||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||||
@ -624,7 +603,7 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
|||||||
n -= nread;
|
n -= nread;
|
||||||
}
|
}
|
||||||
RETRY_EINTR(rc, close(randfd));
|
RETRY_EINTR(rc, close(randfd));
|
||||||
#elif defined(JANET_BSD) || defined(JANET_APPLE)
|
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||||
(void) genericerr;
|
(void) genericerr;
|
||||||
arc4random_buf(buffer->data + offset, n);
|
arc4random_buf(buffer->data + offset, n);
|
||||||
#else
|
#else
|
||||||
|
168
src/core/peg.c
168
src/core/peg.c
@ -1308,47 +1308,136 @@ static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_abstract(peg);
|
return janet_wrap_abstract(peg);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
/* Common data for peg cfunctions */
|
||||||
janet_arity(argc, 2, -1);
|
typedef struct {
|
||||||
JanetPeg *peg;
|
JanetPeg *peg;
|
||||||
|
PegState s;
|
||||||
|
JanetByteView bytes;
|
||||||
|
JanetByteView repl;
|
||||||
|
int32_t start;
|
||||||
|
} PegCall;
|
||||||
|
|
||||||
|
/* Initialize state for peg cfunctions */
|
||||||
|
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||||
|
PegCall ret;
|
||||||
|
int32_t min = get_replace ? 3 : 2;
|
||||||
|
janet_arity(argc, get_replace, -1);
|
||||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||||
peg = janet_unwrap_abstract(argv[0]);
|
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||||
} else {
|
} else {
|
||||||
peg = compile_peg(argv[0]);
|
ret.peg = compile_peg(argv[0]);
|
||||||
}
|
}
|
||||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
if (get_replace) {
|
||||||
int32_t start;
|
ret.repl = janet_getbytes(argv, 1);
|
||||||
PegState s;
|
ret.bytes = janet_getbytes(argv, 2);
|
||||||
if (argc > 2) {
|
|
||||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
|
||||||
s.extrac = argc - 3;
|
|
||||||
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
|
||||||
} else {
|
} else {
|
||||||
start = 0;
|
ret.bytes = janet_getbytes(argv, 1);
|
||||||
s.extrac = 0;
|
|
||||||
s.extrav = NULL;
|
|
||||||
}
|
}
|
||||||
s.mode = PEG_MODE_NORMAL;
|
if (argc > min) {
|
||||||
s.text_start = bytes.bytes;
|
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
|
||||||
s.text_end = bytes.bytes + bytes.len;
|
ret.s.extrac = argc - min - 1;
|
||||||
s.depth = JANET_RECURSION_GUARD;
|
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
|
||||||
s.captures = janet_array(0);
|
} else {
|
||||||
s.scratch = janet_buffer(10);
|
ret.start = 0;
|
||||||
s.tags = janet_buffer(10);
|
ret.s.extrac = 0;
|
||||||
s.constants = peg->constants;
|
ret.s.extrav = NULL;
|
||||||
s.bytecode = peg->bytecode;
|
}
|
||||||
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
ret.s.mode = PEG_MODE_NORMAL;
|
||||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
ret.s.text_start = ret.bytes.bytes;
|
||||||
|
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||||
|
ret.s.depth = JANET_RECURSION_GUARD;
|
||||||
|
ret.s.captures = janet_array(0);
|
||||||
|
ret.s.scratch = janet_buffer(10);
|
||||||
|
ret.s.tags = janet_buffer(10);
|
||||||
|
ret.s.constants = ret.peg->constants;
|
||||||
|
ret.s.bytecode = ret.peg->bytecode;
|
||||||
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void peg_call_reset(PegCall *c) {
|
||||||
|
c->s.captures->count = 0;
|
||||||
|
c->s.scratch->count = 0;
|
||||||
|
c->s.tags->count = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||||
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
|
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
|
||||||
|
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
|
||||||
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
|
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||||
|
peg_call_reset(&c);
|
||||||
|
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||||
|
return janet_wrap_integer(i);
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
|
||||||
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
|
JanetArray *ret = janet_array(0);
|
||||||
|
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||||
|
peg_call_reset(&c);
|
||||||
|
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||||
|
janet_array_push(ret, janet_wrap_integer(i));
|
||||||
|
}
|
||||||
|
return janet_wrap_array(ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||||
|
PegCall c = peg_cfun_init(argc, argv, 1);
|
||||||
|
JanetBuffer *ret = janet_buffer(0);
|
||||||
|
int32_t trail = 0;
|
||||||
|
for (int32_t i = c.start; i < c.bytes.len;) {
|
||||||
|
peg_call_reset(&c);
|
||||||
|
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
|
||||||
|
if (NULL != result) {
|
||||||
|
if (trail < i) {
|
||||||
|
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
|
||||||
|
trail = i;
|
||||||
|
}
|
||||||
|
int32_t nexti = result - c.bytes.bytes;
|
||||||
|
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||||
|
trail = nexti;
|
||||||
|
if (nexti == i) nexti++;
|
||||||
|
i = nexti;
|
||||||
|
if (only_one) break;
|
||||||
|
} else {
|
||||||
|
i++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (trail < c.bytes.len) {
|
||||||
|
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
|
||||||
|
}
|
||||||
|
return janet_wrap_buffer(ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
|
||||||
|
return cfun_peg_replace_generic(argc, argv, 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
|
||||||
|
return cfun_peg_replace_generic(argc, argv, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetMethod peg_methods[] = {
|
||||||
|
{"match", cfun_peg_match},
|
||||||
|
{"find", cfun_peg_find},
|
||||||
|
{"find-all", cfun_peg_find_all},
|
||||||
|
{"replace", cfun_peg_replace},
|
||||||
|
{"replace-all", cfun_peg_replace_all},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||||
(void) a;
|
(void) a;
|
||||||
if (janet_keyeq(key, "match")) {
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0;
|
return 0;
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg peg_cfuns[] = {
|
static const JanetReg peg_cfuns[] = {
|
||||||
@ -1364,6 +1453,27 @@ static const JanetReg peg_cfuns[] = {
|
|||||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"peg/find", cfun_peg_find,
|
||||||
|
JDOC("(peg/find peg text &opt start & args)\n\n"
|
||||||
|
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/find-all", cfun_peg_find_all,
|
||||||
|
JDOC("(peg/find-all peg text &opt start & args)\n\n"
|
||||||
|
"Find all indexes where the peg matches in text. Returns an array of integers.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/replace", cfun_peg_replace,
|
||||||
|
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
|
||||||
|
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
|
||||||
|
"If no matches are found, returns the input string in a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/replace-all", cfun_peg_replace_all,
|
||||||
|
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
|
||||||
|
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -188,7 +188,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
|||||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
janet_buffer_push_cstring(buffer, "nil");
|
janet_buffer_push_cstring(buffer, "");
|
||||||
break;
|
break;
|
||||||
case JANET_BOOLEAN:
|
case JANET_BOOLEAN:
|
||||||
janet_buffer_push_cstring(buffer,
|
janet_buffer_push_cstring(buffer,
|
||||||
@ -277,6 +277,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
|
case JANET_NIL:
|
||||||
|
janet_buffer_push_cstring(buffer, "nil");
|
||||||
|
return;
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
janet_buffer_push_u8(buffer, ':');
|
janet_buffer_push_u8(buffer, ':');
|
||||||
break;
|
break;
|
||||||
|
@ -71,6 +71,7 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
|||||||
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||||
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||||
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||||
|
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||||
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
||||||
|
|
||||||
/* GC roots */
|
/* GC roots */
|
||||||
|
@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
|||||||
int32_t ylen = janet_string_length(rhs);
|
int32_t ylen = janet_string_length(rhs);
|
||||||
int32_t len = xlen > ylen ? ylen : xlen;
|
int32_t len = xlen > ylen ? ylen : xlen;
|
||||||
int res = memcmp(lhs, rhs, len);
|
int res = memcmp(lhs, rhs, len);
|
||||||
if (res) return res;
|
if (res) return res > 0 ? 1 : -1;
|
||||||
if (xlen == ylen) return 0;
|
if (xlen == ylen) return 0;
|
||||||
return xlen < ylen ? -1 : 1;
|
return xlen < ylen ? -1 : 1;
|
||||||
}
|
}
|
||||||
@ -176,6 +176,18 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
|||||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
|
||||||
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
|
return janet_symbolv(view.bytes + range.start, range.end - range.start);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
|
||||||
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
|
return janet_keywordv(view.bytes + range.start, range.end - range.start);
|
||||||
|
}
|
||||||
|
|
||||||
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
@ -529,6 +541,16 @@ static const JanetReg string_cfuns[] = {
|
|||||||
"from the end of the string. Note that index -1 is synonymous with "
|
"from the end of the string. Note that index -1 is synonymous with "
|
||||||
"index (length bytes) to allow a full negative slice range. ")
|
"index (length bytes) to allow a full negative slice range. ")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"keyword/slice", cfun_keyword_slice,
|
||||||
|
JDOC("(keyword/slice bytes &opt start end)\n\n"
|
||||||
|
"Same a string/slice, but returns a keyword.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"symbol/slice", cfun_symbol_slice,
|
||||||
|
JDOC("(symbol/slice bytes &opt start end)\n\n"
|
||||||
|
"Same a string/slice, but returns a symbol.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"string/repeat", cfun_string_repeat,
|
"string/repeat", cfun_string_repeat,
|
||||||
JDOC("(string/repeat bytes n)\n\n"
|
JDOC("(string/repeat bytes n)\n\n"
|
||||||
|
@ -234,7 +234,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
|||||||
if (waiter->timedwait) {
|
if (waiter->timedwait) {
|
||||||
/* N seconds -> timespec of (now + sec) */
|
/* N seconds -> timespec of (now + sec) */
|
||||||
struct timespec now;
|
struct timespec now;
|
||||||
clock_gettime(CLOCK_REALTIME, &now);
|
janet_gettime(&now);
|
||||||
time_t tvsec = (time_t) floor(sec);
|
time_t tvsec = (time_t) floor(sec);
|
||||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||||
tvsec += now.tv_sec;
|
tvsec += now.tv_sec;
|
||||||
|
@ -26,6 +26,9 @@
|
|||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#include <windows.h>
|
||||||
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <inttypes.h>
|
#include <inttypes.h>
|
||||||
@ -574,8 +577,12 @@ int janet_checksize(Janet x) {
|
|||||||
if (!janet_checktype(x, JANET_NUMBER))
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
return 0;
|
return 0;
|
||||||
double dval = janet_unwrap_number(x);
|
double dval = janet_unwrap_number(x);
|
||||||
return dval == (double)((size_t) dval) &&
|
if (dval != (double)((size_t) dval)) return 0;
|
||||||
dval <= SIZE_MAX;
|
if (SIZE_MAX > JANET_INTMAX_INT64) {
|
||||||
|
return dval <= JANET_INTMAX_INT64;
|
||||||
|
} else {
|
||||||
|
return dval <= SIZE_MAX;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
JanetTable *janet_get_core_table(const char *name) {
|
JanetTable *janet_get_core_table(const char *name) {
|
||||||
@ -586,3 +593,35 @@ JanetTable *janet_get_core_table(const char *name) {
|
|||||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||||
return janet_unwrap_table(out);
|
return janet_unwrap_table(out);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Clock shims for various platforms */
|
||||||
|
#ifdef JANET_GETTIME
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int janet_gettime(struct timespec *spec) {
|
||||||
|
FILETIME ftime;
|
||||||
|
GetSystemTimeAsFileTime(&ftime);
|
||||||
|
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||||
|
/* Windows epoch is January 1, 1601 apparently */
|
||||||
|
wintime -= 116444736000000000LL;
|
||||||
|
spec->tv_sec = wintime / 10000000LL;
|
||||||
|
/* Resolution is 100 nanoseconds. */
|
||||||
|
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
#elif defined(__MACH__)
|
||||||
|
int janet_gettime(struct timespec *spec) {
|
||||||
|
clock_serv_t cclock;
|
||||||
|
mach_timespec_t mts;
|
||||||
|
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||||
|
clock_get_time(cclock, &mts);
|
||||||
|
mach_port_deallocate(mach_task_self(), cclock);
|
||||||
|
spec->tv_sec = mts.tv_sec;
|
||||||
|
spec->tv_nsec = mts.tv_nsec;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
int janet_gettime(struct timespec *spec) {
|
||||||
|
return clock_gettime(CLOCK_MONOTONIC, spec);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
@ -97,6 +97,13 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
|
|||||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Clock gettime */
|
||||||
|
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||||
|
#include <time.h>
|
||||||
|
#define JANET_GETTIME
|
||||||
|
int janet_gettime(struct timespec *spec);
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize builtin libraries */
|
/* Initialize builtin libraries */
|
||||||
void janet_lib_io(JanetTable *env);
|
void janet_lib_io(JanetTable *env);
|
||||||
void janet_lib_math(JanetTable *env);
|
void janet_lib_math(JanetTable *env);
|
||||||
|
@ -374,8 +374,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
&&label_JOP_GREATER_THAN_EQUAL,
|
&&label_JOP_GREATER_THAN_EQUAL,
|
||||||
&&label_JOP_LESS_THAN_EQUAL,
|
&&label_JOP_LESS_THAN_EQUAL,
|
||||||
&&label_JOP_NEXT,
|
&&label_JOP_NEXT,
|
||||||
&&label_unknown_op,
|
&&label_JOP_NOT_EQUALS,
|
||||||
&&label_unknown_op,
|
&&label_JOP_NOT_EQUALS_IMMEDIATE,
|
||||||
&&label_unknown_op,
|
&&label_unknown_op,
|
||||||
&&label_unknown_op,
|
&&label_unknown_op,
|
||||||
&&label_unknown_op,
|
&&label_unknown_op,
|
||||||
@ -788,6 +788,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
|
VM_OP(JOP_NOT_EQUALS)
|
||||||
|
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
|
||||||
|
vm_pcnext();
|
||||||
|
|
||||||
|
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||||
|
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
|
||||||
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_COMPARE)
|
VM_OP(JOP_COMPARE)
|
||||||
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
@ -1395,11 +1403,8 @@ int janet_init(void) {
|
|||||||
/* Garbage collection */
|
/* Garbage collection */
|
||||||
janet_vm_blocks = NULL;
|
janet_vm_blocks = NULL;
|
||||||
janet_vm_next_collection = 0;
|
janet_vm_next_collection = 0;
|
||||||
/* Setting memoryInterval to zero forces
|
janet_vm_gc_interval = 0x400000;
|
||||||
* a collection pretty much every cycle, which is
|
janet_vm_block_count = 0;
|
||||||
* incredibly horrible for performance, but can help ensure
|
|
||||||
* there are no memory bugs during development */
|
|
||||||
janet_vm_gc_interval = 0x10000;
|
|
||||||
janet_symcache_init();
|
janet_symcache_init();
|
||||||
/* Initialize gc roots */
|
/* Initialize gc roots */
|
||||||
janet_vm_roots = NULL;
|
janet_vm_roots = NULL;
|
||||||
|
@ -127,6 +127,12 @@ extern "C" {
|
|||||||
#define JANET_LITTLE_ENDIAN 1
|
#define JANET_LITTLE_ENDIAN 1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Limits for converting doubles to 64 bit integers */
|
||||||
|
#define JANET_INTMAX_DOUBLE 9007199254740991.0
|
||||||
|
#define JANET_INTMIN_DOUBLE (-9007199254740991.0)
|
||||||
|
#define JANET_INTMAX_INT64 9007199254740991
|
||||||
|
#define JANET_INTMIN_INT64 (-9007199254740991)
|
||||||
|
|
||||||
/* Check emscripten */
|
/* Check emscripten */
|
||||||
#ifdef __EMSCRIPTEN__
|
#ifdef __EMSCRIPTEN__
|
||||||
#define JANET_NO_DYNAMIC_MODULES
|
#define JANET_NO_DYNAMIC_MODULES
|
||||||
@ -711,7 +717,7 @@ JANET_API int janet_checkint64(Janet x);
|
|||||||
JANET_API int janet_checksize(Janet x);
|
JANET_API int janet_checksize(Janet x);
|
||||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||||
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
|
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
|
||||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||||
|
|
||||||
@ -1123,6 +1129,8 @@ enum JanetOpCode {
|
|||||||
JOP_GREATER_THAN_EQUAL,
|
JOP_GREATER_THAN_EQUAL,
|
||||||
JOP_LESS_THAN_EQUAL,
|
JOP_LESS_THAN_EQUAL,
|
||||||
JOP_NEXT,
|
JOP_NEXT,
|
||||||
|
JOP_NOT_EQUALS,
|
||||||
|
JOP_NOT_EQUALS_IMMEDIATE,
|
||||||
JOP_INSTRUCTION_COUNT
|
JOP_INSTRUCTION_COUNT
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -84,7 +84,7 @@ static void simpleline(JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Windows */
|
/* Windows */
|
||||||
#ifdef JANET_WINDOWS
|
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
||||||
|
|
||||||
void janet_line_init() {
|
void janet_line_init() {
|
||||||
;
|
;
|
||||||
|
@ -337,9 +337,9 @@
|
|||||||
## Polymorphic comparison -- Issue #272
|
## Polymorphic comparison -- Issue #272
|
||||||
|
|
||||||
# confirm polymorphic comparison delegation to primitive comparators:
|
# confirm polymorphic comparison delegation to primitive comparators:
|
||||||
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
|
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
||||||
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
|
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
||||||
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
|
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
||||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||||
@ -372,9 +372,9 @@
|
|||||||
@{:type :mynum :v 0 :compare
|
@{:type :mynum :v 0 :compare
|
||||||
(fn [self other]
|
(fn [self other]
|
||||||
(case (type other)
|
(case (type other)
|
||||||
:number (compare-primitive (self :v) other)
|
:number (cmp (self :v) other)
|
||||||
:table (when (= (get other :type) :mynum)
|
:table (when (= (get other :type) :mynum)
|
||||||
(compare-primitive (self :v) (other :v)))))})
|
(cmp (self :v) (other :v)))))})
|
||||||
|
|
||||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||||
|
@ -36,7 +36,7 @@
|
|||||||
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
||||||
~(while (not= (get DATA POS) 0)
|
~(while (not= (get DATA POS) 0)
|
||||||
,;captures)))
|
,;captures)))
|
||||||
:main (any (+ :s :loop :+ :- :> :< :.)) }))
|
:main (any (+ :s :loop :+ :- :> :< :.))}))
|
||||||
|
|
||||||
(defn bf
|
(defn bf
|
||||||
"Run brainfuck."
|
"Run brainfuck."
|
||||||
@ -325,4 +325,28 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
|||||||
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
|
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
|
||||||
(assert (= result :ok) "issue 428 2")
|
(assert (= result :ok) "issue 428 2")
|
||||||
|
|
||||||
|
# Inline 3 argument get
|
||||||
|
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
|
||||||
|
|
||||||
|
# Keyword and Symbol slice
|
||||||
|
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
|
||||||
|
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
|
||||||
|
|
||||||
|
# Peg find and find-all
|
||||||
|
(def p "/usr/local/bin/janet")
|
||||||
|
(assert (= (peg/find '"n/" p) 13) "peg find 1")
|
||||||
|
(assert (not (peg/find '"t/" p)) "peg find 2")
|
||||||
|
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
|
||||||
|
|
||||||
|
# Peg replace and replace-all
|
||||||
|
(var ti 0)
|
||||||
|
(defn check-replacer
|
||||||
|
[x y z]
|
||||||
|
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
|
||||||
|
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
|
||||||
|
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
|
||||||
|
(check-replacer "abc" "Z" "")
|
||||||
|
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||||
|
(check-replacer "aba" "" "ababababababa")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
Loading…
Reference in New Issue
Block a user