diff --git a/.gitignore b/.gitignore index 5b82c06e..a4a0cadc 100644 --- a/.gitignore +++ b/.gitignore @@ -66,6 +66,10 @@ tags vgcore.* *.out.* +# Wix artifacts +*.msi +*.wixpdb + # Created by https://www.gitignore.io/api/c ### C ### diff --git a/CHANGELOG.md b/CHANGELOG.md index f1033662..80d21e75 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,18 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? - Silence warnings in some compilers. +- Add C++ support to jpm and improve C++ interop in janet.h. +- Add `%t` formatter to `printf`, `string/format`, and other formatter functions. +- Expose `janet_cfuns_prefix` in C API. +- Add `os/proc-wait` and `os/proc-kill` for interacting with processes. +- Add `janet_getjfile` to C API. +- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`. +- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`. + When called like this, `os/execute` returns immediately. +- Add `:x` flag to os/execute to raise error when exit code is non-zero. +- Don't run `main` when flychecking. +- Add `:n` flag to `file/open` to raise an error if file cannot be opened. +- Fix import macro to not try and coerce everything to a string. - Allow passing a second argument to `disasm`. - Add `cancel`. Resumes a fiber but makes it immediately error at the yield point. - Allow multi-line paste into built in repl. diff --git a/Makefile b/Makefile index 4651165d..8c5344fc 100644 --- a/Makefile +++ b/Makefile @@ -150,7 +150,8 @@ build/janet_boot: $(JANET_BOOT_OBJECTS) # Now the reason we bootstrap in the first place build/janet.c: build/janet_boot src/boot/boot.janet - build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@ + build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@ + cksum $@ ######################## ##### Amalgamation ##### diff --git a/jpm b/jpm index 4d363831..d03844b9 100755 --- a/jpm +++ b/jpm @@ -132,6 +132,15 @@ "Convert url with potential bad characters into a file path element." (peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1))))) +(def- entry-replacer + "Convert url with potential bad characters into an entry-name" + (peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_"))))))) + +(defn entry-replace + "Escape special characters in the entry-name" + [name] + (get (peg/match entry-replacer name) 0)) + (defn filepath-replace "Remove special characters from a string or path to make it into a path segment." @@ -323,7 +332,9 @@ # (def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc"))) +(def default-cpp-compiler (or (os/getenv "CXX") (if is-win "cl.exe" "c++"))) (def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc"))) +(def default-cpp-linker (or (os/getenv "CXX") (if is-win "link.exe" "c++"))) (def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar"))) # Detect threads @@ -352,6 +363,10 @@ (if is-win ["/nologo" "/MD"] ["-std=c99" "-Wall" "-Wextra"])) +(def default-cppflags + (if is-win + ["/nologo" "/MD" "/EHsc"] + ["-std=c++11" "-Wall" "-Wextra"])) (def default-ldflags []) # Required flags for dynamic libraries. These @@ -424,29 +439,54 @@ (string "-I" (dyn :headerpath JANET_HEADERPATH)) (string "-O" (opt opts :optimize 2))]) +(defn- getcppflags + "Generate the cpp flags from the input options." + [opts] + @[;(opt opts :cppflags default-cppflags) + (string "-I" (dyn :headerpath JANET_HEADERPATH)) + (string "-O" (opt opts :optimize 2))]) + (defn- entry-name "Name of symbol that enters static compilation of a module." [name] - (string "janet_module_entry_" (filepath-replace name))) + (string "janet_module_entry_" (entry-replace name))) (defn- compile-c "Compile a C file into an object file." [opts src dest &opt static?] (def cc (opt opts :compiler default-compiler)) (def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)]) - (def entry-defines (if-let [n (opts :entry-name)] + (def entry-defines (if-let [n (and static? (opts :entry-name))] [(make-define "JANET_ENTRY_NAME" n)] [])) (def defines [;(make-defines (opt opts :defines {})) ;entry-defines]) (def headers (or (opts :headers) [])) (rule dest [src ;headers] (check-cc) - (print "compiling " dest "...") + (print "compiling " src " to " dest "...") (create-dirs dest) (if is-win (shell cc ;defines "/c" ;cflags (string "/Fo" dest) src) (shell cc "-c" src ;defines ;cflags "-o" dest)))) +(defn- compile-cpp + "Compile a C++ file into an object file." + [opts src dest &opt static?] + (def cpp (opt opts :cpp-compiler default-cpp-compiler)) + (def cflags [;(getcppflags opts) ;(if static? [] dynamic-cflags)]) + (def entry-defines (if-let [n (and static? (opts :entry-name))] + [(make-define "JANET_ENTRY_NAME" n)] + [])) + (def defines [;(make-defines (opt opts :defines {})) ;entry-defines]) + (def headers (or (opts :headers) [])) + (rule dest [src ;headers] + (check-cc) + (print "compiling " src " to " dest "...") + (create-dirs dest) + (if is-win + (shell cpp ;defines "/c" ;cflags (string "/Fo" dest) src) + (shell cpp "-c" src ;defines ;cflags "-o" dest)))) + (defn- libjanet "Find libjanet.a (or libjanet.lib on windows) at compile time" [] @@ -466,7 +506,7 @@ (string hpath `\\janet.lib`)) (defn- link-c - "Link object files together to make a native module." + "Link C object files together to make a native module." [opts target & objects] (def linker (opt opts (if is-win :linker :compiler) default-linker)) (def cflags (getcflags opts)) @@ -481,6 +521,22 @@ (shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags) (shell linker ;cflags ;ldflags `-o` target ;objects ;lflags)))) +(defn- link-cpp + "Link C++ object files together to make a native module." + [opts target & objects] + (def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)) + (def cflags (getcppflags opts)) + (def lflags [;(opt opts :lflags default-lflags) + ;(if (opts :static) [] dynamic-lflags)]) + (def ldflags [;(opt opts :ldflags [])]) + (rule target objects + (check-cc) + (print "linking " target "...") + (create-dirs target) + (if is-win + (shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags) + (shell linker ;cflags ;ldflags `-o` target ;objects ;lflags)))) + (defn- archive-c "Link object files together to make a static library." [opts target & objects] @@ -655,10 +711,12 @@ int main(int argc, const char **argv) { (table/setproto m oldproto)) # Find static modules + (var has-cpp false) (def declarations @"") (def lookup-into-invocations @"") (loop [[prefix name] :pairs prefixes] (def meta (eval-string (slurp (modpath-to-meta name)))) + (if (meta :cpp) (set has-cpp true)) (buffer/push-string lookup-into-invocations " temptab = janet_table(0);\n" " temptab->proto = env;\n" @@ -681,17 +739,33 @@ int main(int argc, const char **argv) { (create-buffer-c-impl image cimage_dest "janet_payload_image") # Append main function (spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab) + (def oimage_dest (out-path cimage_dest ".c" ".o")) # Compile and link final exectable (unless no-compile - (def cc (opt opts :compiler default-compiler)) (def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags]) (def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags]) - (def cflags [;(getcflags opts) ;janet-cflags]) (def defines (make-defines (opt opts :defines {}))) - (print "compiling and linking " dest "...") + (def cc (opt opts :compiler default-compiler)) + (def cflags [;(getcflags opts) ;janet-cflags]) + (check-cc) + (print "compiling " cimage_dest " to " oimage_dest "...") + (create-dirs oimage_dest) (if is-win - (shell cc ;cflags ;ldflags cimage_dest ;lflags `/link` (string "/OUT:" dest)) - (shell cc ;cflags ;ldflags `-o` dest cimage_dest ;lflags))))) + (shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest) + (shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest)) + (if has-cpp + (let [linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker) + cppflags [;(getcppflags opts) ;janet-cflags]] + (print "linking " dest "...") + (if is-win + (shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags) + (shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags))) + (let [linker (opt opts (if is-win :linker :compiler) default-linker)] + (print "linking " dest "...") + (create-dirs dest) + (if is-win + (shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags) + (shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags))))))) # # Installation and Dependencies @@ -853,9 +927,23 @@ int main(int argc, const char **argv) { # Make dynamic module (def lname (string "build" sep name modext)) - (loop [src :in sources] - (compile-c opts src (out-path src ".c" objext))) - (def objects (map (fn [path] (out-path path ".c" objext)) sources)) + + # Get objects to build with + (var has-cpp false) + (def objects + (seq [src :in sources] + (cond + (string/has-suffix? ".cpp" src) + (let [op (out-path src ".cpp" objext)] + (compile-cpp opts src op) + (set has-cpp true) + op) + (string/has-suffix? ".c" src) + (let [op (out-path src ".c" objext)] + (compile-c opts src op) + op) + (errorf "unknown source file type: %s, expected .c or .cpp")))) + (when-let [embedded (opts :embedded)] (loop [src :in embedded] (def c-src (out-path src ".janet" ".janet.c")) @@ -863,7 +951,7 @@ int main(int argc, const char **argv) { (array/push objects o-src) (create-buffer-c src c-src (embed-name src)) (compile-c opts c-src o-src))) - (link-c opts lname ;objects) + ((if has-cpp link-cpp link-c) opts lname ;objects) (add-dep "build" lname) (install-rule lname path) @@ -876,6 +964,7 @@ int main(int argc, const char **argv) { "# Metadata for static library %s\n\n%.20p" (string name statext) {:static-entry ename + :cpp has-cpp :ldflags ~',(opts :ldflags) :lflags ~',(opts :lflags)}))) (add-dep "build" metaname) @@ -887,9 +976,21 @@ int main(int argc, const char **argv) { (def opts (merge @{:entry-name ename} opts)) (def sobjext (string ".static" objext)) (def sjobjext (string ".janet" sobjext)) - (loop [src :in sources] - (compile-c opts src (out-path src ".c" sobjext) true)) - (def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources)) + + # Get static objects + (def sobjects + (seq [src :in sources] + (cond + (string/has-suffix? ".cpp" src) + (let [op (out-path src ".cpp" sobjext)] + (compile-cpp opts src op true) + op) + (string/has-suffix? ".c" src) + (let [op (out-path src ".c" sobjext)] + (compile-c opts src op true) + op) + (errorf "unknown source file type: %s, expected .c or .cpp")))) + (when-let [embedded (opts :embedded)] (loop [src :in embedded] (def c-src (out-path src ".janet" ".janet.c")) @@ -1139,7 +1240,8 @@ Keys are: --binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH. --libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH. --compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows). - --archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows). + --cpp-compiler : C++ compiler to use for natives. Defaults to $CXX or c++ (cl.exe on windows). + --archiver : C archiver to use for static libraries. Defaults to $AR ar (lib.exe on windows). --linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on other platforms. --pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git diff --git a/jpm.1 b/jpm.1 index a20bd168..53204195 100644 --- a/jpm.1 +++ b/jpm.1 @@ -71,9 +71,13 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more. .TP .BR \-\-compiler=$CC -Sets the compiler used for compiling native modules and standalone executables. Defaults +Sets the C compiler used for compiling native modules and standalone executables. Defaults to cc. +.BR \-\-cpp\-compiler=$CXX +Sets the C++ compiler used for compiling native modules and standalone executables. Defaults +to c++.. + .TP .BR \-\-linker Sets the linker used to create native modules and executables. Only used on windows, where diff --git a/src/boot/boot.janet b/src/boot/boot.janet index df20a06a..950e1436 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -7,6 +7,8 @@ ### ### +(def root-env "The root environment used to create environments with (make-env)" _env) + (def defn :macro "(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))." (fn defn [name & more] @@ -81,10 +83,6 @@ (defn nan? "Check if x is NaN" [x] (not= x x)) (defn even? "Check if x is even." [x] (= 0 (mod x 2))) (defn odd? "Check if x is odd." [x] (= 1 (mod x 2))) -(defn zero? "Check if x is zero." [x] (= x 0)) -(defn pos? "Check if x is greater than 0." [x] (> x 0)) -(defn neg? "Check if x is less than 0." [x] (< x 0)) -(defn one? "Check if x is equal to 1." [x] (= x 1)) (defn number? "Check if x is a number." [x] (= (type x) :number)) (defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber)) (defn string? "Check if x is a string." [x] (= (type x) :string)) @@ -567,15 +565,6 @@ [head & body] (loop1 body head 0)) -(put _env 'loop1 nil) -(put _env 'check-indexed nil) -(put _env 'for-template nil) -(put _env 'for-var-template nil) -(put _env 'iterate-template nil) -(put _env 'each-template nil) -(put _env 'range-template nil) -(put _env 'loop-fiber-template nil) - (defmacro seq "Similar to loop, but accumulates the loop body into an array and returns that. See loop for details." @@ -594,6 +583,16 @@ [& body] (tuple fiber/new (tuple 'fn '[] ;body) :yi)) +(defmacro- undef + "Remove binding from root-env" + [& syms] + ~(do ,;(seq [s :in syms] ~(put root-env ',s nil)))) + +(undef _env) + +(undef loop1 check-indexed for-template for-var-template iterate-template + each-template range-template loop-fiber-template) + (defn sum "Returns the sum of xs. If xs is empty, returns 0." [xs] @@ -619,7 +618,7 @@ the fal form. Bindings have the same syntax as the let macro." [bindings tru &opt fal] (def len (length bindings)) - (if (zero? len) (error "expected at least 1 binding")) + (if (= 0 len) (error "expected at least 1 binding")) (if (odd? len) (error "expected an even number of bindings")) (defn aux [i] (if (>= i len) @@ -749,7 +748,12 @@ [& xs] (compare-reduce >= xs)) -(put _env 'compare-reduce nil) +(defn zero? "Check if x is zero." [x] (= (compare x 0) 0)) +(defn pos? "Check if x is greater than 0." [x] (= (compare x 0) 1)) +(defn neg? "Check if x is less than 0." [x] (= (compare x 0) -1)) +(defn one? "Check if x is equal to 1." [x] (= (compare x 1) 0)) + +(undef compare-reduce) ### ### @@ -785,8 +789,8 @@ [a &opt by] (sort-help a 0 (- (length a) 1) (or by <))) -(put _env 'sort-part nil) -(put _env 'sort-help nil) +(undef sort-part) +(undef sort-help) (defn sort-by "Returns a new sorted array that compares elements by invoking @@ -1140,8 +1144,8 @@ :tuple (tuple/slice (walk-ind f form)) form)) -(put _env 'walk-ind nil) -(put _env 'walk-dict nil) +(undef walk-ind) +(undef walk-dict) (defn postwalk "Do a post-order traversal of a data structure and call (f x) @@ -1350,7 +1354,7 @@ [tab & colls] (loop [c :in colls key :keys c] - (set (tab key) (in c key))) + (put tab key (in c key))) tab) (defn merge @@ -1361,7 +1365,7 @@ (def container @{}) (loop [c :in colls key :keys c] - (set (container key) (in c key))) + (put container key (in c key))) container) (defn keys @@ -1615,9 +1619,9 @@ ,(aux (+ 2 i)) ,$res)))) 0))) -(put _env 'sentinel nil) -(put _env 'match-1 nil) -(put _env 'with-idemp nil) +(undef sentinel) +(undef match-1) +(undef with-idemp) ### ### @@ -1742,8 +1746,8 @@ [&opt sym] ~(,doc* ',sym)) -(put _env 'env-walk nil) -(put _env 'print-index nil) +(undef env-walk) +(undef print-index) ### ### @@ -1877,7 +1881,7 @@ (case tx :tuple (or (not= (length x) (length y)) (some identity (map deep-not= x y))) :array (or (not= (length x) (length y)) (some identity (map deep-not= x y))) - :struct (deep-not= (pairs x) (pairs y)) + :struct (deep-not= (kvs x) (kvs y)) :table (deep-not= (table/to-struct x) (table/to-struct y)) :buffer (not= (string x) (string y)) (not= x y)))) @@ -2032,7 +2036,7 @@ will inherit bindings from the parent environment, but new bindings will not pollute the parent environment." [&opt parent] - (def parent (if parent parent _env)) + (def parent (if parent parent root-env)) (def newenv (table/setproto @{} parent)) newenv) @@ -2248,10 +2252,11 @@ by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)." @{}) -(def comptime +(defmacro comptime "(comptime x)\n\n Evals x at compile time and returns the result. Similar to a top level unquote." - :macro eval) + [x] + (eval x)) (defn make-image "Create an image from an environment returned by require. @@ -2305,7 +2310,7 @@ (module/add-paths ".jimage" :image) # Version of fexists that works even with a reduced OS -(if-let [has-stat (_env 'os/stat)] +(if-let [has-stat (root-env 'os/stat)] (let [stat (has-stat :value)] (defglobal "fexists" (fn fexists [path] (= :file (stat path :mode))))) (defglobal "fexists" @@ -2352,10 +2357,10 @@ str-parts (interpose "\n " paths)] [nil (string "could not find module " path ":\n " ;str-parts)]))) -(put _env 'fexists nil) -(put _env 'mod-filter nil) -(put _env 'check-. nil) -(put _env 'not-check-. nil) +(undef fexists) +(undef mod-filter) +(undef check-.) +(undef not-check-.) (def module/cache "Table mapping loaded module identifiers to their environments." @@ -2463,7 +2468,7 @@ (def newv (table/setproto @{:private (not ep)} v)) (put env (symbol prefix k) newv))) -(put _env 'require-1 nil) +(undef require-1) (defmacro import "Import a module. First requires the module, and then merges its @@ -2530,7 +2535,7 @@ (in (.slots frame-idx) (or nth 0))) # Conditional compilation for disasm -(def disasm-alias (if-let [x (_env 'disasm)] (x :value))) +(def disasm-alias (if-let [x (root-env 'disasm)] (x :value))) (defn .disasm "Gets the assembly for the current function." @@ -2592,13 +2597,9 @@ (debug/unfbreak fun i)) (print "Cleared " (length bytecode) " breakpoints in " fun)) -(unless (get _env 'disasm) - (put _env '.disasm nil) - (put _env '.bytecode nil) - (put _env '.breakall nil) - (put _env '.clearall nil) - (put _env '.ppasm nil)) -(put _env 'disasm-alias nil) +(unless (get root-env 'disasm) + (undef .disasm .bytecode .breakall .clearall .ppasm)) +(undef disasm-alias) (defn .source "Show the source code for the function being debugged." @@ -2652,9 +2653,9 @@ "An environment that contains dot prefixed functions for debugging." @{}) -(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env))) -(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil)) -(put _env 'debugger-keys nil) +(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env))) +(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil)) +(undef debugger-keys) ### ### @@ -2750,7 +2751,7 @@ (each a args (import* (string a) :prefix "" :evaluator evaluator))) # conditional compilation for reduced os -(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&]))) +(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&]))) (defn cli-main "Entrance for the Janet CLI tool. Call this functions with the command line @@ -2859,9 +2860,10 @@ (def subargs (array/slice args i)) (put env :args subargs) (dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env) - (if-let [main (get (in env 'main) :value)] - (let [thunk (compile [main ;(tuple/slice args i)] env arg)] - (if (function? thunk) (thunk) (error (thunk :error))))) + (unless *compile-only* + (if-let [main (get (in env 'main) :value)] + (let [thunk (compile [main ;(tuple/slice args i)] env arg)] + (if (function? thunk) (thunk) (error (thunk :error)))))) (set i lenargs)))) (when (and (not *compile-only*) (or *should-repl* *no-file*)) @@ -2884,12 +2886,7 @@ (setdyn :err-color (if *colorize* true)) (repl getchunk nil env))) -(put _env 'no-side-effects nil) -(put _env 'is-safe-def nil) -(put _env 'safe-forms nil) -(put _env 'importers nil) -(put _env 'use-2 nil) -(put _env 'getenv-alias nil) +(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias) ### ### @@ -2897,12 +2894,13 @@ ### ### -(def root-env "The root environment used to create environments with (make-env)" _env) - (do - (put _env 'boot/opts nil) - (put _env '_env nil) - (def load-dict (env-lookup _env)) + (undef boot/opts undef) + (def load-dict (env-lookup root-env)) + (put load-dict 'boot/config nil) + (put load-dict 'boot/args nil) + (each [k v] (pairs load-dict) + (if (number? v) (put load-dict k nil))) (merge-into load-image-dict load-dict) (merge-into make-image-dict (invert load-dict))) @@ -2923,25 +2921,29 @@ (put into k (x k)))) into) - (def env (fiber/getenv (fiber/current))) - # Modify env based on some options. - (loop [[k v] :pairs env + (loop [[k v] :pairs root-env :when (symbol? k)] (def flat (proto-flatten @{} v)) (when (boot/config :no-docstrings) (put flat :doc nil)) (when (boot/config :no-sourcemaps) (put flat :source-map nil)) - (put env k flat)) + (put root-env k flat)) - (put env 'boot/config nil) - (put env 'boot/args nil) - (def image (let [env-pairs (pairs (env-lookup env)) + (put root-env 'boot/config nil) + (put root-env 'boot/args nil) + + (def image (let [env-pairs (pairs (env-lookup root-env)) essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs) lookup (table ;(mapcat identity essential-pairs)) reverse-lookup (invert lookup)] - (marshal env reverse-lookup))) + # Check no duplicate values + (def temp @{}) + (eachp [k v] lookup + (if (in temp v) (errorf "duplicate value: %v" v)) + (put temp v k)) + (marshal root-env reverse-lookup))) # Create amalgamation diff --git a/src/boot/system_test.c b/src/boot/system_test.c index f3e9af78..99165716 100644 --- a/src/boot/system_test.c +++ b/src/boot/system_test.c @@ -23,6 +23,7 @@ #include #include #include +#include #include "tests.h" @@ -44,6 +45,11 @@ int system_test() { assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN))); assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4))); assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265))); +#ifdef NAN + assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER)); +#else + assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER)); +#endif assert(NULL != &janet_wrap_nil); diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index a4d8f40f..29ece3d3 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -70,6 +70,7 @@ /* #define JANET_STACK_MAX 16384 */ /* #define JANET_OS_NAME my-custom-os */ /* #define JANET_ARCH_NAME pdp-8 */ +/* #define JANET_EV_EPOLL */ /* Main client settings, does not affect library code */ /* #define JANET_SIMPLE_GETLINE */ diff --git a/src/core/corelib.c b/src/core/corelib.c index 1bbace73..f1c6c0d2 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -1221,7 +1221,7 @@ JanetTable *janet_core_env(JanetTable *replacements) { } /* Load core cfunctions (and some built in janet assembly functions) */ - JanetTable *dict = janet_table(300); + JanetTable *dict = janet_table(512); janet_load_libs(dict); /* Add replacements */ diff --git a/src/core/ev.c b/src/core/ev.c index 61e9237c..0ed4d378 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -237,6 +237,7 @@ static JanetListenerState *janet_listen_impl(JanetPollable *pollable, JanetListe mask |= JANET_ASYNC_LISTEN_SPAWNER; state->pollable = pollable; state->_mask = mask; + state->_index = 0; pollable->_mask |= mask; janet_vm_active_listeners++; /* Prepend to linked list */ @@ -617,7 +618,7 @@ void janet_loop(void) { } } -#ifdef JANET_LINUX +#ifdef JANET_EV_EPOLL /* * Start linux/epoll implementation @@ -683,7 +684,6 @@ static void janet_unlisten(JanetListenerState *state) { janet_unlisten_impl(state); } -/* Replace janet_loop with this */ #define JANET_EPOLL_MAX_EVENTS 64 void janet_loop1_impl(void) { /* Set timer */ @@ -771,10 +771,148 @@ void janet_ev_deinit(void) { #else +#include + +/* Poll implementation */ + +static JanetTimestamp ts_now(void) { + struct timespec now; + janet_assert(-1 != clock_gettime(CLOCK_REALTIME, &now), "failed to get time"); + uint64_t res = 1000 * now.tv_sec; + res += now.tv_nsec / 1000000; + return res; +} + +/* Epoll global data */ +JANET_THREAD_LOCAL struct pollfd *janet_vm_fds = NULL; +JANET_THREAD_LOCAL JanetListenerState **janet_vm_listener_map = NULL; +JANET_THREAD_LOCAL size_t janet_vm_fdcap = 0; +JANET_THREAD_LOCAL size_t janet_vm_fdcount = 0; + +static int make_poll_events(int mask) { + int events = 0; + if (mask & JANET_ASYNC_LISTEN_READ) + events |= POLLIN; + if (mask & JANET_ASYNC_LISTEN_WRITE) + events |= POLLOUT; + return events; +} + +static void janet_push_pollfd(struct pollfd pfd) { + if (janet_vm_fdcap == janet_vm_fdcount) { + size_t newcap = janet_vm_fdcount ? janet_vm_fdcount * 2 : 16; + janet_vm_fds = realloc(janet_vm_fds, newcap * sizeof(struct pollfd)); + if (NULL == janet_vm_fds) { + JANET_OUT_OF_MEMORY; + } + janet_vm_listener_map = realloc(janet_vm_listener_map, newcap * sizeof(JanetListenerState *)); + if (NULL == janet_vm_listener_map) { + JANET_OUT_OF_MEMORY; + } + janet_vm_fdcap = newcap; + } + janet_vm_fds[janet_vm_fdcount++] = pfd; +} + +/* Wait for the next event */ +JanetListenerState *janet_listen(JanetPollable *pollable, JanetListener behavior, int mask, size_t size) { + JanetListenerState *state = janet_listen_impl(pollable, behavior, mask, size); + struct pollfd ev; + ev.fd = pollable->handle; + ev.events = make_poll_events(state->pollable->_mask); + ev.revents = 0; + state->_index = janet_vm_fdcount; + janet_push_pollfd(ev); + janet_vm_listener_map[state->_index] = state; + return state; +} + +/* Tell system we are done listening for a certain event */ +static void janet_unlisten(JanetListenerState *state) { + janet_vm_fds[state->_index] = janet_vm_fds[--janet_vm_fdcount]; + JanetListenerState *replacer = janet_vm_listener_map[janet_vm_fdcount]; + janet_vm_listener_map[state->_index] = replacer; + /* Update pointers in replacer */ + replacer->_index = state->_index; + /* Destroy state machine and free memory */ + janet_unlisten_impl(state); +} + +void janet_loop1_impl(void) { + /* Set timer */ + JanetTimeout to; + memset(&to, 0, sizeof(to)); + int has_timeout = peek_timeout(&to); + + /* Poll for events */ + int ready; + do { + if (has_timeout) { + int64_t diff = to.when - ts_now(); + ready = poll(janet_vm_fds, janet_vm_fdcount, diff < 0 ? 0 : (int) diff); + } else { + ready = poll(janet_vm_fds, janet_vm_fdcount, -1); + } + } while (ready == -1 && errno == EINTR); + if (ready == -1) { + JANET_EXIT("failed to poll events"); + } + + /* Step state machines */ + int did_handle_something = 0; + for (size_t i = 0; i < janet_vm_fdcount; i++) { + struct pollfd *pfd = janet_vm_fds + i; + did_handle_something |= pfd->revents; + /* Skip fds where nothing interesting happened */ + if (!(pfd->revents & (pfd->events | POLLHUP | POLLERR | POLLNVAL))) continue; + JanetListenerState *state = janet_vm_listener_map[i]; + /* Normal event */ + int mask = janet_vm_fds[i].revents; + JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE; + JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE; + if (mask & POLLOUT) + status1 = state->machine(state, JANET_ASYNC_EVENT_WRITE); + if (mask & POLLIN) + status2 = state->machine(state, JANET_ASYNC_EVENT_READ); + if (status1 == JANET_ASYNC_STATUS_DONE || status2 == JANET_ASYNC_STATUS_DONE) + janet_unlisten(state); + } + + /* If nothing was handled and poll returned, then we know that it timedout and we should trigger + * one of our timers. */ + if (!did_handle_something) { + /* Timer event */ + pop_timeout(0); + /* Cancel waiters for this fiber */ + if (to.is_error) { + janet_cancel(to.fiber, janet_cstringv("timeout")); + } else { + janet_schedule(to.fiber, janet_wrap_nil()); + } + } +} + +void janet_ev_init(void) { + janet_ev_init_common(); + janet_vm_fds = NULL; + janet_vm_listener_map = NULL; + janet_vm_fdcap = 0; + janet_vm_fdcount = 0; + return; +} + +void janet_ev_deinit(void) { + janet_ev_deinit_common(); + free(janet_vm_fds); + free(janet_vm_listener_map); + janet_vm_fds = NULL; + janet_vm_listener_map = NULL; + janet_vm_fdcap = 0; + janet_vm_fdcount = 0; +} #endif - /* C functions */ static Janet cfun_ev_go(int32_t argc, Janet *argv) { diff --git a/src/core/io.c b/src/core/io.c index 0630a437..d057ccad 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -56,8 +56,8 @@ static int32_t checkflags(const uint8_t *str) { int32_t flags = 0; int32_t i; int32_t len = janet_string_length(str); - if (!len || len > 3) - janet_panic("file mode must have a length between 1 and 3"); + if (!len || len > 10) + janet_panic("file mode must have a length between 1 and 10"); switch (*str) { default: janet_panicf("invalid flag %c, expected w, a, or r", *str); @@ -75,7 +75,7 @@ static int32_t checkflags(const uint8_t *str) { for (i = 1; i < len; i++) { switch (str[i]) { default: - janet_panicf("invalid flag %c, expected + or b", str[i]); + janet_panicf("invalid flag %c, expected +, b, or n", str[i]); break; case '+': if (flags & JANET_FILE_UPDATE) return -1; @@ -85,6 +85,10 @@ static int32_t checkflags(const uint8_t *str) { if (flags & JANET_FILE_BINARY) return -1; flags |= JANET_FILE_BINARY; break; + case 'n': + if (flags & JANET_FILE_NONIL) return -1; + flags |= JANET_FILE_NONIL; + break; } } return flags; @@ -112,11 +116,11 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) { int32_t flags; if (argc == 2) { fmode = janet_getkeyword(argv, 1); - if (janet_string_length(fmode) != 1 || - !(fmode[0] == 'r' || fmode[0] == 'w')) { - janet_panicf("invalid file mode :%S, expected :r or :w", fmode); + flags = JANET_FILE_PIPED | checkflags(fmode); + if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) { + janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode); } - flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE); + fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w"); } else { fmode = (const uint8_t *)"r"; flags = JANET_FILE_PIPED | JANET_FILE_READ; @@ -126,6 +130,8 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) { #endif FILE *f = popen((const char *)fname, (const char *)fmode); if (!f) { + if (flags & JANET_FILE_NONIL) + janet_panicf("failed to popen %s: %s", fname, strerror(errno)); return janet_wrap_nil(); } return janet_makefile(f, flags); @@ -155,7 +161,9 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) { flags = JANET_FILE_READ; } FILE *f = fopen((const char *)fname, (const char *)fmode); - return f ? janet_makefile(f, flags) : janet_wrap_nil(); + return f ? janet_makefile(f, flags) + : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil()) + : janet_wrap_nil(); } /* Read up to n bytes into buffer. */ @@ -720,7 +728,8 @@ static const JanetReg io_cfuns[] = { "\tw - allow writing to the file\n" "\ta - append to the file\n" "\tb - open the file in binary mode (rather than text mode)\n" - "\t+ - append to the file instead of overwriting it") + "\t+ - append to the file instead of overwriting it\n" + "\tn - error if the file cannot be opened instead of returning nil") }, { "file/close", cfun_io_fclose, @@ -780,6 +789,10 @@ static const JanetReg io_cfuns[] = { /* C API */ +JanetFile *janet_getjfile(const Janet *argv, int32_t n) { + return janet_getabstract(argv, n, &janet_file_type); +} + FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) { JanetFile *iof = janet_getabstract(argv, n, &janet_file_type); if (NULL != flags) *flags = iof->flags; @@ -804,17 +817,18 @@ FILE *janet_unwrapfile(Janet j, int *flags) { void janet_lib_io(JanetTable *env) { janet_core_cfuns(env, NULL, io_cfuns); janet_register_abstract_type(&janet_file_type); + int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE; /* stdout */ janet_core_def(env, "stdout", - janet_makefile(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE), + janet_makefile(stdout, JANET_FILE_APPEND | default_flags), JDOC("The standard output file.")); /* stderr */ janet_core_def(env, "stderr", - janet_makefile(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE), + janet_makefile(stderr, JANET_FILE_APPEND | default_flags), JDOC("The standard error file.")); /* stdin */ janet_core_def(env, "stdin", - janet_makefile(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE), + janet_makefile(stdin, JANET_FILE_READ | default_flags), JDOC("The standard input file.")); } diff --git a/src/core/os.c b/src/core/os.c index fc90ba7b..f26115a5 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -24,6 +24,7 @@ #include "features.h" #include #include "util.h" +#include "gc.h" #endif #ifndef JANET_REDUCED_OS @@ -36,6 +37,7 @@ #include #include #include +#include #ifdef JANET_APPLE #include @@ -312,13 +314,149 @@ static JanetBuffer *os_exec_escape(JanetView args) { } #endif -static Janet os_execute(int32_t argc, Janet *argv) { +/* Process type for when running a subprocess and not immediately waiting */ +static const JanetAbstractType ProcAT; +#define JANET_PROC_CLOSED 1 +#define JANET_PROC_WAITED 2 +typedef struct { + int flags; +#ifdef JANET_WINDOWS + HANDLE pHandle; + HANDLE tHandle; +#else + int pid; +#endif + int return_code; + JanetFile *in; + JanetFile *out; + JanetFile *err; +} JanetProc; + +static int janet_proc_gc(void *p, size_t s) { + (void) s; + JanetProc *proc = (JanetProc *) p; +#ifdef JANET_WINDOWS + if (!(proc->flags & JANET_PROC_CLOSED)) { + CloseHandle(proc->pHandle); + CloseHandle(proc->tHandle); + } +#else + if (!(proc->flags & JANET_PROC_WAITED)) { + /* Kill and wait to prevent zombies */ + kill(proc->pid, SIGKILL); + int status; + waitpid(proc->pid, &status, 0); + } +#endif + return 0; +} + +static int janet_proc_mark(void *p, size_t s) { + (void) s; + JanetProc *proc = (JanetProc *)p; + if (NULL != proc->in) janet_mark(janet_wrap_abstract(proc->in)); + if (NULL != proc->out) janet_mark(janet_wrap_abstract(proc->out)); + if (NULL != proc->err) janet_mark(janet_wrap_abstract(proc->err)); + return 0; +} + +static Janet os_proc_wait_impl(JanetProc *proc) { + if (proc->flags & JANET_PROC_WAITED) { + janet_panicf("cannot wait on process that has already finished"); + } + proc->flags |= JANET_PROC_WAITED; + int status = 0; +#ifdef JANET_WINDOWS + WaitForSingleObject(proc->pHandle, INFINITE); + GetExitCodeProcess(proc->pHandle, &status); + if (!(proc->flags & JANET_PROC_CLOSED)) { + proc->flags |= JANET_PROC_CLOSED; + CloseHandle(proc->pHandle); + CloseHandle(proc->tHandle); + } +#else + waitpid(proc->pid, &status, 0); +#endif + proc->return_code = (int32_t) status; + return janet_wrap_integer(proc->return_code); +} + +static Janet os_proc_wait(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetProc *proc = janet_getabstract(argv, 0, &ProcAT); + return os_proc_wait_impl(proc); +} + +static Janet os_proc_kill(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 2); + JanetProc *proc = janet_getabstract(argv, 0, &ProcAT); + if (proc->flags & JANET_PROC_WAITED) { + janet_panicf("cannot kill process that has already finished"); + } +#ifdef JANET_WINDOWS + if (proc->flags & JANET_PROC_CLOSED) { + janet_panicf("cannot close process handle that is already closed"); + } + proc->flags |= JANET_PROC_CLOSED; + CloseHandle(proc->pHandle); + CloseHandle(proc->tHandle); +#else + int status = kill(proc->pid, SIGKILL); + if (status) { + janet_panic(strerror(errno)); + } +#endif + /* After killing process we wait on it. */ + if (argc > 1 && janet_truthy(argv[1])) { + return os_proc_wait_impl(proc); + } else { + return argv[0]; + } +} + +static const JanetMethod proc_methods[] = { + {"wait", os_proc_wait}, + {"kill", os_proc_kill}, + {NULL, NULL} +}; + +static int janet_proc_get(void *p, Janet key, Janet *out) { + JanetProc *proc = (JanetProc *)p; + if (janet_keyeq(key, "in")) { + *out = (NULL == proc->in) ? janet_wrap_nil() : janet_wrap_abstract(proc->in); + return 1; + } + if (janet_keyeq(key, "out")) { + *out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->out); + return 1; + } + if (janet_keyeq(key, "err")) { + *out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err); + return 1; + } + if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) { + *out = janet_wrap_integer(proc->return_code); + return 1; + } + if (!janet_checktype(key, JANET_KEYWORD)) return 0; + return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out); +} + +static const JanetAbstractType ProcAT = { + "core/process", + janet_proc_gc, + janet_proc_mark, + janet_proc_get, + JANET_ATEND_GET +}; + +static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) { janet_arity(argc, 1, 3); /* Get flags */ uint64_t flags = 0; if (argc > 1) { - flags = janet_getflags(argv, 1, "ep"); + flags = janet_getflags(argv, 1, "epx"); } /* Get environment */ @@ -330,43 +468,76 @@ static Janet os_execute(int32_t argc, Janet *argv) { janet_panic("expected at least 1 command line argument"); } + /* Optional stdio redirections */ + JanetFile *new_in = NULL, *new_out = NULL, *new_err = NULL; + + /* Get optional redirections */ + if (argc > 2) { + JanetDictView tab = janet_getdictionary(argv, 2); + Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in")); + Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out")); + Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err")); + if (!janet_checktype(maybe_stdin, JANET_NIL)) new_in = janet_getjfile(&maybe_stdin, 0); + if (!janet_checktype(maybe_stdout, JANET_NIL)) new_out = janet_getjfile(&maybe_stdout, 0); + if (!janet_checktype(maybe_stderr, JANET_NIL)) new_err = janet_getjfile(&maybe_stderr, 0); + } + /* Result */ int status = 0; #ifdef JANET_WINDOWS + HANDLE pHandle, tHandle; + PROCESS_INFORMATION processInfo; + STARTUPINFO startupInfo; + memset(&processInfo, 0, sizeof(processInfo)); + memset(&startupInfo, 0, sizeof(startupInfo)); + startupInfo.cb = sizeof(startupInfo); + startupInfo.dwFlags |= STARTF_USESTDHANDLES; + JanetBuffer *buf = os_exec_escape(exargs); if (buf->count > 8191) { janet_panic("command line string too long (max 8191 characters)"); } const char *path = (const char *) janet_unwrap_string(exargs.items[0]); - char *cargv[2] = {(char *) buf->data, NULL}; + + /* Do IO redirection */ + startupInfo.hStdInput = (HANDLE) _get_osfhandle((new_in == NULL) ? 0 : _fileno(new_in->file)); + startupInfo.hStdOutput = (HANDLE) _get_osfhandle((new_out == NULL) ? 1 : _fileno(new_out->file)); + startupInfo.hStdError = (HANDLE) _get_osfhandle((new_err == NULL) ? 2 : _fileno(new_err->file)); /* Use _spawn family of functions. */ /* Windows docs say do this before any spawns. */ _flushall(); - /* Use an empty env instead when envp is NULL to be consistent with other implementation. */ - char *empty_env[1] = {NULL}; - char **envp1 = (NULL == envp) ? empty_env : envp; - - if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) { - status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1); - } else if (janet_flag_at(flags, 1)) { - status = (int) _spawnvp(_P_WAIT, path, cargv); - } else if (janet_flag_at(flags, 0)) { - status = (int) _spawnve(_P_WAIT, path, cargv, envp1); - } else { - status = (int) _spawnv(_P_WAIT, path, cargv); + /* TODO - redirection, :p flag */ + if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path, /* NULL? */ + (char *) buf->data, /* Single CLI argument */ + NULL, /* no proc inheritance */ + NULL, /* no thread inheritance */ + TRUE, /* handle inheritance */ + 0, /* flags */ + envp, /* pass in environment */ + NULL, /* use parents starting directory */ + &startupInfo, + &processInfo)) { + janet_panic("failed to create process"); } + + pHandle = processInfo.hProcess; + tHandle = processInfo.hThread; + os_execute_cleanup(envp, NULL); - /* Check error */ - if (-1 == status) { - janet_panicf("%p: %s", argv[0], strerror(errno)); + /* Wait and cleanup immedaitely */ + if (!is_async) { + DWORD code; + WaitForSingleObject(pHandle, INFINITE); + GetExitCodeProcess(pHandle, &code); + status = (int) code; + CloseHandle(pHandle); + CloseHandle(tHandle); } - - return janet_wrap_integer(status); #else const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1)); @@ -385,17 +556,32 @@ static Janet os_execute(int32_t argc, Janet *argv) { janet_lock_environ(); } + /* Posix spawn setup */ + posix_spawn_file_actions_t actions; + posix_spawn_file_actions_init(&actions); + if (new_in != NULL) { + posix_spawn_file_actions_adddup2(&actions, fileno(new_in->file), 0); + } + if (new_out != NULL) { + posix_spawn_file_actions_adddup2(&actions, fileno(new_out->file), 1); + } + if (new_err != NULL) { + posix_spawn_file_actions_adddup2(&actions, fileno(new_err->file), 2); + } + pid_t pid; if (janet_flag_at(flags, 1)) { status = posix_spawnp(&pid, - child_argv[0], NULL, NULL, cargv, + child_argv[0], &actions, NULL, cargv, use_environ ? environ : envp); } else { status = posix_spawn(&pid, - child_argv[0], NULL, NULL, cargv, + child_argv[0], &actions, NULL, cargv, use_environ ? environ : envp); } + posix_spawn_file_actions_destroy(&actions); + if (use_environ) { janet_unlock_environ(); } @@ -404,22 +590,51 @@ static Janet os_execute(int32_t argc, Janet *argv) { if (status) { os_execute_cleanup(envp, child_argv); janet_panicf("%p: %s", argv[0], strerror(errno)); + } else if (is_async) { + /* Get process handle */ + os_execute_cleanup(envp, child_argv); } else { + /* Wait to complete */ waitpid(pid, &status, 0); + os_execute_cleanup(envp, child_argv); + /* Use POSIX shell semantics for interpreting signals */ + if (WIFEXITED(status)) { + status = WEXITSTATUS(status); + } else if (WIFSTOPPED(status)) { + status = WSTOPSIG(status) + 128; + } else { + status = WTERMSIG(status) + 128; + } } - os_execute_cleanup(envp, child_argv); - /* Use POSIX shell semantics for interpreting signals */ - int ret; - if (WIFEXITED(status)) { - ret = WEXITSTATUS(status); - } else if (WIFSTOPPED(status)) { - ret = WSTOPSIG(status) + 128; - } else { - ret = WTERMSIG(status) + 128; - } - return janet_wrap_integer(ret); #endif + if (is_async) { + JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc)); + proc->return_code = -1; +#ifdef JANET_WINDOWS + proc->pHandle = pHandle; + proc->tHandle = tHandle; +#else + proc->pid = pid; +#endif + proc->in = new_in; + proc->out = new_out; + proc->err = new_err; + proc->flags = 0; + return janet_wrap_abstract(proc); + } else if (janet_flag_at(flags, 2) && status) { + janet_panicf("command failed with non-zero exit code %d", status); + } else { + return janet_wrap_integer(status); + } +} + +static Janet os_execute(int32_t argc, Janet *argv) { + return os_execute_impl(argc, argv, 0); +} + +static Janet os_spawn(int32_t argc, Janet *argv) { + return os_execute_impl(argc, argv, 1); } static Janet os_shell(int32_t argc, Janet *argv) { @@ -1334,10 +1549,19 @@ static const JanetReg os_cfuns[] = { "\t:e - enables passing an environment to the program. Without :e, the " "current environment is inherited.\n" "\t:p - allows searching the current PATH for the binary to execute. " - "Without this flag, binaries must use absolute paths.\n\n" - "env is a table or struct mapping environment variables to values. " + "Without this flag, binaries must use absolute paths.\n" + "\t:x - raise error if exit code is non-zero.\n" + "env is a table or struct mapping environment variables to values. It can also " + "contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. " + "These arguments should be core/file values. " "Returns the exit status of the program.") }, + { + "os/spawn", os_spawn, + JDOC("(os/spawn args &opts flags env)\n\n" + "Execute a program on the system and return a handle to the process. Otherwise, the " + "same arguments as os/execute. Does not wait for the process.") + }, { "os/shell", os_shell, JDOC("(os/shell str)\n\n" @@ -1428,6 +1652,18 @@ static const JanetReg os_cfuns[] = { JDOC("(os/perm-int bytes)\n\n" "Parse a 9 character permission string and return an integer that can be used by chmod.") }, + { + "os/proc-wait", os_proc_wait, + JDOC("(os/proc-wait proc)\n\n" + "Block until the subprocess completes. Returns the subprocess return code.") + }, + { + "os/proc-kill", os_proc_kill, + JDOC("(os/proc-kill proc &opt wait)\n\n" + "Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process " + "handle on windows. If wait is truthy, will wait for the process to finsih and " + "returns the exit code. Otherwise, returns proc.") + }, #endif {NULL, NULL, NULL} }; diff --git a/src/core/pp.c b/src/core/pp.c index 13550ca9..470d405a 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -955,6 +955,9 @@ void janet_buffer_format( janet_description_b(b, argv[arg]); break; } + case 't': + janet_buffer_push_cstring(b, typestr(argv[arg])); + break; case 'M': case 'm': case 'N': diff --git a/src/core/util.h b/src/core/util.h index cdf61e37..48ad89c8 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -76,7 +76,6 @@ int32_t janet_tablen(int32_t n); void safe_memcpy(void *dest, const void *src, size_t len); void janet_buffer_push_types(JanetBuffer *buffer, int types); const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key); -Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key); void janet_memempty(JanetKV *mem, int32_t count); void *janet_memalloc_empty(int32_t count); JanetTable *janet_get_core_table(const char *name); diff --git a/src/core/value.c b/src/core/value.c index 141edf7e..1be7966c 100644 --- a/src/core/value.c +++ b/src/core/value.c @@ -274,10 +274,9 @@ int32_t janet_hash(Janet x) { if (sizeof(double) == sizeof(void *)) { /* Assuming 8 byte pointer */ uint64_t i = janet_u64(x); - hash = (int32_t)(i & 0xFFFFFFFF); - /* Get a bit more entropy by shifting the low bits out */ - hash >>= 3; - hash ^= (int32_t)(i >> 32); + uint32_t lo = (uint32_t)(i & 0xFFFFFFFF); + uint32_t hi = (uint32_t)(i >> 32); + hash = (int32_t)(hi ^ (lo >> 3)); } else { /* Assuming 4 byte pointer (or smaller) */ hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0); diff --git a/src/include/janet.h b/src/include/janet.h index 65a4ca69..44df141f 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -206,7 +206,7 @@ extern "C" { #ifdef JANET_WINDOWS #define JANET_NO_RETURN __declspec(noreturn) #else -#define JANET_NO_RETURN __attribute__ ((noreturn)) +#define JANET_NO_RETURN __attribute__((noreturn)) #endif #endif @@ -272,11 +272,22 @@ typedef struct { } JanetBuildConfig; /* Get config of current compilation unit. */ +#ifdef __cplusplus +/* C++11 syntax */ +#define janet_config_current() (JanetBuildConfig { \ + JANET_VERSION_MAJOR, \ + JANET_VERSION_MINOR, \ + JANET_VERSION_PATCH, \ + JANET_CURRENT_CONFIG_BITS }) +#else +/* C99 syntax */ #define janet_config_current() ((JanetBuildConfig){ \ JANET_VERSION_MAJOR, \ JANET_VERSION_MINOR, \ JANET_VERSION_PATCH, \ JANET_CURRENT_CONFIG_BITS }) +#endif + /***** END SECTION CONFIG *****/ @@ -526,6 +537,7 @@ struct JanetListenerState { JanetFiber *fiber; JanetPollable *pollable; /* internal */ + int _index; /* not used in all implementations */ int _mask; JanetListenerState *_next; }; @@ -620,14 +632,14 @@ JANET_API Janet janet_wrap_integer(int32_t x); #define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47) #define janet_type(x) \ (isnan((x).number) \ - ? (((x).u64 >> 47) & 0xF) \ + ? (JanetType) (((x).u64 >> 47) & 0xF) \ : JANET_NUMBER) #define janet_nanbox_checkauxtype(x, type) \ (((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type))) #define janet_nanbox_isnumber(x) \ - (!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER)) + (!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER)) #define janet_checktype(x, t) \ (((t) == JANET_NUMBER) \ @@ -699,7 +711,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits); #define JANET_DOUBLE_OFFSET 0xFFFF #define janet_u64(x) ((x).u64) -#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER) +#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER) #define janet_checktype(x, t) ((t) == JANET_NUMBER \ ? (x).tagged.type >= JANET_DOUBLE_OFFSET \ : (x).tagged.type == (t)) @@ -1525,6 +1537,7 @@ typedef enum { JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation); JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation); JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns); +JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns); JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out); JANET_API void janet_register(const char *name, JanetCFunction cfun); @@ -1534,14 +1547,19 @@ JANET_API Janet janet_resolve_core(const char *name); /* New C API */ /* Allow setting entry name for static libraries */ +#ifdef __cplusplus +#define JANET_MODULE_PREFIX extern "C" +#else +#define JANET_MODULE_PREFIX +#endif #ifndef JANET_ENTRY_NAME #define JANET_MODULE_ENTRY \ - JANET_API JanetBuildConfig _janet_mod_config(void) { \ + JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \ return janet_config_current(); \ } \ - JANET_API void _janet_init + JANET_MODULE_PREFIX JANET_API void _janet_init #else -#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME +#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME #endif JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message); @@ -1626,10 +1644,12 @@ extern JANET_API const JanetAbstractType janet_file_type; #define JANET_FILE_BINARY 64 #define JANET_FILE_SERIALIZABLE 128 #define JANET_FILE_PIPED 256 +#define JANET_FILE_NONIL 512 JANET_API Janet janet_makefile(FILE *f, int32_t flags); JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags); JANET_API FILE *janet_dynfile(const char *name, FILE *def); +JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n); JANET_API JanetAbstract janet_checkfile(Janet j); JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags); diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index 2d1d92d9..47de7788 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -763,7 +763,7 @@ static int line() { switch (c) { default: - if (c < 0x20) break; + if ((unsigned char) c < 0x20) break; if (insert(c, 1)) return -1; break; case 1: /* ctrl-a */ diff --git a/test/install/project.janet b/test/install/project.janet index d116847c..5f3ce572 100644 --- a/test/install/project.janet +++ b/test/install/project.janet @@ -9,6 +9,14 @@ :name "testmod2" :source @["testmod2.c"]) +(declare-native + :name "testmod3" + :source @["testmod3.cpp"]) + +(declare-native + :name "test-mod-4" + :source @["testmod4.c"]) + (declare-executable :name "testexec" :entry "testexec.janet") diff --git a/test/install/testexec.janet b/test/install/testexec.janet index d57e596e..4f4c5020 100644 --- a/test/install/testexec.janet +++ b/test/install/testexec.janet @@ -1,6 +1,8 @@ (use build/testmod) (use build/testmod2) +(use build/testmod3) +(use build/test-mod-4) (defn main [&] (print "Hello from executable!") - (print (+ (get5) (get6)))) + (print (+ (get5) (get6) (get7) (get8)))) diff --git a/test/install/testmod3.cpp b/test/install/testmod3.cpp new file mode 100644 index 00000000..dfaf94f0 --- /dev/null +++ b/test/install/testmod3.cpp @@ -0,0 +1,42 @@ +/* +* Copyright (c) 2020 Calvin Rose and contributors +* +* Permission is hereby granted, free of charge, to any person obtaining a copy +* of this software and associated documentation files (the "Software"), to +* deal in the Software without restriction, including without limitation the +* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +* sell copies of the Software, and to permit persons to whom the Software is +* furnished to do so, subject to the following conditions: +* +* The above copyright notice and this permission notice shall be included in +* all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +* IN THE SOFTWARE. +*/ + +/* A very simple native module */ + +#include +#include + +static Janet cfun_get_seven(int32_t argc, Janet *argv) { + (void) argv; + janet_fixarity(argc, 0); + std::cout << "Hello!" << std::endl; + return janet_wrap_number(7.0); +} + +static const JanetReg array_cfuns[] = { + {"get7", cfun_get_seven, NULL}, + {NULL, NULL, NULL} +}; + +JANET_MODULE_ENTRY(JanetTable *env) { + janet_cfuns(env, NULL, array_cfuns); +} diff --git a/test/install/testmod4.c b/test/install/testmod4.c new file mode 100644 index 00000000..b29249dd --- /dev/null +++ b/test/install/testmod4.c @@ -0,0 +1,40 @@ +/* +* Copyright (c) 2020 Calvin Rose and contributors +* +* Permission is hereby granted, free of charge, to any person obtaining a copy +* of this software and associated documentation files (the "Software"), to +* deal in the Software without restriction, including without limitation the +* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +* sell copies of the Software, and to permit persons to whom the Software is +* furnished to do so, subject to the following conditions: +* +* The above copyright notice and this permission notice shall be included in +* all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +* IN THE SOFTWARE. +*/ + +/* A very simple native module */ + +#include + +static Janet cfun_get_eight(int32_t argc, Janet *argv) { + (void) argv; + janet_fixarity(argc, 0); + return janet_wrap_number(8.0); +} + +static const JanetReg array_cfuns[] = { + {"get8", cfun_get_eight, NULL}, + {NULL, NULL, NULL} +}; + +JANET_MODULE_ENTRY(JanetTable *env) { + janet_cfuns(env, NULL, array_cfuns); +}