1
0
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:
Calvin Rose 2020-07-03 12:14:48 -05:00
commit a0abf307b4
29 changed files with 570 additions and 226 deletions

1
.gitattributes vendored Normal file
View File

@ -0,0 +1 @@
*.janet linguist-language=Clojure

View File

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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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