From a3d4ecddba4deed1d85a1cb25ca90d87dafc804f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 8 Mar 2020 20:43:06 -0500 Subject: [PATCH 001/107] Address #301 Incorrect bounds checking and offset calculation in buffer/blit. --- CHANGELOG.md | 3 ++- src/core/buffer.c | 10 ++++++---- src/mainclient/shell.c | 2 +- test/suite8.janet | 10 ++++++++++ 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 72aa429f..06f5e172 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,8 @@ All notable changes to this project will be documented in this file. - Correct arity for `marshal` - Add `flush` and `eflush` - Add `prompt` and `return` on top of signal for user friendly delimited continuations. -- Fix possible segfault with malformed pegs. +- Fix bug in buffer/blit when using the offset-src argument. +- Fix segfault with malformed pegs. ## 1.7.0 - 2020-02-01 - Remove `file/fileno` and `file/fdopen`. diff --git a/src/core/buffer.c b/src/core/buffer.c index 85213ad7..ee205600 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -334,13 +334,15 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) { } else { length_src = src.len - offset_src; } - int64_t last = ((int64_t) offset_dest - offset_src) + length_src; + int64_t last = (int64_t) offset_dest + length_src; if (last > INT32_MAX) janet_panic("buffer blit out of range"); - janet_buffer_ensure(dest, (int32_t) last, 2); - if (last > dest->count) dest->count = (int32_t) last; + int32_t last32 = (int32_t) last; + janet_buffer_ensure(dest, last32, 2); + if (last32 > dest->count) dest->count = last32; if (length_src) { if (same_buf) { + /* janet_buffer_ensure may have invalidated src */ src.bytes = dest->data; memmove(dest->data + offset_dest, src.bytes + offset_src, length_src); } else { @@ -438,7 +440,7 @@ static const JanetReg buffer_cfuns[] = { }, { "buffer/blit", cfun_buffer_blit, - JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n" + JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n" "Insert the contents of src into dest. Can optionally take indices that " "indicate which part of src to copy into which part of dest. Indices can be " "negative to index from the end of src or dest. Returns dest.") diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index b9b843d2..65834376 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -623,7 +623,7 @@ static int line() { if (gbl_len == 0) { /* quit on empty line */ clearlines(); return -1; - } + } kdelete(1); break; case 5: /* ctrl-e */ diff --git a/test/suite8.janet b/test/suite8.janet index 4c976289..ac51bf70 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -126,4 +126,14 @@ (assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6") (assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7") +# Regression #301 +(def b (buffer/new-filled 128 0x78)) +(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1") + +(def a @"abcdefghijklm") +(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2") +(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3") +(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4") +(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5") + (end-suite) From 77343e02e9fe6568217b1496b8335c793d0dc6c7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 10 Mar 2020 22:46:18 -0500 Subject: [PATCH 002/107] Fixes #304 Add chr macro. --- CHANGELOG.md | 1 + src/boot/boot.janet | 7 +++++++ test/suite8.janet | 3 +++ 3 files changed, 11 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 06f5e172..557572ee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add `chr` macro. - Allow `_` in the `match` macro to match anything without creating a binding or doing unification. - Add `:range-to` and `:down-to` verbs in the `loop` macro. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c5036e6c..c9c2dcbc 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -316,6 +316,13 @@ ,payload (propagate ,res ,fib))))) +(defmacro chr + "Convert a string of length 1 to its byte (ascii) value at compile time." + [c] + (unless (and (string? c) (= (length c) 1)) + (error (string/format "expected string of length 1, got %v" c))) + (c 0)) + (defmacro label "Set a label point that is lexically scoped. Name should be a symbol that will be bound to the label." diff --git a/test/suite8.janet b/test/suite8.janet index ac51bf70..092c6d2e 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -136,4 +136,7 @@ (assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4") (assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5") +# chr +(assert (= (chr "a") 97) "chr 1") + (end-suite) From 0600b32908ecf3a9743f59d0b26501f3e49f8e43 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 13 Mar 2020 15:01:48 -0500 Subject: [PATCH 003/107] Fix docstring for os/cd - Fixes #307 --- src/core/os.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index ca463639..9350e985 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1028,7 +1028,7 @@ static const JanetReg os_cfuns[] = { { "os/cd", os_cd, JDOC("(os/cd path)\n\n" - "Change current directory to path. Returns true on success, false on failure.") + "Change current directory to path. Returns nil on success, errors on failure.") }, { "os/mkdir", os_mkdir, From 7996edfef94edd5b820b91654d532f9b5ffb67ff Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 13 Mar 2020 20:00:32 -0500 Subject: [PATCH 004/107] Update README.md - Fixes #308 --- README.md | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index a9ddd76c..f8117569 100644 --- a/README.md +++ b/README.md @@ -9,19 +9,21 @@ **Janet** is a functional and imperative programming language and bytecode interpreter. It is a modern lisp, but lists are replaced -by other data structures with better utility and performance (arrays, tables, structs, tuples). +by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples). The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly. There is a repl for trying out the language, as well as the ability to run script files. This client program is separate from the core runtime, so -janet can be embedded into other programs. Try janet in your browser at +Janet can be embedded into other programs. Try Janet in your browser at [https://janet-lang.org](https://janet-lang.org).
## Use Cases -Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile. +Janet makes a good system scripting language, or a language to embed in other programs. +It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than +Lua, but smaller than GNU Guile or Python. ## Features @@ -43,7 +45,7 @@ Janet makes a good system scripting language, or a language to embed in other pr * Imperative programming as well as functional * REPL * Parsing Expression Grammars built in to the core library -* 300+ functions and macros in the core library +* 400+ functions and macros in the core library * Embedding Janet in other programs * Interactive environment with detailed stack traces From 6a3a983f436d95e54db22acf7e6f11a9c7af6306 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 Mar 2020 10:12:47 -0500 Subject: [PATCH 005/107] Expose abstract type definitions in janet.h This makes certain operations easier, and allows more access to built in APIs. --- src/core/inttypes.c | 40 ++++++++++++------------- src/core/io.c | 50 ++++++++++++++----------------- src/core/math.c | 12 ++++---- src/core/parse.c | 32 ++++++++++---------- src/core/peg.c | 67 ++++++++++------------------------------- src/core/thread.c | 8 ++--- src/core/typedarray.c | 38 ++++++++++++------------ src/core/util.c | 10 +++---- src/include/janet.h | 69 ++++++++++++++++++++++++++++++++++++++++++- 9 files changed, 176 insertions(+), 150 deletions(-) diff --git a/src/core/inttypes.c b/src/core/inttypes.c index dffd17b4..4afd6ba0 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -81,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) { janet_buffer_push_cstring(buffer, str); } -static const JanetAbstractType it_s64_type = { +const JanetAbstractType janet_s64_type = { "core/s64", NULL, NULL, @@ -95,7 +95,7 @@ static const JanetAbstractType it_s64_type = { JANET_ATEND_HASH }; -static const JanetAbstractType it_u64_type = { +const JanetAbstractType janet_u64_type = { "core/u64", NULL, NULL, @@ -128,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) { } case JANET_ABSTRACT: { void *abst = janet_unwrap_abstract(x); - if (janet_abstract_type(abst) == &it_s64_type || - (janet_abstract_type(abst) == &it_u64_type)) + if (janet_abstract_type(abst) == &janet_s64_type || + (janet_abstract_type(abst) == &janet_u64_type)) return *(int64_t *)abst; break; } @@ -157,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) { } case JANET_ABSTRACT: { void *abst = janet_unwrap_abstract(x); - if (janet_abstract_type(abst) == &it_s64_type || - (janet_abstract_type(abst) == &it_u64_type)) + if (janet_abstract_type(abst) == &janet_s64_type || + (janet_abstract_type(abst) == &janet_u64_type)) return *(uint64_t *)abst; break; } @@ -170,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) { JanetIntType janet_is_int(Janet x) { if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE; const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x)); - return (at == &it_s64_type) ? JANET_INT_S64 : - ((at == &it_u64_type) ? JANET_INT_U64 : + return (at == &janet_s64_type) ? JANET_INT_S64 : + ((at == &janet_u64_type) ? JANET_INT_U64 : JANET_INT_NONE); } Janet janet_wrap_s64(int64_t x) { - int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t)); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); *box = (int64_t)x; return janet_wrap_abstract(box); } Janet janet_wrap_u64(uint64_t x) { - uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t)); + uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t)); *box = (uint64_t)x; return janet_wrap_abstract(box); } @@ -200,7 +200,7 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) { #define OPMETHOD(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_arity(argc, 2, -1); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[0]); \ for (int32_t i = 1; i < argc; i++) \ *box oper##= janet_unwrap_##type(argv[i]); \ @@ -210,7 +210,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ #define OPMETHODINVERT(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ *box oper##= janet_unwrap_##type(argv[0]); \ return janet_wrap_abstract(box); \ @@ -219,7 +219,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ #define DIVMETHOD(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_arity(argc, 2, -1); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[0]); \ for (int32_t i = 1; i < argc; i++) { \ T value = janet_unwrap_##type(argv[i]); \ @@ -232,7 +232,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ #define DIVMETHODINVERT(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ T value = janet_unwrap_##type(argv[0]); \ if (value == 0) janet_panic("division by zero"); \ @@ -243,7 +243,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ #define DIVMETHOD_SIGNED(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_arity(argc, 2, -1); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[0]); \ for (int32_t i = 1; i < argc; i++) { \ T value = janet_unwrap_##type(argv[i]); \ @@ -257,7 +257,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ - T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ + T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ T value = janet_unwrap_##type(argv[0]); \ if (value == 0) janet_panic("division by zero"); \ @@ -276,7 +276,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { janet_arity(argc, 2, -1); - int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t)); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); *box = janet_unwrap_s64(argv[0]); for (int32_t i = 1; i < argc; i++) { int64_t value = janet_unwrap_s64(argv[i]); @@ -292,7 +292,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); - int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t)); + int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[1]); int64_t x = op1 % op2; @@ -441,8 +441,8 @@ static const JanetReg it_cfuns[] = { /* Module entry point */ void janet_lib_inttypes(JanetTable *env) { janet_core_cfuns(env, NULL, it_cfuns); - janet_register_abstract_type(&it_s64_type); - janet_register_abstract_type(&it_u64_type); + janet_register_abstract_type(&janet_s64_type); + janet_register_abstract_type(&janet_u64_type); } #endif diff --git a/src/core/io.c b/src/core/io.c index 7a8663f2..fe6c2625 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -33,16 +33,10 @@ #include #endif -typedef struct IOFile IOFile; -struct IOFile { - FILE *file; - int flags; -}; - static int cfun_io_gc(void *p, size_t len); static int io_file_get(void *p, Janet key, Janet *out); -JanetAbstractType cfun_io_filetype = { +const JanetAbstractType janet_file_type = { "core/file", cfun_io_gc, NULL, @@ -90,7 +84,7 @@ static int checkflags(const uint8_t *str) { } static Janet makef(FILE *f, int flags) { - IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile)); + JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile)); iof->file = f; iof->flags = flags; return janet_wrap_abstract(iof); @@ -158,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) { } /* Read up to n bytes into buffer. */ -static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { +static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE))) janet_panic("file is not readable"); janet_buffer_extra(buffer, nBytesMax); @@ -172,7 +166,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { /* Read a certain number of bytes into memory */ static Janet cfun_io_fread(int32_t argc, Janet *argv) { janet_arity(argc, 2, 3); - IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); JanetBuffer *buffer; if (argc == 2) { @@ -212,7 +206,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) { /* Write bytes to a file */ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) { janet_arity(argc, 1, -1); - IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE))) @@ -235,7 +229,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) { /* Flush the bytes in the file */ static Janet cfun_io_fflush(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE))) @@ -248,7 +242,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) { /* Cleanup a file */ static int cfun_io_gc(void *p, size_t len) { (void) len; - IOFile *iof = (IOFile *)p; + JanetFile *iof = (JanetFile *)p; if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) { return fclose(iof->file); } @@ -258,7 +252,7 @@ static int cfun_io_gc(void *p, size_t len) { /* Close a file */ static Janet cfun_io_fclose(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) return janet_wrap_nil(); if (iof->flags & (JANET_FILE_NOT_CLOSEABLE)) @@ -282,7 +276,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) { /* Seek a file */ static Janet cfun_io_fseek(int32_t argc, Janet *argv) { janet_arity(argc, 2, 3); - IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); long int offset = 0; @@ -326,8 +320,8 @@ FILE *janet_dynfile(const char *name, FILE *def) { Janet x = janet_dyn(name); if (!janet_checktype(x, JANET_ABSTRACT)) return def; void *abstract = janet_unwrap_abstract(x); - if (janet_abstract_type(abstract) != &cfun_io_filetype) return def; - IOFile *iofile = abstract; + if (janet_abstract_type(abstract) != &janet_file_type) return def; + JanetFile *iofile = abstract; return iofile->file; } @@ -354,9 +348,9 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv, break; case JANET_ABSTRACT: { void *abstract = janet_unwrap_abstract(x); - if (janet_abstract_type(abstract) != &cfun_io_filetype) + if (janet_abstract_type(abstract) != &janet_file_type) return janet_wrap_nil(); - IOFile *iofile = abstract; + JanetFile *iofile = abstract; f = iofile->file; break; } @@ -421,9 +415,9 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline, break; case JANET_ABSTRACT: { void *abstract = janet_unwrap_abstract(x); - if (janet_abstract_type(abstract) != &cfun_io_filetype) + if (janet_abstract_type(abstract) != &janet_file_type) return janet_wrap_nil(); - IOFile *iofile = abstract; + JanetFile *iofile = abstract; f = iofile->file; break; } @@ -470,8 +464,8 @@ static void janet_flusher(const char *name, FILE *dflt_file) { break; case JANET_ABSTRACT: { void *abstract = janet_unwrap_abstract(x); - if (janet_abstract_type(abstract) != &cfun_io_filetype) break; - IOFile *iofile = abstract; + if (janet_abstract_type(abstract) != &janet_file_type) break; + JanetFile *iofile = abstract; fflush(iofile->file); break; } @@ -511,9 +505,9 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) janet_formatb(&buffer, format, args); if (xtype == JANET_ABSTRACT) { void *abstract = janet_unwrap_abstract(x); - if (janet_abstract_type(abstract) != &cfun_io_filetype) + if (janet_abstract_type(abstract) != &janet_file_type) break; - IOFile *iofile = abstract; + JanetFile *iofile = abstract; f = iofile->file; } fwrite(buffer.data, buffer.count, 1, f); @@ -660,7 +654,7 @@ static const JanetReg io_cfuns[] = { /* C API */ FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) { - IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype); + JanetFile *iof = janet_getabstract(argv, n, &janet_file_type); if (NULL != flags) *flags = iof->flags; return iof->file; } @@ -670,11 +664,11 @@ Janet janet_makefile(FILE *f, int flags) { } JanetAbstract janet_checkfile(Janet j) { - return janet_checkabstract(j, &cfun_io_filetype); + return janet_checkabstract(j, &janet_file_type); } FILE *janet_unwrapfile(Janet j, int *flags) { - IOFile *iof = janet_unwrap_abstract(j); + JanetFile *iof = janet_unwrap_abstract(j); if (NULL != flags) *flags = iof->flags; return iof->file; } diff --git a/src/core/math.c b/src/core/math.c index 611b97c3..5d853d07 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -52,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) { return rng; } -static JanetAbstractType JanetRNG_type = { +const JanetAbstractType janet_rng_type = { "core/rng", NULL, NULL, @@ -115,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) { static Janet cfun_rng_make(int32_t argc, Janet *argv) { janet_arity(argc, 0, 1); - JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG)); + JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG)); if (argc == 1) { if (janet_checkint(argv[0])) { uint32_t seed = (uint32_t)(janet_getinteger(argv, 0)); @@ -132,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) { static Janet cfun_rng_uniform(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type); + JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); return janet_wrap_number(janet_rng_double(rng)); } static Janet cfun_rng_int(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); - JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type); + JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); if (argc == 1) { uint32_t word = janet_rng_u32(rng) >> 1; return janet_wrap_integer(word); @@ -166,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) { static Janet cfun_rng_buffer(int32_t argc, Janet *argv) { janet_arity(argc, 2, 3); - JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type); + JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); int32_t n = janet_getnat(argv, 1); JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n); @@ -459,7 +459,7 @@ static const JanetReg math_cfuns[] = { /* Module entry point */ void janet_lib_math(JanetTable *env) { janet_core_cfuns(env, NULL, math_cfuns); - janet_register_abstract_type(&JanetRNG_type); + janet_register_abstract_type(&janet_rng_type); #ifdef JANET_BOOTSTRAP janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931), JDOC("The value pi.")); diff --git a/src/core/parse.c b/src/core/parse.c index 8e477580..f6d6625f 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -732,7 +732,7 @@ static int parsergc(void *p, size_t size) { static int parserget(void *p, Janet key, Janet *out); -static JanetAbstractType janet_parse_parsertype = { +const JanetAbstractType janet_parser_type = { "core/parser", parsergc, parsermark, @@ -744,14 +744,14 @@ static JanetAbstractType janet_parse_parsertype = { static Janet cfun_parse_parser(int32_t argc, Janet *argv) { (void) argv; janet_fixarity(argc, 0); - JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser)); + JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser)); janet_parser_init(p); return janet_wrap_abstract(p); } static Janet cfun_parse_consume(int32_t argc, Janet *argv) { janet_arity(argc, 2, 3); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); JanetByteView view = janet_getbytes(argv, 1); if (argc == 3) { int32_t offset = janet_getinteger(argv, 2); @@ -776,14 +776,14 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) { static Janet cfun_parse_eof(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); janet_parser_eof(p); return argv[0]; } static Janet cfun_parse_insert(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); JanetParseState *s = p->states + p->statecount - 1; if (s->consumer == tokenchar) { janet_parser_consume(p, ' '); @@ -817,13 +817,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) { static Janet cfun_parse_has_more(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); return janet_wrap_boolean(janet_parser_has_more(p)); } static Janet cfun_parse_byte(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); int32_t i = janet_getinteger(argv, 1); janet_parser_consume(p, 0xFF & i); return argv[0]; @@ -831,7 +831,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) { static Janet cfun_parse_status(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); const char *stat = NULL; switch (janet_parser_status(p)) { case JANET_PARSE_PENDING: @@ -852,7 +852,7 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) { static Janet cfun_parse_error(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); const char *err = janet_parser_error(p); if (err) return janet_cstringv(err); return janet_wrap_nil(); @@ -860,20 +860,20 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) { static Janet cfun_parse_produce(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); return janet_parser_produce(p); } static Janet cfun_parse_flush(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); janet_parser_flush(p); return argv[0]; } static Janet cfun_parse_where(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); Janet *tup = janet_tuple_begin(2); tup[0] = janet_wrap_integer(p->line); tup[1] = janet_wrap_integer(p->column); @@ -953,7 +953,7 @@ struct ParserStateGetter { }; static Janet parser_state_delimiters(const JanetParser *_p) { - JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser)); + JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser)); janet_parser_clone(_p, clone); size_t i; const uint8_t *str; @@ -1004,7 +1004,7 @@ static const struct ParserStateGetter parser_state_getters[] = { static Janet cfun_parse_state(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); const uint8_t *key = NULL; - JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); + JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); if (argc == 2) { key = janet_getkeyword(argv, 1); } @@ -1031,8 +1031,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) { static Janet cfun_parse_clone(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype); - JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser)); + JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type); + JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser)); janet_parser_clone(src, dest); return janet_wrap_abstract(dest); } diff --git a/src/core/peg.c b/src/core/peg.c index fc05c9b7..d08b1770 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -35,34 +35,6 @@ * Runtime */ -/* opcodes for peg vm */ -typedef enum { - RULE_LITERAL, /* [len, bytes...] */ - RULE_NCHAR, /* [n] */ - RULE_NOTNCHAR, /* [n] */ - RULE_RANGE, /* [lo | hi << 16 (1 word)] */ - RULE_SET, /* [bitmap (8 words)] */ - RULE_LOOK, /* [offset, rule] */ - RULE_CHOICE, /* [len, rules...] */ - RULE_SEQUENCE, /* [len, rules...] */ - RULE_IF, /* [rule_a, rule_b (b if a)] */ - RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */ - RULE_NOT, /* [rule] */ - RULE_BETWEEN, /* [lo, hi, rule] */ - RULE_GETTAG, /* [searchtag, tag] */ - RULE_CAPTURE, /* [rule, tag] */ - RULE_POSITION, /* [tag] */ - RULE_ARGUMENT, /* [argument-index, tag] */ - RULE_CONSTANT, /* [constant, tag] */ - RULE_ACCUMULATE, /* [rule, tag] */ - RULE_GROUP, /* [rule, tag] */ - RULE_REPLACE, /* [rule, constant, tag] */ - RULE_MATCHTIME, /* [rule, constant, tag] */ - RULE_ERROR, /* [rule] */ - RULE_DROP, /* [rule] */ - RULE_BACKMATCH, /* [tag] */ -} Opcode; - /* Hold captured patterns and match state */ typedef struct { const uint8_t *text_start; @@ -1016,16 +988,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) { * Post-Compilation */ -typedef struct { - uint32_t *bytecode; - Janet *constants; - size_t bytecode_len; - uint32_t num_constants; -} Peg; - static int peg_mark(void *p, size_t size) { (void) size; - Peg *peg = (Peg *)p; + JanetPeg *peg = (JanetPeg *)p; if (NULL != peg->constants) for (uint32_t i = 0; i < peg->num_constants; i++) janet_mark(peg->constants[i]); @@ -1033,7 +998,7 @@ static int peg_mark(void *p, size_t size) { } static void peg_marshal(void *p, JanetMarshalContext *ctx) { - Peg *peg = (Peg *)p; + JanetPeg *peg = (JanetPeg *)p; janet_marshal_size(ctx, peg->bytecode_len); janet_marshal_int(ctx, (int32_t)peg->num_constants); janet_marshal_abstract(ctx, p); @@ -1055,7 +1020,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx); /* Calculate offsets. Should match those in make_peg */ - size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t)); + size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t)); size_t bytecode_size = bytecode_len * sizeof(uint32_t); size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet)); size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants; @@ -1065,7 +1030,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { /* Allocate PEG */ char *mem = janet_unmarshal_abstract(ctx, total_size); - Peg *peg = (Peg *)mem; + JanetPeg *peg = (JanetPeg *)mem; uint32_t *bytecode = (uint32_t *)(mem + bytecode_start); Janet *constants = (Janet *)(mem + constants_start); peg->bytecode = NULL; @@ -1208,7 +1173,7 @@ bad: static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out); -static const JanetAbstractType peg_type = { +const JanetAbstractType janet_peg_type = { "core/peg", NULL, peg_mark, @@ -1219,15 +1184,15 @@ static const JanetAbstractType peg_type = { JANET_ATEND_UNMARSHAL }; -/* Convert Builder to Peg (Janet Abstract Value) */ -static Peg *make_peg(Builder *b) { - size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t)); +/* Convert Builder to JanetPeg (Janet Abstract Value) */ +static JanetPeg *make_peg(Builder *b) { + size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t)); size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t); size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet)); size_t constants_size = janet_v_count(b->constants) * sizeof(Janet); size_t total_size = constants_start + constants_size; - char *mem = janet_abstract(&peg_type, total_size); - Peg *peg = (Peg *)mem; + char *mem = janet_abstract(&janet_peg_type, total_size); + JanetPeg *peg = (JanetPeg *)mem; peg->bytecode = (uint32_t *)(mem + bytecode_start); peg->constants = (Janet *)(mem + constants_start); peg->num_constants = janet_v_count(b->constants); @@ -1238,7 +1203,7 @@ static Peg *make_peg(Builder *b) { } /* Compiler entry point */ -static Peg *compile_peg(Janet x) { +static JanetPeg *compile_peg(Janet x) { Builder builder; builder.grammar = janet_table(0); builder.default_grammar = janet_get_core_table("default-peg-grammar"); @@ -1249,7 +1214,7 @@ static Peg *compile_peg(Janet x) { builder.form = x; builder.depth = JANET_RECURSION_GUARD; peg_compile1(&builder, x); - Peg *peg = make_peg(&builder); + JanetPeg *peg = make_peg(&builder); builder_cleanup(&builder); return peg; } @@ -1260,15 +1225,15 @@ static Peg *compile_peg(Janet x) { static Janet cfun_peg_compile(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); - Peg *peg = compile_peg(argv[0]); + JanetPeg *peg = compile_peg(argv[0]); return janet_wrap_abstract(peg); } static Janet cfun_peg_match(int32_t argc, Janet *argv) { janet_arity(argc, 2, -1); - Peg *peg; + JanetPeg *peg; if (janet_checktype(argv[0], JANET_ABSTRACT) && - janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) { + janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) { peg = janet_unwrap_abstract(argv[0]); } else { peg = compile_peg(argv[0]); @@ -1327,7 +1292,7 @@ static const JanetReg peg_cfuns[] = { /* Load the peg module */ void janet_lib_peg(JanetTable *env) { janet_core_cfuns(env, NULL, peg_cfuns); - janet_register_abstract_type(&peg_type); + janet_register_abstract_type(&janet_peg_type); } #endif /* ifdef JANET_PEG */ diff --git a/src/core/thread.c b/src/core/thread.c index 109e4939..1240bc65 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -409,7 +409,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) { static int janet_thread_getter(void *p, Janet key, Janet *out); -static JanetAbstractType Thread_AT = { +const JanetAbstractType janet_thread_type = { "core/thread", thread_gc, thread_mark, @@ -418,7 +418,7 @@ static JanetAbstractType Thread_AT = { }; static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) { - JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread)); + JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread)); janet_mailbox_ref(mailbox, 1); thread->mailbox = mailbox; thread->encode = encode; @@ -426,7 +426,7 @@ static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) } JanetThread *janet_getthread(const Janet *argv, int32_t n) { - return (JanetThread *) janet_getabstract(argv, n, &Thread_AT); + return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type); } /* Runs in new thread */ @@ -664,7 +664,7 @@ static const JanetReg threadlib_cfuns[] = { /* Module entry point */ void janet_lib_thread(JanetTable *env) { janet_core_cfuns(env, NULL, threadlib_cfuns); - janet_register_abstract_type(&Thread_AT); + janet_register_abstract_type(&janet_thread_type); } #endif diff --git a/src/core/typedarray.c b/src/core/typedarray.c index 840368bd..961d103e 100644 --- a/src/core/typedarray.c +++ b/src/core/typedarray.c @@ -111,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) { return buf; } -static const JanetAbstractType ta_buffer_type = { +const JanetAbstractType janet_ta_buffer_type = { "ta/buffer", ta_buffer_gc, NULL, @@ -154,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) { offset = janet_unmarshal_size(ctx); buffer = janet_unmarshal_janet(ctx); if (!janet_checktype(buffer, JANET_ABSTRACT) || - (janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) { + (janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) { janet_panicf("expected typed array buffer"); } view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer); @@ -275,7 +275,7 @@ static void ta_setter(void *p, Janet key, Janet value) { } } -static const JanetAbstractType ta_view_type = { +const JanetAbstractType janet_ta_view_type = { "ta/view", NULL, ta_mark, @@ -287,7 +287,7 @@ static const JanetAbstractType ta_view_type = { }; JanetTArrayBuffer *janet_tarray_buffer(size_t size) { - JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer)); + JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer)); ta_buffer_init(buf, size); return buf; } @@ -299,13 +299,13 @@ JanetTArrayView *janet_tarray_view( size_t offset, JanetTArrayBuffer *buffer) { - JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView)); + JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView)); if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0"); size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1); if (NULL == buffer) { - buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer)); + buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer)); ta_buffer_init(buffer, buf_size); } @@ -325,15 +325,15 @@ JanetTArrayView *janet_tarray_view( } JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) { - return janet_getabstract(argv, n, &ta_buffer_type); + return janet_getabstract(argv, n, &janet_ta_buffer_type); } JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) { - return janet_getabstract(argv, n, &ta_view_type); + return janet_getabstract(argv, n, &janet_ta_view_type); } JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) { - JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type); + JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type); if (view->type != type) { janet_panicf("bad slot #%d, expected typed array of type %s, got %v", n, ta_type_names[type], argv[n]); @@ -359,7 +359,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) { 4, argv[4]); } void *p = janet_unwrap_abstract(argv[4]); - if (janet_abstract_type(p) == &ta_view_type) { + if (janet_abstract_type(p) == &janet_ta_view_type) { JanetTArrayView *view = (JanetTArrayView *)p; offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type]; stride *= view->stride; @@ -375,7 +375,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) { static JanetTArrayView *ta_is_view(Janet x) { if (!janet_checktype(x, JANET_ABSTRACT)) return NULL; void *abst = janet_unwrap_abstract(x); - if (janet_abstract_type(abst) != &ta_view_type) return NULL; + if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL; return (JanetTArrayView *)abst; } @@ -396,7 +396,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) { if ((view = ta_is_view(argv[0]))) { return janet_wrap_number((double) view->size); } - JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type); + JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type); return janet_wrap_number((double) buf->size); } @@ -433,7 +433,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) { static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) { janet_arity(argc, 1, 3); - JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); JanetRange range; int32_t length = (int32_t)src->size; if (argc == 1) { @@ -461,9 +461,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) { static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) { janet_arity(argc, 4, 5); - JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); size_t index_src = janet_getsize(argv, 1); - JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type); + JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type); size_t index_dst = janet_getsize(argv, 3); size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; size_t src_atom_size = ta_type_sizes[src->type]; @@ -488,9 +488,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) { static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) { janet_arity(argc, 4, 5); - JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); size_t index_src = janet_getsize(argv, 1); - JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type); + JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type); size_t index_dst = janet_getsize(argv, 3); size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; size_t src_atom_size = ta_type_sizes[src->type]; @@ -574,8 +574,8 @@ static JanetMethod tarray_view_methods[] = { /* Module entry point */ void janet_lib_typed_array(JanetTable *env) { janet_core_cfuns(env, NULL, ta_cfuns); - janet_register_abstract_type(&ta_buffer_type); - janet_register_abstract_type(&ta_view_type); + janet_register_abstract_type(&janet_ta_buffer_type); + janet_register_abstract_type(&janet_ta_view_type); } #endif diff --git a/src/core/util.c b/src/core/util.c index 738127a9..57681054 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -421,10 +421,10 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) free(longname_buffer); } -/* Abstract type introspection */ +/* Abstract type introspection - not meant to be used directly */ -static const JanetAbstractType type_wrap = { - "core/type-info", +static const JanetAbstractType janet_abstract_info_type = { + "core/abstract-info", JANET_ATEND_NAME }; @@ -434,7 +434,7 @@ typedef struct { void janet_register_abstract_type(const JanetAbstractType *at) { JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *) - janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap)); + janet_abstract(&janet_abstract_info_type, sizeof(JanetAbstractTypeWrap)); abstract->at = at; Janet sym = janet_csymbolv(at->name); if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) { @@ -450,7 +450,7 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) { return NULL; } if (!janet_checktype(twrap, JANET_ABSTRACT) || - (janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) { + (janet_abstract_type(janet_unwrap_abstract(twrap)) != &janet_abstract_info_type)) { janet_panic("expected abstract type"); } JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap); diff --git a/src/include/janet.h b/src/include/janet.h index 46e65558..50f772a8 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -887,8 +887,9 @@ struct JanetParser { int flag; }; +/* A context for marshaling and unmarshaling abstract types */ typedef struct { - void *m_state; /* void* to not expose MarshalState ?*/ + void *m_state; void *u_state; int flags; const uint8_t *data; @@ -965,6 +966,12 @@ struct JanetRNG { uint32_t counter; }; +typedef struct JanetFile JanetFile; +struct JanetFile { + FILE *file; + int flags; +}; + /* Thread types */ #ifdef JANET_THREADS typedef struct JanetThread JanetThread; @@ -1095,6 +1102,7 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT]; /***** START SECTION MAIN *****/ /* Parsing */ +extern JANET_API const JanetAbstractType janet_parser_type; JANET_API void janet_parser_init(JanetParser *parser); JANET_API void janet_parser_deinit(JanetParser *parser); JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c); @@ -1156,6 +1164,7 @@ JANET_API void janet_debug_find( JanetString source, int32_t line, int32_t column); /* RNG */ +extern JANET_API const JanetAbstractType janet_rng_type; JANET_API JanetRNG *janet_default_rng(void); JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed); JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len); @@ -1468,6 +1477,8 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n, JANET_API Janet janet_dyn(const char *name); JANET_API void janet_setdyn(const char *name, Janet value); +extern JANET_API const JanetAbstractType janet_file_type; + #define JANET_FILE_WRITE 1 #define JANET_FILE_READ 2 #define JANET_FILE_APPEND 4 @@ -1505,8 +1516,52 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_ JANET_API void janet_register_abstract_type(const JanetAbstractType *at); JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key); +#ifdef JANET_PEG + +extern JANET_API const JanetAbstractType janet_peg_type; + +/* opcodes for peg vm */ +typedef enum { + RULE_LITERAL, /* [len, bytes...] */ + RULE_NCHAR, /* [n] */ + RULE_NOTNCHAR, /* [n] */ + RULE_RANGE, /* [lo | hi << 16 (1 word)] */ + RULE_SET, /* [bitmap (8 words)] */ + RULE_LOOK, /* [offset, rule] */ + RULE_CHOICE, /* [len, rules...] */ + RULE_SEQUENCE, /* [len, rules...] */ + RULE_IF, /* [rule_a, rule_b (b if a)] */ + RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */ + RULE_NOT, /* [rule] */ + RULE_BETWEEN, /* [lo, hi, rule] */ + RULE_GETTAG, /* [searchtag, tag] */ + RULE_CAPTURE, /* [rule, tag] */ + RULE_POSITION, /* [tag] */ + RULE_ARGUMENT, /* [argument-index, tag] */ + RULE_CONSTANT, /* [constant, tag] */ + RULE_ACCUMULATE, /* [rule, tag] */ + RULE_GROUP, /* [rule, tag] */ + RULE_REPLACE, /* [rule, constant, tag] */ + RULE_MATCHTIME, /* [rule, constant, tag] */ + RULE_ERROR, /* [rule] */ + RULE_DROP, /* [rule] */ + RULE_BACKMATCH, /* [tag] */ +} JanetPegOpcode; + +typedef struct { + uint32_t *bytecode; + Janet *constants; + size_t bytecode_len; + uint32_t num_constants; +} JanetPeg; + +#endif + #ifdef JANET_TYPED_ARRAY +extern JANET_API const JanetAbstractType janet_ta_view_type; +extern JANET_API const JanetAbstractType janet_ta_buffer_type; + typedef enum { JANET_TARRAY_TYPE_U8, JANET_TARRAY_TYPE_S8, @@ -1557,6 +1612,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n); #ifdef JANET_INT_TYPES +extern JANET_API const JanetAbstractType janet_s64_type; +extern JANET_API const JanetAbstractType janet_s64_type; + typedef enum { JANET_INT_NONE, JANET_INT_S64, @@ -1573,6 +1631,15 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out); #endif +#ifdef JANET_THREADS + +extern JANET_API const JanetAbstractType janet_thread_type; + +JANET_API int janet_thread_receive(Janet *msg_out, double timeout); +JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout); + +#endif + /***** END SECTION MAIN *****/ #ifdef __cplusplus From a3aaa6634dcc49081354f867cc87d0ea1f6e89de Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 Mar 2020 10:25:39 -0500 Subject: [PATCH 006/107] Use separate registry table for abstract types. This avoids overloading the registry table, which is intended for names of c functions. --- src/core/state.h | 4 ++++ src/core/util.c | 29 ++++++----------------------- src/core/vm.c | 4 ++++ 3 files changed, 14 insertions(+), 23 deletions(-) diff --git a/src/core/state.h b/src/core/state.h index 8674b07a..0ed8b31d 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -53,6 +53,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg; * along with otherwise bare c function pointers. */ extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry; +/* Registry for abstract abstract types that can be marshalled. + * We need this to look up the constructors when unmarshalling. */ +extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry; + /* Immutable value cache */ extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache; extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity; diff --git a/src/core/util.c b/src/core/util.c index 57681054..f2df7421 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -421,40 +421,23 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) free(longname_buffer); } -/* Abstract type introspection - not meant to be used directly */ - -static const JanetAbstractType janet_abstract_info_type = { - "core/abstract-info", - JANET_ATEND_NAME -}; - -typedef struct { - const JanetAbstractType *at; -} JanetAbstractTypeWrap; +/* Abstract type introspection */ void janet_register_abstract_type(const JanetAbstractType *at) { - JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *) - janet_abstract(&janet_abstract_info_type, sizeof(JanetAbstractTypeWrap)); - abstract->at = at; Janet sym = janet_csymbolv(at->name); - if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) { + if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) { janet_panicf("cannot register abstract type %s, " "a type with the same name exists", at->name); } - janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract)); + janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at)); } const JanetAbstractType *janet_get_abstract_type(Janet key) { - Janet twrap = janet_table_get(janet_vm_registry, key); - if (janet_checktype(twrap, JANET_NIL)) { + Janet wrapped = janet_table_get(janet_vm_abstract_registry, key); + if (janet_checktype(wrapped, JANET_NIL)) { return NULL; } - if (!janet_checktype(twrap, JANET_ABSTRACT) || - (janet_abstract_type(janet_unwrap_abstract(twrap)) != &janet_abstract_info_type)) { - janet_panic("expected abstract type"); - } - JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap); - return w->at; + return (JanetAbstractType *)(janet_unwrap_pointer(wrapped)); } #ifndef JANET_BOOTSTRAP diff --git a/src/core/vm.c b/src/core/vm.c index ead97d68..e96507b3 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -35,6 +35,7 @@ /* VM state */ JANET_THREAD_LOCAL JanetTable *janet_vm_core_env; JANET_THREAD_LOCAL JanetTable *janet_vm_registry; +JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry; JANET_THREAD_LOCAL int janet_vm_stackn = 0; JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL; JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL; @@ -1380,7 +1381,9 @@ int janet_init(void) { janet_scratch_cap = 0; /* Initialize registry */ janet_vm_registry = janet_table(0); + janet_vm_abstract_registry = janet_table(0); janet_gcroot(janet_wrap_table(janet_vm_registry)); + janet_gcroot(janet_wrap_table(janet_vm_abstract_registry)); /* Core env */ janet_vm_core_env = NULL; /* Seed RNG */ @@ -1401,6 +1404,7 @@ void janet_deinit(void) { janet_vm_root_count = 0; janet_vm_root_capacity = 0; janet_vm_registry = NULL; + janet_vm_abstract_registry = NULL; janet_vm_core_env = NULL; #ifdef JANET_THREADS janet_threads_deinit(); From bac2b74b3d92ff04f4720fda66a1a679fdc39fe2 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 Mar 2020 11:56:42 -0500 Subject: [PATCH 007/107] Add os/chmod. --- CHANGELOG.md | 1 + src/core/os.c | 93 +++++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 84 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 557572ee..6e1f43a7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add `os/chmod`. - Add `chr` macro. - Allow `_` in the `match` macro to match anything without creating a binding or doing unification. diff --git a/src/core/os.c b/src/core/os.c index 9350e985..9b96b74d 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -739,13 +739,42 @@ static Janet os_remove(int32_t argc, Janet *argv) { #ifdef JANET_WINDOWS static const uint8_t *janet_decode_permissions(unsigned short m) { - uint8_t flags[9] = {0}; - flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-'; - flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-'; - flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-'; + uint8_t flags[3] = {0}; + flags[0] = (m & S_IREAD) ? 'r' : '-'; + flags[1] = (m & S_IWRITE) ? 'w' : '-'; + flags[2] = (m & S_IEXEC) ? 'x' : '-'; return janet_string(flags, sizeof(flags)); } +static unsigned short janet_encode_permissions(Janet *argv, int32_t n) { + if (janet_checkint(argv[n])) { + int32_t x = janet_unwrap_integer(argv[n]); + if (x < 0 || x > 0777) { + janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]); + } + unsigned short m = 0; + if (x & 1 || x & 010 || x & 0100) m |= S_IEXEC; + if (x & 2 || x & 020 || x & 0200) m |= S_IWRITE; + if (x & 4 || x & 040 || x & 0400) m |= S_IREAD; + return m; + } + JanetString perm = janet_getstring(argv, n); + if (janet_string_length(perm) != 9) { + janet_panicf("expected string of length 9, got %S", perm); + } + unsigned short m = 0; + if (perm[0] == 'r') m |= S_IREAD; + if (perm[1] == 'w') m |= S_IWRITE; + if (perm[2] == 'x') m |= S_IEXEC; + if (perm[3] == 'r') m |= S_IREAD; + if (perm[4] == 'w') m |= S_IWRITE; + if (perm[5] == 'x') m |= S_IEXEC; + if (perm[6] == 'r') m |= S_IREAD; + if (perm[7] == 'w') m |= S_IWRITE; + if (perm[8] == 'x') m |= S_IEXEC; + return m; +} + static const uint8_t *janet_decode_mode(unsigned short m) { const char *str = "other"; if (m & _S_IFREG) str = "file"; @@ -768,6 +797,31 @@ static const uint8_t *janet_decode_permissions(mode_t m) { return janet_string(flags, sizeof(flags)); } +static mode_t janet_encode_permissions(Janet *argv, int32_t n) { + if (janet_checkint(argv[n])) { + int32_t x = janet_unwrap_integer(argv[n]); + if (x < 0 || x > 0777) { + janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]); + } + return (mode_t) x; + } + JanetString perm = janet_getstring(argv, n); + if (janet_string_length(perm) != 9) { + janet_panicf("expected string of length 9, got %S", perm); + } + mode_t m = 0; + if (perm[0] == 'r') m |= S_IRUSR; + if (perm[1] == 'w') m |= S_IWUSR; + if (perm[2] == 'x') m |= S_IXUSR; + if (perm[3] == 'r') m |= S_IRGRP; + if (perm[4] == 'w') m |= S_IWGRP; + if (perm[5] == 'x') m |= S_IXGRP; + if (perm[6] == 'r') m |= S_IROTH; + if (perm[7] == 'w') m |= S_IWOTH; + if (perm[8] == 'x') m |= S_IXOTH; + return m; +} + static const uint8_t *janet_decode_mode(mode_t m) { const char *str = "other"; if (S_ISREG(m)) str = "file"; @@ -781,11 +835,6 @@ static const uint8_t *janet_decode_mode(mode_t m) { } #endif -/* Can we do this? */ -#ifdef JANET_WINDOWS -#define stat _stat -#endif - /* Getters */ static Janet os_stat_dev(struct stat *st) { return janet_wrap_number(st->st_dev); @@ -881,7 +930,11 @@ static Janet os_stat(int32_t argc, Janet *argv) { /* Build result */ struct stat st; +#ifdef JANET_WINDOWS + int res = _stat(path, &st); +#else int res = stat(path, &st); +#endif if (-1 == res) { return janet_wrap_nil(); } @@ -903,6 +956,18 @@ static Janet os_stat(int32_t argc, Janet *argv) { } } +static Janet os_chmod(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); + const char *path = janet_getcstring(argv, 0); +#ifdef JANET_WINDOWS + int res = _chmod(path, janet_encode_permissions(argv, 1)); +#else + int res = chmod(path, janet_encode_permissions(argv, 1)); +#endif + if (-1 == res) janet_panicf("%s: %s", strerror(errno), path); + return janet_wrap_nil(); +} + static Janet os_dir(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); const char *dir = janet_getcstring(argv, 0); @@ -1007,7 +1072,7 @@ static const JanetReg os_cfuns[] = { " only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n" "\t:dev - the device that the file is on\n" "\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n" - "\t:permissions - A unix permission string like \"rwx--x--x\"\n" + "\t:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n" "\t:uid - File uid\n" "\t:gid - File gid\n" "\t:nlink - number of links to file\n" @@ -1019,6 +1084,14 @@ static const JanetReg os_cfuns[] = { "\t:changed - timestamp when file last chnaged (permissions changed)\n" "\t:modified - timestamp when file last modified (content changed)\n") }, + { + "os/chmod", os_chmod, + JDOC("(os/chmod path mode)\n\n" + "Change file permissions, where mode is a permission string as returned by " + "os/stat, or an integer. " + "When mode is an integer, it is interpreted as a unix permission value, best specified in octal, like " + "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions. Returns nil.") + }, { "os/touch", os_touch, JDOC("(os/touch path &opt actime modtime)\n\n" From c0746155509e76f5d88dce41a9a010e8e0f09ae2 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 Mar 2020 12:00:11 -0500 Subject: [PATCH 008/107] Revert to 9 char permission strings on windows. --- src/core/os.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 9b96b74d..b719d239 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -739,10 +739,10 @@ static Janet os_remove(int32_t argc, Janet *argv) { #ifdef JANET_WINDOWS static const uint8_t *janet_decode_permissions(unsigned short m) { - uint8_t flags[3] = {0}; - flags[0] = (m & S_IREAD) ? 'r' : '-'; - flags[1] = (m & S_IWRITE) ? 'w' : '-'; - flags[2] = (m & S_IEXEC) ? 'x' : '-'; + uint8_t flags[9] = {0}; + flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-'; + flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-'; + flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-'; return janet_string(flags, sizeof(flags)); } From 4a05b4556ea8b39c018310f3c8588579bae06e2e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 Mar 2020 12:02:31 -0500 Subject: [PATCH 009/107] Fix MSVC build warning. --- src/core/os.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index b719d239..5a674ae2 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -929,10 +929,11 @@ static Janet os_stat(int32_t argc, Janet *argv) { } /* Build result */ - struct stat st; #ifdef JANET_WINDOWS + struct _stat st; int res = _stat(path, &st); #else + struct stat st; int res = stat(path, &st); #endif if (-1 == res) { From 635ae3a523f68f2f25c03592137f360f290656ac Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Tue, 17 Mar 2020 11:02:49 +1300 Subject: [PATCH 010/107] Properly export u64_type --- src/include/janet.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/include/janet.h b/src/include/janet.h index 50f772a8..7169f0b2 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1613,7 +1613,7 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n); #ifdef JANET_INT_TYPES extern JANET_API const JanetAbstractType janet_s64_type; -extern JANET_API const JanetAbstractType janet_s64_type; +extern JANET_API const JanetAbstractType janet_u64_type; typedef enum { JANET_INT_NONE, From fac47e8ecb550557ee2caa6cedd3545a5a281b03 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 17 Mar 2020 18:55:32 -0500 Subject: [PATCH 011/107] When marshalling a closure, try to detach funcenvs If possible, this will reduce the need to marshal fibers in many cases. Also add this logic to the GC so holding a closure that originally came from a fiber that crashed does not cause that fiber to hang around forever. --- src/core/fiber.c | 18 ++++++++++++++++++ src/core/fiber.h | 1 + src/core/gc.c | 4 ++++ src/core/marsh.c | 1 + 4 files changed, 24 insertions(+) diff --git a/src/core/fiber.c b/src/core/fiber.c index 6a4c140c..5370e7a5 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -230,6 +230,24 @@ static void janet_env_detach(JanetFuncEnv *env) { } } +/* Detach a fiber from the env if the target fiber has stopped mutating */ +void janet_env_maybe_detach(JanetFuncEnv *env) { + /* Check for detachable closure envs */ + if (env->offset) { + JanetFiberStatus s = janet_fiber_status(env->as.fiber); + int isFinished = s == JANET_STATUS_DEAD || + s == JANET_STATUS_ERROR || + s == JANET_STATUS_USER0 || + s == JANET_STATUS_USER1 || + s == JANET_STATUS_USER2 || + s == JANET_STATUS_USER3 || + s == JANET_STATUS_USER4; + if (isFinished) { + janet_env_detach(env); + } + } +} + /* Create a tail frame for a function */ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) { int32_t i; diff --git a/src/core/fiber.h b/src/core/fiber.h index 8afbe3f7..50daf0f1 100644 --- a/src/core/fiber.h +++ b/src/core/fiber.h @@ -73,5 +73,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func); int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func); void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun); void janet_fiber_popframe(JanetFiber *fiber); +void janet_env_maybe_detach(JanetFuncEnv *env); #endif diff --git a/src/core/gc.c b/src/core/gc.c index ba3e3400..1f0a551a 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -27,6 +27,7 @@ #include "symcache.h" #include "gc.h" #include "util.h" +#include "fiber.h" #endif struct JanetScratch { @@ -189,6 +190,9 @@ static void janet_mark_funcenv(JanetFuncEnv *env) { if (janet_gc_reachable(env)) return; janet_gc_mark(env); + /* If closure env references a dead fiber, we can just copy out the stack frame we need so + * we don't need to keep around the whole dead fiber. */ + janet_env_maybe_detach(env); if (env->offset) { /* On stack */ janet_mark_fiber(env->as.fiber); diff --git a/src/core/marsh.c b/src/core/marsh.c index 1af1ba9f..b2bb15c2 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -184,6 +184,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { } } janet_v_push(st->seen_envs, env); + janet_env_maybe_detach(env); pushint(st, env->offset); pushint(st, env->length); if (env->offset) { From de4f8f9aaf61f0b794f1fcbd24cd6270cfd49ca4 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 17 Mar 2020 20:53:11 -0500 Subject: [PATCH 012/107] Marshal alive fibers in func envs as detached. This will help with marshaling fibers. --- src/core/marsh.c | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index b2bb15c2..27394547 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -184,16 +184,24 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { } } janet_v_push(st->seen_envs, env); - janet_env_maybe_detach(env); - pushint(st, env->offset); - pushint(st, env->length); - if (env->offset) { - /* On stack variant */ - marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1); - } else { - /* Off stack variant */ + if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) { + pushint(st, 0); + pushint(st, env->length); + Janet *values = env->as.fiber->data + env->offset; for (int32_t i = 0; i < env->length; i++) - marshal_one(st, env->as.values[i], flags + 1); + marshal_one(st, values[i], flags + 1); + } else { + janet_env_maybe_detach(env); + pushint(st, env->offset); + pushint(st, env->length); + if (env->offset) { + /* On stack variant */ + marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1); + } else { + /* Off stack variant */ + for (int32_t i = 0; i < env->length; i++) + marshal_one(st, env->as.values[i], flags + 1); + } } } From 7c4ffe9b9a081bb06fda019c81db9901c48bdb76 Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Wed, 18 Mar 2020 15:40:41 +1300 Subject: [PATCH 013/107] Add test cases for closure edge cases. --- test/suite8.janet | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/test/suite8.janet b/test/suite8.janet index 092c6d2e..1b94a458 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -139,4 +139,40 @@ # chr (assert (= (chr "a") 97) "chr 1") +# Detaching closure over non resumable fiber. +(do + (defn f1 + [a] + (defn f1 [] (++ (a 0))) + (defn f2 [] (++ (a 0))) + (error [f1 f2])) + (def [_ [f1 f2]] (protect (f1 @[0]))) + # At time of writing, mark phase can detach closure envs. + (gccollect) + (assert (= 1 (f1)) "detach-non-resumable-closure 1") + (assert (= 2 (f2)) "detach-non-resumable-closure 2")) + +# Marshal closure over non resumable fiber. +(do + (defn f1 + [a] + (defn f1 [] (++ (a 0))) + (defn f2 [] (++ (a 0))) + (error [f1 f2])) + (def [_ tup] (protect (f1 @[0]))) + (def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict)) + (assert (= 1 (f1)) "marshal-non-resumable-closure 1") + (assert (= 2 (f2)) "marshal-non-resumable-closure 2")) + +# Marshal closure over currently alive fiber. +(do + (defn f1 + [a] + (defn f1 [] (++ (a 0))) + (defn f2 [] (++ (a 0))) + (marshal [f1 f2] make-image-dict)) + (def [f1 f2] (unmarshal (f1 @[0]) load-image-dict)) + (assert (= 1 (f1)) "marshal-live-closure 1") + (assert (= 2 (f2)) "marshal-live-closure 2")) + (end-suite) From b0d8369534c12853aaf36958ffd042d4634fef19 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 09:30:10 -0500 Subject: [PATCH 014/107] Increase reference accuracy of on-stack close envs. Using a bitset to indicate which stack values are upvalues, we can more accurately track when a reference to a stack value persists after the stack frame exits. --- CHANGELOG.md | 2 +- src/core/bytecode.c | 1 + src/core/compile.c | 22 +++++++++++++++ src/core/compile.h | 5 +++- src/core/fiber.c | 18 +++++++++++-- src/core/gc.c | 1 + src/core/marsh.c | 66 +++++++++++++++++++++++++++++++++------------ src/include/janet.h | 2 ++ test/suite8.janet | 6 +++++ 9 files changed, 102 insertions(+), 21 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6e1f43a7..17f88a26 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. - Add `os/chmod`. - Add `chr` macro. - Allow `_` in the `match` macro to match anything without creating a binding - or doing unification. + or doing unification. Also change behavior of matching nil. - Add `:range-to` and `:down-to` verbs in the `loop` macro. - Fix `and` and `or` macros returning nil instead of false in some cases. - Allow matching successfully against nil values in the `match` macro. diff --git a/src/core/bytecode.c b/src/core/bytecode.c index 1b40df28..9c84a457 100644 --- a/src/core/bytecode.c +++ b/src/core/bytecode.c @@ -212,6 +212,7 @@ JanetFuncDef *janet_funcdef_alloc(void) { def->environments = NULL; def->constants = NULL; def->bytecode = NULL; + def->closure_bitset = NULL; def->flags = 0; def->slotcount = 0; def->arity = 0; diff --git a/src/core/compile.c b/src/core/compile.c index b95e0096..5d74536c 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -102,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name) scope.bytecode_start = janet_v_count(c->buffer); scope.flags = flags; scope.parent = c->scope; + janetc_regalloc_init(&scope.ua); /* Inherit slots */ if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) { janetc_regalloc_clone(&scope.ra, &(c->scope->ra)); @@ -149,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) { janet_v_free(oldscope->envs); janet_v_free(oldscope->defs); janetc_regalloc_deinit(&oldscope->ra); + janetc_regalloc_deinit(&oldscope->ua); /* Update pointer */ if (newscope) newscope->child = NULL; @@ -236,6 +238,11 @@ found: scope = scope->parent; janet_assert(scope, "invalid scopes"); scope->flags |= JANET_SCOPE_ENV; + + /* In the function scope, allocate the slot as an upvalue */ + janetc_regalloc_touch(&scope->ua, ret.index); + + /* Iterate through child scopes and make sure environment is propagated */ scope = scope->child; /* Propagate env up to current scope */ @@ -737,6 +744,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV; } + /* Copy upvalue bitset */ + if (scope->ua.count) { + /* Number of u32s we need to create a bitmask for all slots */ + int32_t numchunks = (def->slotcount + 31) >> 5; + uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks); + if (NULL == chunks) { + JANET_OUT_OF_MEMORY; + } + memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks); + /* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */ + if (scope->ua.count > 7) chunks[7] &= 0xFFFFU; + def->closure_bitset = chunks; + def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET; + } + /* Pop the scope */ janetc_popscope(c); diff --git a/src/core/compile.h b/src/core/compile.h index 903e9beb..3f53da58 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -127,7 +127,10 @@ struct JanetScope { /* Regsiter allocator */ JanetcRegisterAllocator ra; - /* Referenced closure environents. The values at each index correspond + /* Upvalue allocator */ + JanetcRegisterAllocator ua; + + /* Referenced closure environments. The values at each index correspond * to which index to get the environment from in the parent. The environment * that corresponds to the direct parent's stack will always have value 0. */ int32_t *envs; diff --git a/src/core/fiber.c b/src/core/fiber.c index 5370e7a5..ab45f58a 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -218,13 +218,27 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) { static void janet_env_detach(JanetFuncEnv *env) { /* Check for closure environment */ if (env) { - size_t s = sizeof(Janet) * (size_t) env->length; + int32_t len = env->length; + size_t s = sizeof(Janet) * (size_t) len; Janet *vmem = malloc(s); janet_vm_next_collection += (uint32_t) s; if (NULL == vmem) { JANET_OUT_OF_MEMORY; } - safe_memcpy(vmem, env->as.fiber->data + env->offset, s); + Janet *values = env->as.fiber->data + env->offset; + safe_memcpy(vmem, values, s); + uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset; + if (bitset) { + /* Clear unneeded references in closure environment */ + for (int32_t i = 0; i < len; i += 32) { + uint32_t mask = ~(bitset[i >> 5]); + int32_t maxj = i + 32 > len ? len : i + 32; + for (int32_t j = i; j < maxj; j++) { + if (mask & 1) vmem[j] = janet_wrap_nil(); + mask >>= 1; + } + } + } env->offset = 0; env->as.values = vmem; } diff --git a/src/core/gc.c b/src/core/gc.c index 1f0a551a..5fc491bb 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -309,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) { free(def->constants); free(def->bytecode); free(def->sourcemap); + free(def->closure_bitset); } break; } diff --git a/src/core/marsh.c b/src/core/marsh.c index 27394547..d6d6353c 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -188,8 +188,14 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { pushint(st, 0); pushint(st, env->length); Janet *values = env->as.fiber->data + env->offset; - for (int32_t i = 0; i < env->length; i++) - marshal_one(st, values[i], flags + 1); + uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset; + for (int32_t i = 0; i < env->length; i++) { + if (1 & (bitset[i >> 5] >> (i & 0x1F))) { + marshal_one(st, values[i], flags + 1); + } else { + pushbyte(st, LB_NIL); + } + } } else { janet_env_maybe_detach(env); pushint(st, env->offset); @@ -214,6 +220,16 @@ static void janet_func_addflags(JanetFuncDef *def) { if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP; } +/* Marshal a sequence of u32s */ +static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) { + for (int32_t i = 0; i < n; i++) { + pushbyte(st, u32s[i] & 0xFF); + pushbyte(st, (u32s[i] >> 8) & 0xFF); + pushbyte(st, (u32s[i] >> 16) & 0xFF); + pushbyte(st, (u32s[i] >> 24) & 0xFF); + } +} + /* Marshal a function def */ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { MARSH_STACKCHECK; @@ -248,12 +264,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { marshal_one(st, def->constants[i], flags); /* marshal the bytecode */ - for (int32_t i = 0; i < def->bytecode_length; i++) { - pushbyte(st, def->bytecode[i] & 0xFF); - pushbyte(st, (def->bytecode[i] >> 8) & 0xFF); - pushbyte(st, (def->bytecode[i] >> 16) & 0xFF); - pushbyte(st, (def->bytecode[i] >> 24) & 0xFF); - } + janet_marshal_u32s(st, def->bytecode, def->bytecode_length); /* marshal the environments if needed */ for (int32_t i = 0; i < def->environments_length; i++) @@ -273,6 +284,11 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { current = map.line; } } + + /* Marshal closure bitset, if needed */ + if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) { + janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5)); + } } #define JANET_FIBER_FLAG_HASCHILD (1 << 29) @@ -716,6 +732,20 @@ static const uint8_t *unmarshal_one_env( return data; } +/* Unmarshal a series of u32s */ +static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) { + for (int32_t i = 0; i < n; i++) { + MARSH_EOS(st, data + 3); + into[i] = + (uint32_t)(data[0]) | + ((uint32_t)(data[1]) << 8) | + ((uint32_t)(data[2]) << 16) | + ((uint32_t)(data[3]) << 24); + data += 4; + } + return data; +} + /* Unmarshal a funcdef */ static const uint8_t *unmarshal_one_def( UnmarshalState *st, @@ -739,6 +769,7 @@ static const uint8_t *unmarshal_one_def( def->bytecode_length = 0; def->name = NULL; def->source = NULL; + def->closure_bitset = NULL; janet_v_push(st->lookup_defs, def); /* Set default lengths to zero */ @@ -794,15 +825,7 @@ static const uint8_t *unmarshal_one_def( if (!def->bytecode) { JANET_OUT_OF_MEMORY; } - for (int32_t i = 0; i < bytecode_length; i++) { - MARSH_EOS(st, data + 3); - def->bytecode[i] = - (uint32_t)(data[0]) | - ((uint32_t)(data[1]) << 8) | - ((uint32_t)(data[2]) << 16) | - ((uint32_t)(data[3]) << 24); - data += 4; - } + data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length); def->bytecode_length = bytecode_length; /* Unmarshal environments */ @@ -849,6 +872,15 @@ static const uint8_t *unmarshal_one_def( def->sourcemap = NULL; } + /* Unmarshal closure bitset if needed */ + if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) { + def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount); + if (NULL == def->closure_bitset) { + JANET_OUT_OF_MEMORY; + } + data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5); + } + /* Validate */ if (janet_verify(def)) janet_panic("funcdef has invalid bytecode"); diff --git a/src/include/janet.h b/src/include/janet.h index 7169f0b2..6d5b7de0 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -805,6 +805,7 @@ struct JanetAbstractHead { #define JANET_FUNCDEF_FLAG_HASENVS 0x400000 #define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000 #define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000 +#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000 #define JANET_FUNCDEF_FLAG_TAG 0xFFFF /* Source mapping structure for a bytecode instruction */ @@ -820,6 +821,7 @@ struct JanetFuncDef { Janet *constants; JanetFuncDef **defs; uint32_t *bytecode; + uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */ /* Various debug information */ JanetSourceMapping *sourcemap; diff --git a/test/suite8.janet b/test/suite8.janet index 1b94a458..580cd3be 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -175,4 +175,10 @@ (assert (= 1 (f1)) "marshal-live-closure 1") (assert (= 2 (f2)) "marshal-live-closure 2")) +(do + (var a 1) + (defn b [x] (+ a x)) + (def c (unmarshal (marshal b))) + (assert (= 2 (c 1)) "marshal-on-stack-closure 1")) + (end-suite) From 381dd1ce98f0d1caab73ee9ae6d7a9cf9d597c6f Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Mon, 9 Mar 2020 17:14:45 +0100 Subject: [PATCH 015/107] Add os/lstat. --- src/core/os.c | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 5a674ae2..c05c2287 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -911,7 +911,7 @@ static const struct OsStatGetter os_stat_getters[] = { {NULL, NULL} }; -static Janet os_stat(int32_t argc, Janet *argv) { +static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); const char *path = janet_getcstring(argv, 0); JanetTable *tab = NULL; @@ -930,11 +930,17 @@ static Janet os_stat(int32_t argc, Janet *argv) { /* Build result */ #ifdef JANET_WINDOWS + (void) do_lstat; struct _stat st; int res = _stat(path, &st); #else struct stat st; - int res = stat(path, &st); + int res; + if (do_lstat) { + res = lstat(path, &st); + } else { + res = stat(path, &st); + } #endif if (-1 == res) { return janet_wrap_nil(); @@ -957,6 +963,14 @@ static Janet os_stat(int32_t argc, Janet *argv) { } } +static Janet os_stat(int32_t argc, Janet *argv) { + return os_stat_or_lstat(0, argc, argv); +} + +static Janet os_lstat(int32_t argc, Janet *argv) { + return os_stat_or_lstat(1, argc, argv); +} + static Janet os_chmod(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); const char *path = janet_getcstring(argv, 0); @@ -1085,6 +1099,11 @@ static const JanetReg os_cfuns[] = { "\t:changed - timestamp when file last chnaged (permissions changed)\n" "\t:modified - timestamp when file last modified (content changed)\n") }, + { + "os/lstat", os_lstat, + JDOC("(os/lstat path &opt tab|key)\n\n" + "Like os/stat, but don't follow symlinks.\n") + }, { "os/chmod", os_chmod, JDOC("(os/chmod path mode)\n\n" From 6e678994011152275f4ea7c6872612ce8b047d7f Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Mon, 9 Mar 2020 17:34:30 +0100 Subject: [PATCH 016/107] Add os/readlink. --- src/core/os.c | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/core/os.c b/src/core/os.c index c05c2287..18d652f9 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -32,6 +32,7 @@ #include #include #include +#include #include #include #include @@ -737,6 +738,23 @@ static Janet os_remove(int32_t argc, Janet *argv) { return janet_wrap_nil(); } +static Janet os_readlink(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); +#ifdef JANET_WINDOWS + (void) argc; + (void) argv; + janet_panic("os/readlink not supported on Windows"); + return janet_wrap_nil(); +#else + static char buffer[PATH_MAX]; + const char *path = janet_getcstring(argv, 0); + ssize_t len = readlink(path, buffer, sizeof buffer); + if (len < 0 || (size_t)len >= sizeof buffer) + janet_panicf("%s: %s", strerror(errno), path); + return janet_stringv((const uint8_t *)buffer, len); +#endif +} + #ifdef JANET_WINDOWS static const uint8_t *janet_decode_permissions(unsigned short m) { uint8_t flags[9] = {0}; @@ -1145,6 +1163,11 @@ static const JanetReg os_cfuns[] = { "Create a symlink from oldpath to newpath. The 3 optional paramater " "enables a hard link over a soft link. Does not work on Windows.") }, + { + "os/readlink", os_readlink, + JDOC("(os/readlink path)\n\n" + "Read the contents of a symbolic link. Does not work on Windows.\n") + }, { "os/execute", os_execute, JDOC("(os/execute args &opts flags env)\n\n" From f013c6e48dd987b9138a2219f121898022673fd7 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Wed, 18 Mar 2020 19:49:23 +0100 Subject: [PATCH 017/107] os/date: check the second argument truthy, not the third. --- src/core/os.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 5a674ae2..2451b3ed 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -627,7 +627,7 @@ static Janet os_date(int32_t argc, Janet *argv) { } else { time(&t); } - if (argc >= 2 && janet_truthy(argv[2])) { + if (argc >= 2 && janet_truthy(argv[1])) { /* local time */ #ifdef JANET_WINDOWS localtime_s(&t_infos, &t); From efdb13f0c75cbfce5d6f7be6c05ddcac025d5dff Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Wed, 18 Mar 2020 19:50:26 +0100 Subject: [PATCH 018/107] os/date: allow negative timestamps. Why not? Even on 32-bit time_t systems this lasts until late 1901. --- src/core/os.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 2451b3ed..f12c8bfd 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -621,8 +621,6 @@ static Janet os_date(int32_t argc, Janet *argv) { struct tm *t_info = NULL; if (argc) { int64_t integer = janet_getinteger64(argv, 0); - if (integer < 0) - janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]); t = (time_t) integer; } else { time(&t); From 3ee43c3abb903efc5b13f89967c888c4aa12a2e9 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Wed, 18 Mar 2020 19:52:25 +0100 Subject: [PATCH 019/107] add os/mktime, an inverse to os/date. --- src/core/os.c | 77 +++++++++++++++++++++++++++++++++++++++++++++++ test/suite7.janet | 17 +++++++++++ 2 files changed, 94 insertions(+) diff --git a/src/core/os.c b/src/core/os.c index f12c8bfd..d74d0396 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -69,6 +69,13 @@ extern char **environ; void arc4random_buf(void *buf, size_t nbytes); #endif +/* Not POSIX, but all Unixes but Solaris have this function. */ +#if defined(JANET_POSIX) && !defined(__sun) +time_t timegm(struct tm *tm); +#elif defined(JANET_WINDOWS) +#define timegm _mkgmtime +#endif + /* Access to some global variables should be synchronized if not in single threaded mode, as * setenv/getenv are not thread safe. */ #ifdef JANET_THREADS @@ -656,6 +663,66 @@ static Janet os_date(int32_t argc, Janet *argv) { return janet_wrap_struct(janet_struct_end(st)); } +static int64_t entry_getint(Janet env_entry, char *field) { + Janet i; + if (janet_checktype(env_entry, JANET_TABLE)) { + JanetTable *entry = janet_unwrap_table(env_entry); + i = janet_table_get(entry, janet_ckeywordv(field)); + } else if (janet_checktype(env_entry, JANET_STRUCT)) { + const JanetKV *entry = janet_unwrap_struct(env_entry); + i = janet_struct_get(entry, janet_ckeywordv(field)); + } else { + return 0; + } + + if (janet_checktype(i, JANET_NIL)) { + return 0; + } + + if (!janet_checkint64(i)) { + janet_panicf("bad slot :%s, expected 64 bit signed integer, got %v", + field, i); + } + + return (int64_t)janet_unwrap_number(i); +} + +static Janet os_mktime(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 2); + time_t t; + struct tm t_info = { 0 }; + + if (!janet_checktype(argv[0], JANET_TABLE) && + !janet_checktype(argv[0], JANET_STRUCT)) + janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY); + + t_info.tm_sec = entry_getint(argv[0], "seconds"); + t_info.tm_min = entry_getint(argv[0], "minutes"); + t_info.tm_hour = entry_getint(argv[0], "hours"); + t_info.tm_mday = entry_getint(argv[0], "month-day") + 1; + t_info.tm_mon = entry_getint(argv[0], "month"); + t_info.tm_year = entry_getint(argv[0], "year") - 1900; + + if (argc >= 2 && janet_truthy(argv[1])) { + /* local time */ + t = mktime(&t_info); + } else { + /* utc time */ +#ifdef __sun + janet_panic("os/mktime UTC not supported on Solaris"); + return janet_wrap_nil(); +#else + t = timegm(&t_info); +#endif + } + + if (t == (time_t)-1) { + janet_panicf("%s", strerror(errno)); + } + + return janet_wrap_number((double)t); +} + static Janet os_link(int32_t argc, Janet *argv) { janet_arity(argc, 2, 3); #ifdef JANET_WINDOWS @@ -1152,6 +1219,16 @@ static const JanetReg os_cfuns[] = { "Get the current time expressed as the number of seconds since " "January 1, 1970, the Unix epoch. Returns a real number.") }, + { + "os/mktime", os_mktime, + JDOC("(os/mktime date-struct &opt local)\n\n" + "Get the broken down date-struct time expressed as the number " + " of seconds since January 1, 1970, the Unix epoch. " + "Returns a real number. " + "Date is given in UTC unless local is truthy, in which case the " + "date is computed for the local timezone.\n\n" + "Inverse function to os/date.") + }, { "os/clock", os_clock, JDOC("(os/clock)\n\n" diff --git a/test/suite7.janet b/test/suite7.janet index cdffc3c9..3e8d19bb 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -226,6 +226,23 @@ :week-day 3} (os/date 1388608200)) "os/date") +# OS mktime test + +(assert (= 1388608200 (os/mktime {:year-day 0 + :minutes 30 + :month 0 + :dst false + :seconds 0 + :year 2014 + :month-day 0 + :hours 20 + :week-day 3})) "os/mktime") + +(def now (os/time)) +(assert (= (os/mktime (os/date now)) now) "UTC os/mktime") +(assert (= (os/mktime (os/date now true) true) now) "local os/mktime") +(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values") + # Appending buffer to self (with-dyns [:out @""] From 3b5183a74ebaa58158305dfa16aa43205e11e35c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 17:46:02 -0500 Subject: [PATCH 020/107] Fixes #316: os/execute should return non-zero on signals Behave more like shells, and catch segfaults. --- src/core/os.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 5a674ae2..ca997bbb 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -401,7 +401,16 @@ static Janet os_execute(int32_t argc, Janet *argv) { } os_execute_cleanup(envp, child_argv); - return janet_wrap_integer(WEXITSTATUS(status)); + /* 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 } From 7590cfc610f08fbc7f8c1fb5ec78cdd5adb0f031 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 18:36:41 -0500 Subject: [PATCH 021/107] Update meson build file to try and fix LGTM. --- meson.build | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/meson.build b/meson.build index 41cf36d1..2aebc8d2 100644 --- a/meson.build +++ b/meson.build @@ -160,7 +160,7 @@ janetc = custom_target('janetc', output : 'janet.c', capture : true, command : [ - janet_boot, '@CURRENT_SOURCE_DIR@', + janet_boot, meson.current_source_dir(), 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path ]) From 00450cd9db61435829738c301e2bff02bf3655d1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 21:15:50 -0500 Subject: [PATCH 022/107] try and remove warnings on windows, format os.c. --- src/core/os.c | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index a7a5c2e9..0df91afe 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -673,7 +673,13 @@ static Janet os_date(int32_t argc, Janet *argv) { return janet_wrap_struct(janet_struct_end(st)); } -static int64_t entry_getint(Janet env_entry, char *field) { +#ifdef JANET_WINDOWS +typedef int32_t timeint_t; +#else +typedef int64_t timeint_t; +#endif + +static timeint_t entry_getint(Janet env_entry, char *field) { Janet i; if (janet_checktype(env_entry, JANET_TABLE)) { JanetTable *entry = janet_unwrap_table(env_entry); @@ -689,12 +695,19 @@ static int64_t entry_getint(Janet env_entry, char *field) { return 0; } - if (!janet_checkint64(i)) { - janet_panicf("bad slot :%s, expected 64 bit signed integer, got %v", - field, i); +#ifdef JANET_WINDOWS + if (!janet_checkint(i)) { + janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v", + field, i); } +#else + if (!janet_checkint64(i)) { + janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v", + field, i); + } +#endif - return (int64_t)janet_unwrap_number(i); + return (timeint_t)janet_unwrap_number(i); } static Janet os_mktime(int32_t argc, Janet *argv) { @@ -703,8 +716,8 @@ static Janet os_mktime(int32_t argc, Janet *argv) { struct tm t_info = { 0 }; if (!janet_checktype(argv[0], JANET_TABLE) && - !janet_checktype(argv[0], JANET_STRUCT)) - janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY); + !janet_checktype(argv[0], JANET_STRUCT)) + janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY); t_info.tm_sec = entry_getint(argv[0], "seconds"); t_info.tm_min = entry_getint(argv[0], "minutes"); @@ -719,14 +732,14 @@ static Janet os_mktime(int32_t argc, Janet *argv) { } else { /* utc time */ #ifdef __sun - janet_panic("os/mktime UTC not supported on Solaris"); - return janet_wrap_nil(); + janet_panic("os/mktime UTC not supported on Solaris"); + return janet_wrap_nil(); #else t = timegm(&t_info); #endif } - if (t == (time_t)-1) { + if (t == (time_t) -1) { janet_panicf("%s", strerror(errno)); } From b76ff3bdfc8f6947248082d9346b71368fc4200c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 21:23:35 -0500 Subject: [PATCH 023/107] Fix omission of daylight savings time in mktime Since with daylight savings times, certain times are ambiguous (the hours before and after the switch), mktime needs to allow reading a dst flag. --- src/core/os.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/core/os.c b/src/core/os.c index 0df91afe..f6b2c597 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -673,6 +673,18 @@ static Janet os_date(int32_t argc, Janet *argv) { return janet_wrap_struct(janet_struct_end(st)); } +static int entry_getdst(Janet env_entry) { + if (janet_checktype(env_entry, JANET_TABLE)) { + JanetTable *entry = janet_unwrap_table(env_entry); + return janet_truthy(janet_table_get(entry, janet_ckeywordv("dst"))); + } else if (janet_checktype(env_entry, JANET_STRUCT)) { + const JanetKV *entry = janet_unwrap_struct(env_entry); + return janet_truthy(janet_struct_get(entry, janet_ckeywordv("dst"))); + } else { + return 0; + } +} + #ifdef JANET_WINDOWS typedef int32_t timeint_t; #else @@ -725,6 +737,7 @@ static Janet os_mktime(int32_t argc, Janet *argv) { t_info.tm_mday = entry_getint(argv[0], "month-day") + 1; t_info.tm_mon = entry_getint(argv[0], "month"); t_info.tm_year = entry_getint(argv[0], "year") - 1900; + t_info.tm_isdst = entry_getdst(argv[0]); if (argc >= 2 && janet_truthy(argv[1])) { /* local time */ From 665f4bf2485d4ae5de5d993c73ca495c5c442435 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 21:37:55 -0500 Subject: [PATCH 024/107] Remove windows MSVC warnings about _stat. --- src/core/os.c | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index f6b2c597..01b21fa2 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -953,62 +953,68 @@ static const uint8_t *janet_decode_mode(mode_t m) { } #endif +#ifdef JANET_WINDOWS +typedef struct _stat jstat_t; +#else +typedef struct stat jstat_t; +#endif + /* Getters */ -static Janet os_stat_dev(struct stat *st) { +static Janet os_stat_dev(jstat_t *st) { return janet_wrap_number(st->st_dev); } -static Janet os_stat_inode(struct stat *st) { +static Janet os_stat_inode(jstat_t *st) { return janet_wrap_number(st->st_ino); } -static Janet os_stat_mode(struct stat *st) { +static Janet os_stat_mode(jstat_t *st) { return janet_wrap_keyword(janet_decode_mode(st->st_mode)); } -static Janet os_stat_permissions(struct stat *st) { +static Janet os_stat_permissions(jstat_t *st) { return janet_wrap_string(janet_decode_permissions(st->st_mode)); } -static Janet os_stat_uid(struct stat *st) { +static Janet os_stat_uid(jstat_t *st) { return janet_wrap_number(st->st_uid); } -static Janet os_stat_gid(struct stat *st) { +static Janet os_stat_gid(jstat_t *st) { return janet_wrap_number(st->st_gid); } -static Janet os_stat_nlink(struct stat *st) { +static Janet os_stat_nlink(jstat_t *st) { return janet_wrap_number(st->st_nlink); } -static Janet os_stat_rdev(struct stat *st) { +static Janet os_stat_rdev(jstat_t *st) { return janet_wrap_number(st->st_rdev); } -static Janet os_stat_size(struct stat *st) { +static Janet os_stat_size(jstat_t *st) { return janet_wrap_number(st->st_size); } -static Janet os_stat_accessed(struct stat *st) { +static Janet os_stat_accessed(jstat_t *st) { return janet_wrap_number((double) st->st_atime); } -static Janet os_stat_modified(struct stat *st) { +static Janet os_stat_modified(jstat_t *st) { return janet_wrap_number((double) st->st_mtime); } -static Janet os_stat_changed(struct stat *st) { +static Janet os_stat_changed(jstat_t *st) { return janet_wrap_number((double) st->st_ctime); } #ifdef JANET_WINDOWS -static Janet os_stat_blocks(struct stat *st) { +static Janet os_stat_blocks(jstat_t *st) { return janet_wrap_number(0); } -static Janet os_stat_blocksize(struct stat *st) { +static Janet os_stat_blocksize(jstat_t *st) { return janet_wrap_number(0); } #else -static Janet os_stat_blocks(struct stat *st) { +static Janet os_stat_blocks(jstat_t *st) { return janet_wrap_number(st->st_blocks); } -static Janet os_stat_blocksize(struct stat *st) { +static Janet os_stat_blocksize(jstat_t *st) { return janet_wrap_number(st->st_blksize); } #endif struct OsStatGetter { const char *name; - Janet(*fn)(struct stat *st); + Janet(*fn)(jstat_t *st); }; static const struct OsStatGetter os_stat_getters[] = { @@ -1047,12 +1053,11 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) { } /* Build result */ + jstat_t st; #ifdef JANET_WINDOWS (void) do_lstat; - struct _stat st; int res = _stat(path, &st); #else - struct stat st; int res; if (do_lstat) { res = lstat(path, &st); From 3aca5502dcf158e9916aa8827dd2436c0bdf45ab Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 18 Mar 2020 22:22:03 -0500 Subject: [PATCH 025/107] Allow :dst to be nil to set tm_isdst to be -1. --- src/core/os.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 01b21fa2..4e14b6d5 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -674,14 +674,20 @@ static Janet os_date(int32_t argc, Janet *argv) { } static int entry_getdst(Janet env_entry) { + Janet v; if (janet_checktype(env_entry, JANET_TABLE)) { JanetTable *entry = janet_unwrap_table(env_entry); - return janet_truthy(janet_table_get(entry, janet_ckeywordv("dst"))); + v = janet_table_get(entry, janet_ckeywordv("dst")); } else if (janet_checktype(env_entry, JANET_STRUCT)) { const JanetKV *entry = janet_unwrap_struct(env_entry); - return janet_truthy(janet_struct_get(entry, janet_ckeywordv("dst"))); + v = janet_struct_get(entry, janet_ckeywordv("dst")); } else { - return 0; + v = janet_wrap_nil(); + } + if (janet_checktype(v, JANET_NIL)) { + return -1; + } else { + return janet_truthy(v); } } From 6a63b13d693c27170a3eb4d58ef5747be348d847 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 21 Mar 2020 16:18:40 -0500 Subject: [PATCH 026/107] Fix os/link docstring - Address #323 --- src/core/os.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 4e14b6d5..243141c7 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1271,8 +1271,8 @@ static const JanetReg os_cfuns[] = { { "os/link", os_link, JDOC("(os/link oldpath newpath &opt symlink)\n\n" - "Create a symlink from oldpath to newpath. The 3 optional paramater " - "enables a hard link over a soft link. Does not work on Windows.") + "Create a symlink from oldpath to newpath. The 3rd optional paramater " + "enables a symlink over a hard link. Does not work on Windows.") }, { "os/readlink", os_readlink, From 3d1de237f6a46af261c45d07d3ff9ce3ba46f458 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 24 Mar 2020 19:45:57 -0500 Subject: [PATCH 027/107] Several changes to the os module. - Add os/symlink - Add os/realpath --- CHANGELOG.md | 1 + src/boot/boot.janet | 1 + src/core/features.h | 4 ++++ src/core/os.c | 57 ++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 57 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 17f88a26..1dcc62ae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add `os/realpath` (Not supported on windows). - Add `os/chmod`. - Add `chr` macro. - Allow `_` in the `match` macro to match anything without creating a binding diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c9c2dcbc..3334b1f8 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2546,6 +2546,7 @@ (print "#define JANET_BUILD \"" janet/build "\"") (print ```#define JANET_AMALG```) (print ```#define _POSIX_C_SOURCE 200112L```) + (print ```#define _XOPEN_SOURCE 500```) (print ```#include "janet.h"```) (defn do-one-flie diff --git a/src/core/features.h b/src/core/features.h index cac3981f..94beffbe 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -29,4 +29,8 @@ #define _POSIX_C_SOURCE 200112L #endif +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE 500 +#endif + #endif diff --git a/src/core/os.c b/src/core/os.c index 243141c7..25ff59fb 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -775,9 +775,25 @@ static Janet os_link(int32_t argc, Janet *argv) { #else const char *oldpath = janet_getcstring(argv, 0); const char *newpath = janet_getcstring(argv, 1); - int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath); + int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath); if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath); - return janet_wrap_integer(res); + return janet_wrap_nil(); +#endif +} + +static Janet os_symlink(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); +#ifdef JANET_WINDOWS + (void) argc; + (void) argv; + janet_panic("os/symlink not supported on Windows"); + return janet_wrap_nil(); +#else + const char *oldpath = janet_getcstring(argv, 0); + const char *newpath = janet_getcstring(argv, 1); + int res = symlink(oldpath, newpath); + if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath); + return janet_wrap_nil(); #endif } @@ -789,7 +805,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) { #else int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH); #endif - return janet_wrap_boolean(res != -1); + if (res == 0) return janet_wrap_true(); + if (errno == EEXIST) return janet_wrap_false(); + janet_panicf("%s: %s", strerror(errno), path); } static Janet os_rmdir(int32_t argc, Janet *argv) { @@ -1158,6 +1176,21 @@ static Janet os_rename(int32_t argc, Janet *argv) { return janet_wrap_nil(); } +static Janet os_realpath(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); +#ifdef JANET_WINDOWS + (void) argv; + janet_panic("os/realpath not supported on Windows"); +#else + const char *src = janet_getcstring(argv, 0); + char *dest = realpath(src, NULL); + if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src); + Janet ret = janet_cstringv(dest); + free(dest); + return ret; +#endif +} + #endif /* JANET_REDUCED_OS */ static const JanetReg os_cfuns[] = { @@ -1256,7 +1289,8 @@ static const JanetReg os_cfuns[] = { "os/mkdir", os_mkdir, JDOC("(os/mkdir path)\n\n" "Create a new directory. The path will be relative to the current directory if relative, otherwise " - "it will be an absolute path.") + "it will be an absolute path. Returns true if the directory was create, false if the directoyr already exists, and " + "errors otherwise.") }, { "os/rmdir", os_rmdir, @@ -1271,8 +1305,13 @@ static const JanetReg os_cfuns[] = { { "os/link", os_link, JDOC("(os/link oldpath newpath &opt symlink)\n\n" - "Create a symlink from oldpath to newpath. The 3rd optional paramater " - "enables a symlink over a hard link. Does not work on Windows.") + "Create a symlink from oldpath to newpath, returning nil. The 3rd optional paramater " + "enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.") + }, + { + "os/symlink", os_symlink, + JDOC("(os/symlink oldpath newpath)\n\n" + "Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") }, { "os/readlink", os_readlink, @@ -1361,6 +1400,12 @@ static const JanetReg os_cfuns[] = { JDOC("(os/rename oldname newname)\n\n" "Rename a file on disk to a new path. Returns nil.") }, + { + "os/realpath", os_realpath, + JDOC("(os/realpath path)\n\n" + "Get the absolute path for a given path, resolving the relative path, following ../, ./, and symlinks. " + "Returns an absolute path as a string. Will raise an error on Windows.") + }, #endif {NULL, NULL, NULL} }; From 655633ef349101e8944c10aa17058a1f86dfab84 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 Mar 2020 18:00:15 -0500 Subject: [PATCH 028/107] Tweak docstring. --- src/core/os.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 25ff59fb..a895df3e 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1403,7 +1403,7 @@ static const JanetReg os_cfuns[] = { { "os/realpath", os_realpath, JDOC("(os/realpath path)\n\n" - "Get the absolute path for a given path, resolving the relative path, following ../, ./, and symlinks. " + "Get the absolute path for a given path, following ../, ./, and symlinks. " "Returns an absolute path as a string. Will raise an error on Windows.") }, #endif From e380c01dd1528d0857288b52567423259f02d951 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 Mar 2020 19:44:30 -0500 Subject: [PATCH 029/107] Add lockfiles to jpm. Add make-lockfile and load-lockfile commands. --- auxbin/jpm | 78 +++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 65 insertions(+), 13 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index a3efee68..158c0bea 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -194,7 +194,8 @@ (loop [k :keys currenv :when (keyword? k)] (put env k (currenv k))) (dofile path :env env :exit true) - (when-let [rules (env :rules)] (merge-into (getrules) rules))) + (when-let [rules (env :rules)] (merge-into (getrules) rules)) + env) # # OS and shell helpers @@ -251,11 +252,7 @@ If we can't create it, give a friendly error. Return true if created, false if existing. Throw an error if we can't create it." [dir] - (if (os/mkdir dir) - true - (if (os/stat dir :mode) - false - (error (string "Could not create " dir " - this could be a permission issue."))))) + (os/mkdir dir)) # # C Compilation @@ -607,7 +604,7 @@ int main(int argc, const char **argv) { (defn install-git "Install a bundle from git. If the bundle is already installed, the bundle is reinistalled (but not rebuilt if artifacts are cached)." - [repotab &opt recurse] + [repotab &opt recurse no-deps] (def repo (if (string? repotab) repotab (repotab :repo))) (def tag (unless (string? repotab) (repotab :tag))) # prevent infinite recursion (very unlikely, but consider @@ -639,24 +636,22 @@ int main(int argc, const char **argv) { (rimraf module-dir) (error (string "could not clone git dependency " repo)))) (def olddir (os/cwd)) - (try + (os/cd module-dir) + (defer (os/cd olddir) (with-dyns [:rules @{} :modpath (abspath (dyn :modpath JANET_MODPATH)) :headerpath (abspath (dyn :headerpath JANET_HEADERPATH)) :libpath (abspath (dyn :libpath JANET_LIBPATH)) :binpath (abspath (dyn :binpath JANET_BINPATH))] - (os/cd module-dir) (unless fresh (os/execute ["git" "pull" "origin" "master"] :p)) (when tag (os/execute ["git" "reset" "--hard" tag] :p)) (os/execute ["git" "submodule" "update" "--init" "--recursive"] :p) (import-rules "./project.janet") - (do-rule "install-deps") + (unless no-deps (do-rule "install-deps")) (do-rule "build") - (do-rule "install")) - ([err] (print "Error building git repository dependency: " err))) - (os/cd olddir)) + (do-rule "install")))) (defn install-rule "Add install and uninstall rule for moving file from src into destdir." @@ -669,6 +664,54 @@ int main(int argc, const char **argv) { (mkdir destdir) (copy src destdir))) +(defn- pslurp + "Like slurp, but with file/popen instead file/open. Also trims output" + [cmd] + (string/trim (with [f (file/popen cmd)] (:read f :all)))) + +(defn- make-lockfile + [&opt filename] + (default filename "lockfile.janet") + (def cwd (os/cwd)) + (def packages @[]) + (os/cd (find-cache)) + (defer (os/cd cwd) + (each repo (os/dir ".") + (os/cd repo) + (def sha (pslurp "git rev-parse HEAD")) + (def url (pslurp "git remote get-url origin")) + (def deps + (with-dyns [:rules @{}] + (def env (import-rules "./project.janet")) + ((env :project) :dependencies))) + (array/push packages {:repo url :sha sha :deps (or deps [])}) + (os/cd ".."))) + # Put in correct order, such that a package is preceded by all of its dependencies + (def ordered-packages @[]) + (def resolved @{}) + (while (< (length ordered-packages) (length packages)) + (each p packages + (def {:repo r :sha s :deps d} p) + (unless (resolved r) + (when (all resolved d) + (array/push ordered-packages p) + (put resolved r true))))) + # Write to file + (with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages)))) + +(defn- load-lockfile + [&opt filename] + (default filename "lockfile.janet") + (def locksource (slurp filename)) + (def lockarray + (let [p (parser/new)] + (:consume p locksource) + (if (= :error (:status p)) + (error (string "Could not parse lockfile " filename ": " (parser/error p)))) + (:produce p))) + (each {:repo url :sha sha} lockarray + (install-git {:repo url :tag sha} nil true))) + # # Declaring Artifacts - used in project.janet, targets specifically # tailored for janet. @@ -815,6 +858,7 @@ int main(int argc, const char **argv) { (print "generating " manifest "...") (mkdir manifests) (spit manifest (string (string/join installed-files "\n") "\n"))) + (phony "install" ["uninstall" "build" "manifest"] (when (dyn :test) (do-rule "test")) @@ -888,6 +932,12 @@ Subcommands are: rules : list rules available with run. 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 + 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 + name is lockfile.janet. + load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The + default lockfile name is lockfile.janet. Keys are: --modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) @@ -974,6 +1024,8 @@ Flags are: "rules" list-rules "update-pkgs" update-pkgs "uninstall" uninstall-cmd + "make-lockfile" make-lockfile + "load-lockfile" load-lockfile "quickbin" quickbin}) (def- args (tuple/slice (dyn :args) 1)) From b8c1c1c144e40e58832803258e21c7bd8e73be34 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 Mar 2020 20:55:04 -0500 Subject: [PATCH 030/107] Get lockfile info from manifest, not cache. Make manifest files track more information. Use jdn to store manifest files, as well as repo url and sha. --- auxbin/jpm | 74 +++++++++++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 34 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index 158c0bea..b295f86d 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -551,6 +551,15 @@ int main(int argc, const char **argv) { # Public utilities # +(defn parse + "Read a string of Janet source and parse out the first expression." + [src] + (let [p (parser/new)] + (:consume p src) + (if (= :error (:status p)) + (error (string "Could not parse: " (parser/error p)))) + (:produce p))) + (defn find-manifest-dir "Get the path to the directory containing manifests for installed packages." @@ -560,7 +569,7 @@ int main(int argc, const char **argv) { (defn find-manifest "Get the full path of a manifest file given a package name." [name] - (string (find-manifest-dir) sep name ".txt")) + (string (find-manifest-dir) sep name ".jdn")) (defn find-cache "Return the path to the global cache." @@ -572,17 +581,14 @@ int main(int argc, const char **argv) { "Uninstall bundle named name" [name] (def manifest (find-manifest name)) - (def f (file/open manifest :r)) - (unless f (print manifest " does not exist") (break)) - (loop [line :iterate (:read f :line)] - (def path ((string/split "\n" line) 0)) - (def path ((string/split "\r" path) 0)) - (print "removing " path) - (rm path)) - (:close f) - (print "removing " manifest) - (rm manifest) - (print "Uninstalled.")) + (when-with [f (file/open manifest)] + (def man (parse (:read f :all))) + (each path (get man :paths []) + (print "removing " path) + (rm path)) + (print "removing " manifest) + (rm manifest) + (print "Uninstalled."))) (defn- rimraf "Hard delete directory tree" @@ -636,13 +642,13 @@ int main(int argc, const char **argv) { (rimraf module-dir) (error (string "could not clone git dependency " repo)))) (def olddir (os/cwd)) - (os/cd module-dir) - (defer (os/cd olddir) + (try (with-dyns [:rules @{} :modpath (abspath (dyn :modpath JANET_MODPATH)) :headerpath (abspath (dyn :headerpath JANET_HEADERPATH)) :libpath (abspath (dyn :libpath JANET_LIBPATH)) :binpath (abspath (dyn :binpath JANET_BINPATH))] + (os/cd module-dir) (unless fresh (os/execute ["git" "pull" "origin" "master"] :p)) (when tag @@ -651,7 +657,9 @@ int main(int argc, const char **argv) { (import-rules "./project.janet") (unless no-deps (do-rule "install-deps")) (do-rule "build") - (do-rule "install")))) + (do-rule "install")) + ([err] (print "Error building git repository dependency: " err))) + (os/cd olddir)) (defn install-rule "Add install and uninstall rule for moving file from src into destdir." @@ -674,24 +682,21 @@ int main(int argc, const char **argv) { (default filename "lockfile.janet") (def cwd (os/cwd)) (def packages @[]) - (os/cd (find-cache)) + # Read installed modules from manifests + (os/cd (find-manifest-dir)) (defer (os/cd cwd) - (each repo (os/dir ".") - (os/cd repo) - (def sha (pslurp "git rev-parse HEAD")) - (def url (pslurp "git remote get-url origin")) - (def deps - (with-dyns [:rules @{}] - (def env (import-rules "./project.janet")) - ((env :project) :dependencies))) - (array/push packages {:repo url :sha sha :deps (or deps [])}) + (each man (os/dir ".") + (def package (parse slurp man)) + (if (or (not package :repo) (not package :sha)) + (print "Cannot add local package " man " to lockfile, skipping...") + (array/push packages package)) (os/cd ".."))) # Put in correct order, such that a package is preceded by all of its dependencies (def ordered-packages @[]) (def resolved @{}) (while (< (length ordered-packages) (length packages)) (each p packages - (def {:repo r :sha s :deps d} p) + (def {:repo r :sha s :dependencies d} p) (unless (resolved r) (when (all resolved d) (array/push ordered-packages p) @@ -702,13 +707,7 @@ int main(int argc, const char **argv) { (defn- load-lockfile [&opt filename] (default filename "lockfile.janet") - (def locksource (slurp filename)) - (def lockarray - (let [p (parser/new)] - (:consume p locksource) - (if (= :error (:status p)) - (error (string "Could not parse lockfile " filename ": " (parser/error p)))) - (:produce p))) + (def lockarray (parse (slurp filename))) (each {:repo url :sha sha} lockarray (install-git {:repo url :tag sha} nil true))) @@ -857,7 +856,14 @@ int main(int argc, const char **argv) { (phony "manifest" [] (print "generating " manifest "...") (mkdir manifests) - (spit manifest (string (string/join installed-files "\n") "\n"))) + (def sha (pslurp "git rev-parse HEAD")) + (def url (pslurp "git remote get-url origin")) + (def man + {:sha (if-not (empty? sha) sha) + :repo (if-not (empty? url) url) + :dependencies (array/slice (get meta :dependencies [])) + :paths installed-files}) + (spit manifest (string/format "%j\n" man))) (phony "install" ["uninstall" "build" "manifest"] (when (dyn :test) From 6721c70b9e2b5d30a71c355b48c4ed0f5be95b36 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 Mar 2020 21:01:54 -0500 Subject: [PATCH 031/107] Fix typo in jpm. --- auxbin/jpm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/auxbin/jpm b/auxbin/jpm index b295f86d..e1bebbe5 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -686,7 +686,7 @@ int main(int argc, const char **argv) { (os/cd (find-manifest-dir)) (defer (os/cd cwd) (each man (os/dir ".") - (def package (parse slurp man)) + (def package (parse (slurp man))) (if (or (not package :repo) (not package :sha)) (print "Cannot add local package " man " to lockfile, skipping...") (array/push packages package)) From 6e8aac984f74c5baacfdbc9c5e9820076934530b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 Mar 2020 21:06:45 -0500 Subject: [PATCH 032/107] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1dcc62ae..a3dccb50 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`. - Add `os/realpath` (Not supported on windows). - Add `os/chmod`. - Add `chr` macro. From d2d0300c7e5e6352212e7d16b5ace185c16eee14 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 26 Mar 2020 00:12:18 -0500 Subject: [PATCH 033/107] Remove use of cd in make-lockfile. --- auxbin/jpm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index e1bebbe5..94c1f6fe 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -683,14 +683,12 @@ int main(int argc, const char **argv) { (def cwd (os/cwd)) (def packages @[]) # Read installed modules from manifests - (os/cd (find-manifest-dir)) - (defer (os/cd cwd) - (each man (os/dir ".") - (def package (parse (slurp man))) - (if (or (not package :repo) (not package :sha)) - (print "Cannot add local package " man " to lockfile, skipping...") - (array/push packages package)) - (os/cd ".."))) + (def mdir (find-manifest-dir)) + (each man (os/dir mdir) + (def package (parse (slurp (string mdir sep man)))) + (if (or (not (package :repo)) (not (package :sha))) + (print "Cannot add local package " man " to lockfile, skipping...") + (array/push packages package))) # Put in correct order, such that a package is preceded by all of its dependencies (def ordered-packages @[]) (def resolved @{}) From a20ea702e2d0f63bca5bb9356afc94fcd52022ec Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 26 Mar 2020 00:34:34 -0500 Subject: [PATCH 034/107] Add infinite loop detection and complex deps. We needed to handle dependencies that had both a url and a tag component. --- auxbin/jpm | 10 ++++++++-- lockfile.janet | 1 + 2 files changed, 9 insertions(+), 2 deletions(-) create mode 100644 lockfile.janet diff --git a/auxbin/jpm b/auxbin/jpm index 94c1f6fe..7be76d58 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -693,12 +693,18 @@ int main(int argc, const char **argv) { (def ordered-packages @[]) (def resolved @{}) (while (< (length ordered-packages) (length packages)) + (var made-progress false) (each p packages (def {:repo r :sha s :dependencies d} p) + (def dep-urls (map |(if (string? $) $ ($ :repo)) d)) (unless (resolved r) - (when (all resolved d) + (when (all resolved dep-urls) (array/push ordered-packages p) - (put resolved r true))))) + (set made-progress true) + (put resolved r true)))) + (unless made-progress + (error (string/format "could not resolve package order for: %j" + (filter (complement resolved) (map |($ :repo) packages)))))) # Write to file (with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages)))) diff --git a/lockfile.janet b/lockfile.janet new file mode 100644 index 00000000..f18f7a9a --- /dev/null +++ b/lockfile.janet @@ -0,0 +1 @@ +@[{:sha "0a1e9d34916f9f315a269106cd628ae6c27c4d4f" :repo "https://github.com/janet-lang/pkgs.git" :paths @["/usr/local/lib/janet/pkgs.janet"] :dependencies @[]} {:sha "aea28d1124dde004320816f838516e39c108d57e" :repo "https://github.com/joy-framework/tester" :paths @["/usr/local/lib/janet/tester.janet"] :dependencies @[]} {:sha "d8619960d428c45ebb784600771a7c584ae49431" :repo "https://github.com/janet-lang/path" :paths @["/usr/local/lib/janet/path.janet"] :dependencies @[]} {:sha "a276646d269fc8a8df5336015579219300378ac2" :repo "https://github.com/joy-framework/halo" :paths @["/usr/local/lib/janet/halo.so" "/usr/local/lib/janet/halo.meta.janet" "/usr/local/lib/janet/halo.a"] :dependencies @[]} {:sha "d4423658a15275a815be2bef49b4e0030c18d8d4" :repo "https://github.com/janet-lang/jhydro" :paths @["/usr/local/lib/janet/jhydro.so" "/usr/local/lib/janet/jhydro.meta.janet" "/usr/local/lib/janet/jhydro.a"] :dependencies @[]} {:sha "1a1d4436086e7fb4a07a82d466e39ebe6f3e2258" :repo "https://github.com/janet-lang/sqlite3" :paths @["/usr/local/lib/janet/sqlite3.so" "/usr/local/lib/janet/sqlite3.meta.janet" "/usr/local/lib/janet/sqlite3.a"] :dependencies @[]} {:sha "61437d96b5df6eb7e524f88847e7d7521201662d" :repo "https://github.com/janet-lang/json" :paths @["/usr/local/lib/janet/json.so" "/usr/local/lib/janet/json.meta.janet" "/usr/local/lib/janet/json.a"] :dependencies @[]} {:sha "f50c00462b9d048034ee8bdd2f6af6e67bc5aff4" :repo "https://github.com/joy-framework/codec" :paths @["/usr/local/lib/janet/codec.so" "/usr/local/lib/janet/codec.meta.janet" "/usr/local/lib/janet/codec.a"] :dependencies @[{:tag "c14aff3591cb0aed74cba9b54d853cf0bf539ecb" :repo "https://github.com/joy-framework/tester"}]} {:sha "91fcbd6445c841d48066642e2b7aa19e555934d8" :repo "https://github.com/joy-framework/cipher" :paths @["/usr/local/lib/janet/cipher.janet"] :dependencies @[{:tag "0.2.1" :repo "https://github.com/joy-framework/tester"} {:tag "d4423658a15275a815be2bef49b4e0030c18d8d4" :repo "https://github.com/janet-lang/jhydro"}]} {:sha "921c16d008444792ad262f7aaff87549acfc4240" :repo "https://github.com/andrewchambers/janet-uri" :paths @["/usr/local/lib/janet/uri.janet" "/usr/local/lib/janet/_uri.so" "/usr/local/lib/janet/_uri.meta.janet" "/usr/local/lib/janet/_uri.a"] :dependencies @[]} {:sha "23785e59c468d39973dfc9a2aeee8e1b135f15fd" :repo "https://github.com/joy-framework/bundler" :paths @["/usr/local/lib/janet/bundler.janet"] :dependencies @["https://github.com/joy-framework/tester" "https://github.com/janet-lang/path"]} {:sha "68d5a36978ad30ef5281ebadcec2f95dd57cb9dd" :repo "https://github.com/joy-framework/joy.git" :paths @["/usr/local/lib/janet/bin/joy" "/usr/local/lib/janet/joy" "/usr/local/lib/janet/joy.janet"] :dependencies @["https://github.com/andrewchambers/janet-uri" "https://github.com/janet-lang/json" "https://github.com/janet-lang/path" "https://github.com/janet-lang/sqlite3" "https://github.com/joy-framework/cipher" "https://github.com/joy-framework/codec" "https://github.com/joy-framework/halo" "https://github.com/joy-framework/bundler" "https://github.com/joy-framework/tester"]}] From a3a45511e5d2282c938f35455a5ee144866c5867 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 26 Mar 2020 00:39:30 -0500 Subject: [PATCH 035/107] Remove lockfile.janet --- .gitignore | 3 +++ lockfile.janet | 1 - 2 files changed, 3 insertions(+), 1 deletion(-) delete mode 100644 lockfile.janet diff --git a/.gitignore b/.gitignore index fb90c98e..e738c879 100644 --- a/.gitignore +++ b/.gitignore @@ -13,6 +13,9 @@ janet janet-*.tar.gz dist +# jpm lockfile +lockfile.janet + # Kakoune (fzf via fd) .fdignore diff --git a/lockfile.janet b/lockfile.janet deleted file mode 100644 index f18f7a9a..00000000 --- a/lockfile.janet +++ /dev/null @@ -1 +0,0 @@ -@[{:sha "0a1e9d34916f9f315a269106cd628ae6c27c4d4f" :repo "https://github.com/janet-lang/pkgs.git" :paths @["/usr/local/lib/janet/pkgs.janet"] :dependencies @[]} {:sha "aea28d1124dde004320816f838516e39c108d57e" :repo "https://github.com/joy-framework/tester" :paths @["/usr/local/lib/janet/tester.janet"] :dependencies @[]} {:sha "d8619960d428c45ebb784600771a7c584ae49431" :repo "https://github.com/janet-lang/path" :paths @["/usr/local/lib/janet/path.janet"] :dependencies @[]} {:sha "a276646d269fc8a8df5336015579219300378ac2" :repo "https://github.com/joy-framework/halo" :paths @["/usr/local/lib/janet/halo.so" "/usr/local/lib/janet/halo.meta.janet" "/usr/local/lib/janet/halo.a"] :dependencies @[]} {:sha "d4423658a15275a815be2bef49b4e0030c18d8d4" :repo "https://github.com/janet-lang/jhydro" :paths @["/usr/local/lib/janet/jhydro.so" "/usr/local/lib/janet/jhydro.meta.janet" "/usr/local/lib/janet/jhydro.a"] :dependencies @[]} {:sha "1a1d4436086e7fb4a07a82d466e39ebe6f3e2258" :repo "https://github.com/janet-lang/sqlite3" :paths @["/usr/local/lib/janet/sqlite3.so" "/usr/local/lib/janet/sqlite3.meta.janet" "/usr/local/lib/janet/sqlite3.a"] :dependencies @[]} {:sha "61437d96b5df6eb7e524f88847e7d7521201662d" :repo "https://github.com/janet-lang/json" :paths @["/usr/local/lib/janet/json.so" "/usr/local/lib/janet/json.meta.janet" "/usr/local/lib/janet/json.a"] :dependencies @[]} {:sha "f50c00462b9d048034ee8bdd2f6af6e67bc5aff4" :repo "https://github.com/joy-framework/codec" :paths @["/usr/local/lib/janet/codec.so" "/usr/local/lib/janet/codec.meta.janet" "/usr/local/lib/janet/codec.a"] :dependencies @[{:tag "c14aff3591cb0aed74cba9b54d853cf0bf539ecb" :repo "https://github.com/joy-framework/tester"}]} {:sha "91fcbd6445c841d48066642e2b7aa19e555934d8" :repo "https://github.com/joy-framework/cipher" :paths @["/usr/local/lib/janet/cipher.janet"] :dependencies @[{:tag "0.2.1" :repo "https://github.com/joy-framework/tester"} {:tag "d4423658a15275a815be2bef49b4e0030c18d8d4" :repo "https://github.com/janet-lang/jhydro"}]} {:sha "921c16d008444792ad262f7aaff87549acfc4240" :repo "https://github.com/andrewchambers/janet-uri" :paths @["/usr/local/lib/janet/uri.janet" "/usr/local/lib/janet/_uri.so" "/usr/local/lib/janet/_uri.meta.janet" "/usr/local/lib/janet/_uri.a"] :dependencies @[]} {:sha "23785e59c468d39973dfc9a2aeee8e1b135f15fd" :repo "https://github.com/joy-framework/bundler" :paths @["/usr/local/lib/janet/bundler.janet"] :dependencies @["https://github.com/joy-framework/tester" "https://github.com/janet-lang/path"]} {:sha "68d5a36978ad30ef5281ebadcec2f95dd57cb9dd" :repo "https://github.com/joy-framework/joy.git" :paths @["/usr/local/lib/janet/bin/joy" "/usr/local/lib/janet/joy" "/usr/local/lib/janet/joy.janet"] :dependencies @["https://github.com/andrewchambers/janet-uri" "https://github.com/janet-lang/json" "https://github.com/janet-lang/path" "https://github.com/janet-lang/sqlite3" "https://github.com/joy-framework/cipher" "https://github.com/joy-framework/codec" "https://github.com/joy-framework/halo" "https://github.com/joy-framework/bundler" "https://github.com/joy-framework/tester"]}] From 3eb0927a2b169259292d2c7e525415c5232536c3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 26 Mar 2020 21:35:11 -0500 Subject: [PATCH 036/107] Add accumulate(2) and reduce2 These functions are variations on reduce and can be quite useful. Improve error message for jpm as well. --- CHANGELOG.md | 1 + auxbin/jpm | 4 ++-- src/boot/boot.janet | 37 +++++++++++++++++++++++++++++++++++++ test/suite8.janet | 10 ++++++++++ 4 files changed, 50 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a3dccb50..6aea9e77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add `reduce2`, `accumulate`, and `accumulate2`. - Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`. - Add `os/realpath` (Not supported on windows). - Add `os/chmod`. diff --git a/auxbin/jpm b/auxbin/jpm index 7be76d58..1dcdb6bb 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -686,8 +686,8 @@ int main(int argc, const char **argv) { (def mdir (find-manifest-dir)) (each man (os/dir mdir) (def package (parse (slurp (string mdir sep man)))) - (if (or (not (package :repo)) (not (package :sha))) - (print "Cannot add local package " man " to lockfile, skipping...") + (if (or (not (dictionary? package)) (not (package :repo)) (not (package :sha))) + (print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...") (array/push packages package))) # Put in correct order, such that a package is preceded by all of its dependencies (def ordered-packages @[]) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 3334b1f8..44203722 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -699,6 +699,43 @@ (each x ind (set res (f res x))) res) +(defn reduce2 + "The 2 argument version of reduce that does not take an initialization value. + Instead the first element of the array is used for initialization." + [f ind] + (var k (next ind)) + (var res (in ind k)) + (set k (next ind k)) + (while (not= nil k) + (set res (f res (in ind k))) + (set k (next ind k))) + res) + +(defn accumulate + "Similar to reduce, but accumulates intermediate values into an array. + The last element in the array is what would be the return value from reduce. + The init value is not added to the array. + Returns a new array." + [f init ind] + (var res init) + (def ret (array/new (length ind))) + (each x ind (array/push ret (set res (f res x)))) + ret) + +(defn accumulate2 + "The 2 argument version of accumulate that does not take an initialization value." + [f ind] + (var k (next ind)) + (def ret (array/new (length ind))) + (var res (in ind k)) + (array/push ret res) + (set k (next ind k)) + (while (not= nil k) + (set res (f res (in ind k))) + (array/push ret res) + (set k (next ind k))) + ret) + (defn map "Map a function over every element in an indexed data structure and return an array of the results." diff --git a/test/suite8.janet b/test/suite8.janet index 580cd3be..b20fb7e6 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -181,4 +181,14 @@ (def c (unmarshal (marshal b))) (assert (= 2 (c 1)) "marshal-on-stack-closure 1")) +# Reduce2 + +(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1") +(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2") + +# Accumulate + +(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1") +(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1") + (end-suite) From 65379741f70e2973aeda1d4954e8ce7e997a9816 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 27 Mar 2020 12:45:40 -0500 Subject: [PATCH 037/107] Address edge case of reduce2 when ind is empty. Same for accumulate 2. --- auxbin/jpm | 6 +++--- src/boot/boot.janet | 2 ++ test/suite8.janet | 5 ++++- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index 1dcdb6bb..c2fee871 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -686,9 +686,9 @@ int main(int argc, const char **argv) { (def mdir (find-manifest-dir)) (each man (os/dir mdir) (def package (parse (slurp (string mdir sep man)))) - (if (or (not (dictionary? package)) (not (package :repo)) (not (package :sha))) - (print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...") - (array/push packages package))) + (if (and (dictionary? package) (package :repo) (package :sha)) + (array/push packages package) + (print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping..."))) # Put in correct order, such that a package is preceded by all of its dependencies (def ordered-packages @[]) (def resolved @{}) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 44203722..0a677370 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -704,6 +704,7 @@ Instead the first element of the array is used for initialization." [f ind] (var k (next ind)) + (if (= nil k) (break nil)) (var res (in ind k)) (set k (next ind k)) (while (not= nil k) @@ -727,6 +728,7 @@ [f ind] (var k (next ind)) (def ret (array/new (length ind))) + (if (= nil k) (break ret)) (var res (in ind k)) (array/push ret res) (set k (next ind k)) diff --git a/test/suite8.janet b/test/suite8.janet index b20fb7e6..5ba1e737 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -184,11 +184,14 @@ # Reduce2 (assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1") -(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2") +(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2") +(assert (= nil (reduce2 * [])) "reduce2 3") # Accumulate (assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1") (assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1") +(assert (deep= @[] (accumulate2 + [])) "accumulate2 2") +(assert (deep= @[] (accumulate 0 + [])) "accumulate 2") (end-suite) From ff163a5ae4b710228f7743acc83f84d5a69171f7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 Mar 2020 10:23:28 -0500 Subject: [PATCH 038/107] Use modulo instead of remainder for even?/odd?. Works better for negative and fractional numbers. --- src/boot/boot.janet | 4 ++-- test/suite1.janet | 22 ++++++++++++++++++++++ 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 0a677370..4ddbbef2 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -79,8 +79,8 @@ # Basic predicates (defn nan? "Check if x is NaN" [x] (not= x x)) -(defn even? "Check if x is even." [x] (= 0 (% x 2))) -(defn odd? "Check if x is odd." [x] (not= 0 (% x 2))) +(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)) diff --git a/test/suite1.janet b/test/suite1.janet index 5b9f4f4f..c3d625d6 100644 --- a/test/suite1.janet +++ b/test/suite1.janet @@ -259,4 +259,26 @@ (assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1") (assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2") +# Even and odd + +(assert (odd? 9) "odd? 1") +(assert (odd? -9) "odd? 2") +(assert (not (odd? 10)) "odd? 3") +(assert (not (odd? 0)) "odd? 4") +(assert (not (odd? -10)) "odd? 5") +(assert (not (odd? 1.1)) "odd? 6") +(assert (not (odd? -0.1)) "odd? 7") +(assert (not (odd? -1.1)) "odd? 8") +(assert (not (odd? -1.6)) "odd? 9") + +(assert (even? 10) "even? 1") +(assert (even? -10) "even? 2") +(assert (even? 0) "even? 3") +(assert (not (even? 9)) "even? 4") +(assert (not (even? -9)) "even? 5") +(assert (not (even? 0.1)) "even? 6") +(assert (not (even? -0.1)) "even? 7") +(assert (not (even? -10.1)) "even? 8") +(assert (not (even? -10.6)) "even? 9") + (end-suite) From 279b536646e1b044158a5fa41cd1504d7e8bfe0b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 29 Mar 2020 14:18:28 -0500 Subject: [PATCH 039/107] Prepare for 1.8.0 release. --- CHANGELOG.md | 2 +- appveyor.yml | 2 +- meson.build | 2 +- src/conf/janetconf.h | 8 ++++---- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6aea9e77..036b417b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog All notable changes to this project will be documented in this file. -## Unreleased +## 1.8.0 - 2020-03-29 - Add `reduce2`, `accumulate`, and `accumulate2`. - Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`. - Add `os/realpath` (Not supported on windows). diff --git a/appveyor.yml b/appveyor.yml index 613d4526..69adfb73 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -30,7 +30,7 @@ install: - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform% - build_win test-install - set janet_outname=%appveyor_repo_tag_name% - - if "%janet_outname%"=="" set janet_outname=v1.7.1 + - if "%janet_outname%"=="" set janet_outname=v1.8.0 build: off artifacts: diff --git a/meson.build b/meson.build index 2aebc8d2..4311c7e8 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.7.1-dev') + version : '1.8.0') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 118fac99..de37f568 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -27,10 +27,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 7 -#define JANET_VERSION_PATCH 1 -#define JANET_VERSION_EXTRA "-dev" -#define JANET_VERSION "1.7.1-dev" +#define JANET_VERSION_MINOR 8 +#define JANET_VERSION_PATCH 0 +#define JANET_VERSION_EXTRA "" +#define JANET_VERSION "1.8.0" /* #define JANET_BUILD "local" */ From a40b2767c5c9b855f5d20b4b6c167a2263914bbc Mon Sep 17 00:00:00 2001 From: q66 Date: Mon, 30 Mar 2020 18:30:19 +0200 Subject: [PATCH 040/107] Fix endian check for little endian PowerPC and maybe others This fixes various subtle breakage on ppc64le at very least. --- src/include/janet.h | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/include/janet.h b/src/include/janet.h index 6d5b7de0..9fb9f416 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -97,7 +97,14 @@ extern "C" { #endif /* Check big endian */ -#if defined(__MIPSEB__) /* MIPS 32-bit */ \ +#if defined(__LITTLE_ENDIAN__) || \ + (defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__)) +/* If we know the target is LE, always use that - e.g. ppc64 little endian + * defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely + * on that and if that's not defined, fall back to big endian assumption + */ +#define JANET_LITTLE_ENDIAN 1 +#elif defined(__MIPSEB__) /* MIPS 32-bit */ \ || defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \ || defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \ || defined(_M_PPC) || defined(__PPC) \ From 1e2887649457f51d541f87188aac1ec73ada711f Mon Sep 17 00:00:00 2001 From: q66 Date: Mon, 30 Mar 2020 19:14:00 +0200 Subject: [PATCH 041/107] Fix typo in big endian unmarshalling code This was subtly breaking everything. --- src/core/marsh.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index d6d6353c..d9cd3f70 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -1141,7 +1141,7 @@ static const uint8_t *unmarshal_one( u.bytes[0] = data[8]; u.bytes[1] = data[7]; u.bytes[2] = data[6]; - u.bytes[5] = data[5]; + u.bytes[3] = data[5]; u.bytes[4] = data[4]; u.bytes[5] = data[3]; u.bytes[6] = data[2]; From 5d840b944b01cc07368b178b6d9bcda69d35e851 Mon Sep 17 00:00:00 2001 From: q66 Date: Mon, 30 Mar 2020 19:19:51 +0200 Subject: [PATCH 042/107] Fix wrong check on big endian systems We can't randomly type pun random-sized types on big endian systems. --- src/include/janet.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/include/janet.h b/src/include/janet.h index 9fb9f416..d874cb53 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -663,7 +663,7 @@ struct Janet { #define janet_type(x) ((x).type) #define janet_checktype(x, t) ((x).type == (t)) #define janet_truthy(x) \ - ((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1))) + ((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1))) #define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer) #define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer) From e4ea8bc867c5d42b4acf30c09de34821ed8edb04 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 30 Mar 2020 15:38:03 -0500 Subject: [PATCH 043/107] Fix features for bsd. Don't define XOPEN_SOURCE unless we actually need it. --- src/core/features.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/features.h b/src/core/features.h index 94beffbe..7ae18edf 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -29,7 +29,8 @@ #define _POSIX_C_SOURCE 200112L #endif -#ifndef _XOPEN_SOURCE +/* Needed for realpath on linux */ +#if !defined(_XOPEN_SOURCE) && defined(__linux__) #define _XOPEN_SOURCE 500 #endif From ca4a35c90ad80165094912b7f6db7be91142174f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 30 Mar 2020 16:59:51 -0500 Subject: [PATCH 044/107] Update CHANGELOG.md --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 036b417b..27cfe841 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ # Changelog All notable changes to this project will be documented in this file. +## 1.8.1 - 2020-03-30 +- Fix bugs for big endian systems +- Fix 1.8.0 regression on BSDs + ## 1.8.0 - 2020-03-29 - Add `reduce2`, `accumulate`, and `accumulate2`. - Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`. From 244566ccd48f8cbe78bce5e84e28e13357701979 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 31 Mar 2020 07:50:40 -0500 Subject: [PATCH 045/107] Remove manual feature definitions in boot. Instead, reuse features as defined in features.h --- CHANGELOG.md | 2 +- README.md | 4 ++-- src/boot/boot.janet | 12 +++++++----- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 27cfe841..4d78abaf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog All notable changes to this project will be documented in this file. -## 1.8.1 - 2020-03-30 +## 1.8.1 - 2020-03-31 - Fix bugs for big endian systems - Fix 1.8.0 regression on BSDs diff --git a/README.md b/README.md index f8117569..99405ec4 100644 --- a/README.md +++ b/README.md @@ -2,8 +2,8 @@   [![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master) [![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yaml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yaml?) Janet logo diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 4ddbbef2..468da4a5 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2528,9 +2528,10 @@ # Create amalgamation + (def feature-header "src/core/features.h") + (def local-headers - ["src/core/features.h" - "src/core/util.h" + ["src/core/util.h" "src/core/state.h" "src/core/gc.h" "src/core/vector.h" @@ -2584,9 +2585,6 @@ (print "/* Generated from janet version " janet/version "-" janet/build " */") (print "#define JANET_BUILD \"" janet/build "\"") (print ```#define JANET_AMALG```) - (print ```#define _POSIX_C_SOURCE 200112L```) - (print ```#define _XOPEN_SOURCE 500```) - (print ```#include "janet.h"```) (defn do-one-flie [fname] @@ -2595,6 +2593,10 @@ (def source (slurp fname)) (print (string/replace-all "\r" "" source))) + (do-one-flie feature-header) + + (print ```#include "janet.h"```) + (each h local-headers (do-one-flie h)) From 417d9a14ccb01976c7005f4e69e1fe5ab6acc2b8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 31 Mar 2020 08:03:38 -0500 Subject: [PATCH 046/107] s/yaml/yml/g in README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 99405ec4..5bc8c1b8 100644 --- a/README.md +++ b/README.md @@ -2,8 +2,8 @@   [![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master) [![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yaml?) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yaml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?) Janet logo From b6b70d54ef69572fbdca7ddc0afeef02172d366b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Josef=20Pospi=CC=81s=CC=8Cil?= Date: Tue, 31 Mar 2020 15:31:27 +0200 Subject: [PATCH 047/107] Fix typo flie --- src/boot/boot.janet | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 468da4a5..114d0d5a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2586,22 +2586,22 @@ (print "#define JANET_BUILD \"" janet/build "\"") (print ```#define JANET_AMALG```) - (defn do-one-flie + (defn do-one-file [fname] (print "\n/* " fname " */") (print "#line 0 \"" fname "\"\n") (def source (slurp fname)) (print (string/replace-all "\r" "" source))) - (do-one-flie feature-header) + (do-one-file feature-header) (print ```#include "janet.h"```) (each h local-headers - (do-one-flie h)) + (do-one-file h)) (each s core-sources - (do-one-flie s)) + (do-one-file s)) # Create C source file that contains images a uint8_t buffer. This # can be compiled and linked statically into the main janet library From 5b6b9f15974ea7adf1e38e25047014a1bc956ce5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 31 Mar 2020 09:49:09 -0500 Subject: [PATCH 048/107] Prepare for 1.8.1 release. --- appveyor.yml | 2 +- meson.build | 2 +- src/conf/janetconf.h | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/appveyor.yml b/appveyor.yml index 69adfb73..0a002ed1 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -30,7 +30,7 @@ install: - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform% - build_win test-install - set janet_outname=%appveyor_repo_tag_name% - - if "%janet_outname%"=="" set janet_outname=v1.8.0 + - if "%janet_outname%"=="" set janet_outname=v1.8.1 build: off artifacts: diff --git a/meson.build b/meson.build index 4311c7e8..904f030a 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.8.0') + version : '1.8.1') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index de37f568..4a2175ce 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -28,9 +28,9 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 8 -#define JANET_VERSION_PATCH 0 +#define JANET_VERSION_PATCH 1 #define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.8.0" +#define JANET_VERSION "1.8.1" /* #define JANET_BUILD "local" */ From 57b08a57a03527418a223cfca2ee40f100a471e4 Mon Sep 17 00:00:00 2001 From: DEADB17 Date: Tue, 31 Mar 2020 23:32:17 -0400 Subject: [PATCH 049/107] Corret typo and match wording for consistency --- src/boot/boot.janet | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 114d0d5a..d17b613b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -942,7 +942,7 @@ (reduce fop x forms)) (defmacro -?> - "Short circuit threading macro. Inserts x as the last value in the first form + "Short circuit threading macro. Inserts x as the second value in the first form in forms, and inserts the modified first form into the second form in the same manner, and so on. The pipeline will return nil if an intermediate value is nil. @@ -958,7 +958,7 @@ (reduce fop x forms)) (defmacro -?>> - "Threading macro. Inserts x as the last value in the first form + "Short circuit threading macro. Inserts x as the last value in the first form in forms, and inserts the modified first form into the second form in the same manner, and so on. The pipeline will return nil if an intermediate value is nil. From 789ef3608bbe9cb883be461e40c9bba861cbd8c1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 1 Apr 2020 08:54:01 -0500 Subject: [PATCH 050/107] Make format. --- src/core/os.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index a895df3e..dc484644 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1403,8 +1403,8 @@ static const JanetReg os_cfuns[] = { { "os/realpath", os_realpath, JDOC("(os/realpath path)\n\n" - "Get the absolute path for a given path, following ../, ./, and symlinks. " - "Returns an absolute path as a string. Will raise an error on Windows.") + "Get the absolute path for a given path, following ../, ./, and symlinks. " + "Returns an absolute path as a string. Will raise an error on Windows.") }, #endif {NULL, NULL, NULL} From 6b1d5c6d7b3a10fb01ad118725656f0c697d6b8b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 1 Apr 2020 09:22:27 -0500 Subject: [PATCH 051/107] Work on improving deployment for windows. --- appveyor.yml | 5 ++--- janet-installer.nsi | 10 ++++++++-- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/appveyor.yml b/appveyor.yml index 0a002ed1..8060d9fb 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -30,7 +30,7 @@ install: - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform% - build_win test-install - set janet_outname=%appveyor_repo_tag_name% - - if "%janet_outname%"=="" set janet_outname=v1.8.1 + - if "%janet_outname%"=="" set /P janet_outname= Date: Wed, 1 Apr 2020 09:23:19 -0500 Subject: [PATCH 052/107] Fix appveyor.yml --- appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/appveyor.yml b/appveyor.yml index 8060d9fb..50327344 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -49,7 +49,7 @@ artifacts: - name: "janet-$(janet_outname)-windows-%platform%" path: dist type: Zip - - name: "janet-$(janet_outname)-windows-%platform%-installer.exe" + - path: "janet-$(janet_outname)-windows-%platform%-installer.exe" type: File deploy: From f2815d706839a0a5105148094b7239731db5a5fc Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 1 Apr 2020 09:26:20 -0500 Subject: [PATCH 053/107] Actually run the installer in build_win.bat. --- build_win.bat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build_win.bat b/build_win.bat index e783064e..3f45578e 100644 --- a/build_win.bat +++ b/build_win.bat @@ -131,7 +131,7 @@ exit /b 0 @rem Run the installer. (Installs to the local user with default settings) :INSTALL @echo Running Installer... -FOR %%a in (janet-*-windows-installer.exe) DO ( +FOR %%a in (janet-*-windows-*-installer.exe) DO ( %%a /S /CurrentUser ) exit /b 0 From 3c2b1baff241fd01bfa9d51ca31a64bcea17b687 Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Thu, 2 Apr 2020 23:33:50 +1300 Subject: [PATCH 054/107] Add os/umask. --- src/core/os.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/core/os.c b/src/core/os.c index a895df3e..8b1d168e 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -797,6 +797,16 @@ static Janet os_symlink(int32_t argc, Janet *argv) { #endif } +static Janet os_umask(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); +#ifdef JANET_WINDOWS + janet_panicf("os/umask not supported on Windows"); +#else + int32_t mask = janet_getinteger(argv, 0); + return janet_wrap_integer(umask(mask)); +#endif +} + static Janet os_mkdir(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); const char *path = janet_getcstring(argv, 0); @@ -1285,6 +1295,11 @@ static const JanetReg os_cfuns[] = { JDOC("(os/cd path)\n\n" "Change current directory to path. Returns nil on success, errors on failure.") }, + { + "os/umask", os_umask, + JDOC("(os/umask mask)\n\n" + "Set a new umask, returns the old umask.") + }, { "os/mkdir", os_mkdir, JDOC("(os/mkdir path)\n\n" From 464fb73d834111d9d2919ba5d94ab87176313d0b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 15:02:12 -0500 Subject: [PATCH 055/107] Add os/perm-int and os/perm-str. This helps address #331. While we could also make os/stat return an integer, we don't do that yet for api breakage reasons. This also lets us use this logic on other functions that take permission strings. --- src/core/os.c | 201 +++++++++++++++++++++++++++++--------------------- 1 file changed, 118 insertions(+), 83 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index dc484644..34a9e9d2 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -880,40 +880,23 @@ static Janet os_readlink(int32_t argc, Janet *argv) { } #ifdef JANET_WINDOWS -static const uint8_t *janet_decode_permissions(unsigned short m) { - uint8_t flags[9] = {0}; - flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-'; - flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-'; - flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-'; - return janet_string(flags, sizeof(flags)); + +typedef struct _stat jstat_t; +typedef unsigned short jmode_t; + +static int32_t janet_perm_to_unix(unsigned short m) { + int32_t ret = 0; + if (m & S_IEXEC) ret |= 0111; + if (m & S_IWRITE) ret |= 0222; + if (m & S_IREAD) ret |= 0444; + return ret; } -static unsigned short janet_encode_permissions(Janet *argv, int32_t n) { - if (janet_checkint(argv[n])) { - int32_t x = janet_unwrap_integer(argv[n]); - if (x < 0 || x > 0777) { - janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]); - } - unsigned short m = 0; - if (x & 1 || x & 010 || x & 0100) m |= S_IEXEC; - if (x & 2 || x & 020 || x & 0200) m |= S_IWRITE; - if (x & 4 || x & 040 || x & 0400) m |= S_IREAD; - return m; - } - JanetString perm = janet_getstring(argv, n); - if (janet_string_length(perm) != 9) { - janet_panicf("expected string of length 9, got %S", perm); - } +static unsigned short janet_perm_from_unix(int32_t x) { unsigned short m = 0; - if (perm[0] == 'r') m |= S_IREAD; - if (perm[1] == 'w') m |= S_IWRITE; - if (perm[2] == 'x') m |= S_IEXEC; - if (perm[3] == 'r') m |= S_IREAD; - if (perm[4] == 'w') m |= S_IWRITE; - if (perm[5] == 'x') m |= S_IEXEC; - if (perm[6] == 'r') m |= S_IREAD; - if (perm[7] == 'w') m |= S_IWRITE; - if (perm[8] == 'x') m |= S_IEXEC; + if (x & 111) m |= S_IEXEC; + if (x & 222) m |= S_IWRITE; + if (x & 444) m |= S_IREAD; return m; } @@ -924,44 +907,22 @@ static const uint8_t *janet_decode_mode(unsigned short m) { else if (m & _S_IFCHR) str = "character"; return janet_ckeyword(str); } -#else -static const uint8_t *janet_decode_permissions(mode_t m) { - uint8_t flags[9] = {0}; - flags[0] = (m & S_IRUSR) ? 'r' : '-'; - flags[1] = (m & S_IWUSR) ? 'w' : '-'; - flags[2] = (m & S_IXUSR) ? 'x' : '-'; - flags[3] = (m & S_IRGRP) ? 'r' : '-'; - flags[4] = (m & S_IWGRP) ? 'w' : '-'; - flags[5] = (m & S_IXGRP) ? 'x' : '-'; - flags[6] = (m & S_IROTH) ? 'r' : '-'; - flags[7] = (m & S_IWOTH) ? 'w' : '-'; - flags[8] = (m & S_IXOTH) ? 'x' : '-'; - return janet_string(flags, sizeof(flags)); + +static int32_t janet_decode_permissions(jmode_t mode) { + return (int32_t)(mode & (S_IEXEC | S_IWRITE | S_IREAD)); } -static mode_t janet_encode_permissions(Janet *argv, int32_t n) { - if (janet_checkint(argv[n])) { - int32_t x = janet_unwrap_integer(argv[n]); - if (x < 0 || x > 0777) { - janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]); - } - return (mode_t) x; - } - JanetString perm = janet_getstring(argv, n); - if (janet_string_length(perm) != 9) { - janet_panicf("expected string of length 9, got %S", perm); - } - mode_t m = 0; - if (perm[0] == 'r') m |= S_IRUSR; - if (perm[1] == 'w') m |= S_IWUSR; - if (perm[2] == 'x') m |= S_IXUSR; - if (perm[3] == 'r') m |= S_IRGRP; - if (perm[4] == 'w') m |= S_IWGRP; - if (perm[5] == 'x') m |= S_IXGRP; - if (perm[6] == 'r') m |= S_IROTH; - if (perm[7] == 'w') m |= S_IWOTH; - if (perm[8] == 'x') m |= S_IXOTH; - return m; +#else + +typedef struct stat jstat_t; +typedef mode_t jmode_t; + +static int32_t janet_perm_to_unix(mode_t m) { + return (int32_t) m; +} + +static mode_t janet_perm_from_unix(int32_t x) { + return (mode_t) x; } static const uint8_t *janet_decode_mode(mode_t m) { @@ -975,13 +936,64 @@ static const uint8_t *janet_decode_mode(mode_t m) { else if (S_ISCHR(m)) str = "character"; return janet_ckeyword(str); } + +static int32_t janet_decode_permissions(jmode_t mode) { + return (int32_t)(mode & 0777); +} + #endif -#ifdef JANET_WINDOWS -typedef struct _stat jstat_t; -#else -typedef struct stat jstat_t; -#endif +static int32_t os_parse_permstring(const uint8_t *perm) { + int32_t m = 0; + if (perm[0] == 'r') m |= 0400; + if (perm[1] == 'w') m |= 0200; + if (perm[2] == 'x') m |= 0100; + if (perm[3] == 'r') m |= 0040; + if (perm[4] == 'w') m |= 0020; + if (perm[5] == 'x') m |= 0010; + if (perm[6] == 'r') m |= 0004; + if (perm[7] == 'w') m |= 0002; + if (perm[8] == 'x') m |= 0001; + return m; +} + +static Janet os_make_permstring(int32_t permissions) { + uint8_t bytes[9] = {0}; + bytes[0] = (permissions & 0400) ? 'r' : '-'; + bytes[1] = (permissions & 0200) ? 'w' : '-'; + bytes[2] = (permissions & 0100) ? 'x' : '-'; + bytes[3] = (permissions & 0040) ? 'r' : '-'; + bytes[4] = (permissions & 0020) ? 'w' : '-'; + bytes[5] = (permissions & 0010) ? 'x' : '-'; + bytes[6] = (permissions & 0004) ? 'r' : '-'; + bytes[7] = (permissions & 0002) ? 'w' : '-'; + bytes[8] = (permissions & 0001) ? 'x' : '-'; + return janet_stringv(bytes, sizeof(bytes)); +} + +static int32_t os_get_unix_mode(const Janet *argv, int32_t n) { + int32_t unix_mode; + if (janet_checkint(argv[n])) { + /* Integer mode */ + int32_t x = janet_unwrap_integer(argv[n]); + if (x < 0 || x > 0777) { + janet_panicf("bad slot #%d, expected integer in range [0, 8r777], got %v", n, argv[n]); + } + unix_mode = x; + } else { + /* Bytes mode */ + JanetByteView bytes = janet_getbytes(argv, n); + if (bytes.len != 9) { + janet_panicf("bad slot #%d: expected byte sequence of length 9, got %v", n, argv[n]); + } + unix_mode = os_parse_permstring(bytes.bytes); + } + return unix_mode; +} + +static jmode_t os_getmode(const Janet *argv, int32_t n) { + return janet_perm_from_unix(os_get_unix_mode(argv, n)); +} /* Getters */ static Janet os_stat_dev(jstat_t *st) { @@ -994,7 +1006,7 @@ static Janet os_stat_mode(jstat_t *st) { return janet_wrap_keyword(janet_decode_mode(st->st_mode)); } static Janet os_stat_permissions(jstat_t *st) { - return janet_wrap_string(janet_decode_permissions(st->st_mode)); + return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode))); } static Janet os_stat_uid(jstat_t *st) { return janet_wrap_number(st->st_uid); @@ -1122,9 +1134,9 @@ static Janet os_chmod(int32_t argc, Janet *argv) { janet_fixarity(argc, 2); const char *path = janet_getcstring(argv, 0); #ifdef JANET_WINDOWS - int res = _chmod(path, janet_encode_permissions(argv, 1)); + int res = _chmod(path, os_getmode(argv, 1)); #else - int res = chmod(path, janet_encode_permissions(argv, 1)); + int res = chmod(path, os_getmode(argv, 1)); #endif if (-1 == res) janet_panicf("%s: %s", strerror(errno), path); return janet_wrap_nil(); @@ -1191,6 +1203,16 @@ static Janet os_realpath(int32_t argc, Janet *argv) { #endif } +static Janet os_permission_string(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + return os_make_permstring(os_get_unix_mode(argv, 0)); +} + +static Janet os_permission_int(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + return janet_wrap_integer(os_get_unix_mode(argv, 0)); +} + #endif /* JANET_REDUCED_OS */ static const JanetReg os_cfuns[] = { @@ -1249,7 +1271,7 @@ static const JanetReg os_cfuns[] = { " only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n" "\t:dev - the device that the file is on\n" "\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n" - "\t:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n" + "\t:permissions - A Unix permission integer like 8r740\n" "\t:uid - File uid\n" "\t:gid - File gid\n" "\t:nlink - number of links to file\n" @@ -1270,9 +1292,9 @@ static const JanetReg os_cfuns[] = { "os/chmod", os_chmod, JDOC("(os/chmod path mode)\n\n" "Change file permissions, where mode is a permission string as returned by " - "os/stat, or an integer. " - "When mode is an integer, it is interpreted as a unix permission value, best specified in octal, like " - "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions. Returns nil.") + "os/perm-str, or an integer as returned by os/perm-int. " + "When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like " + "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") }, { "os/touch", os_touch, @@ -1289,7 +1311,7 @@ static const JanetReg os_cfuns[] = { "os/mkdir", os_mkdir, JDOC("(os/mkdir path)\n\n" "Create a new directory. The path will be relative to the current directory if relative, otherwise " - "it will be an absolute path. Returns true if the directory was create, false if the directoyr already exists, and " + "it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and " "errors otherwise.") }, { @@ -1305,7 +1327,7 @@ static const JanetReg os_cfuns[] = { { "os/link", os_link, JDOC("(os/link oldpath newpath &opt symlink)\n\n" - "Create a symlink from oldpath to newpath, returning nil. The 3rd optional paramater " + "Create a symlink from oldpath to newpath, returning nil. The 3rd optional parameter " "enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.") }, { @@ -1376,14 +1398,14 @@ static const JanetReg os_cfuns[] = { { "os/cryptorand", os_cryptorand, JDOC("(os/cryptorand n &opt buf)\n\n" - "Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.") + "Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") }, { "os/date", os_date, JDOC("(os/date &opt time local)\n\n" "Returns the given time as a date struct, or the current time if no time is given. " "Returns a struct with following key values. Note that all numbers are 0-indexed. " - "Date is given in UTC unless local is truthy, in which case the date is formated for " + "Date is given in UTC unless local is truthy, in which case the date is formatted for " "the local timezone.\n\n" "\t:seconds - number of seconds [0-61]\n" "\t:minutes - number of minutes [0-59]\n" @@ -1406,6 +1428,19 @@ static const JanetReg os_cfuns[] = { "Get the absolute path for a given path, following ../, ./, and symlinks. " "Returns an absolute path as a string. Will raise an error on Windows.") }, + { + "os/perm-str", os_permission_string, + JDOC("(os/perm-str int)\n\n" + "Convert a Unix octal permission value from a permission integer as returned by os/stat " + "to a human readable string, that follows the formatting " + "of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not " + "include the file/directory/symlink character as rendered by `ls`.") + }, + { + "os/perm-int", os_permission_int, + JDOC("(os/perm-int bytes)\n\n" + "Parse a 9 character permission string and return an integer that can be used by chmod.") + }, #endif {NULL, NULL, NULL} }; From 95f1ef7561e23885a764787065bba8f440c4c7fb Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 15:12:58 -0500 Subject: [PATCH 056/107] Add umask support for windows, and allow parsing mode strings. --- CHANGELOG.md | 5 +++++ src/core/os.c | 21 +++++++++++---------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4d78abaf..e9d70353 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ # Changelog All notable changes to this project will be documented in this file. +## Unreleased - ??? +- Add os/umask +- Add os/perm-int +- Add os/perm-str + ## 1.8.1 - 2020-03-31 - Fix bugs for big endian systems - Fix 1.8.0 regression on BSDs diff --git a/src/core/os.c b/src/core/os.c index 7a8162c3..fb1e2c31 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -797,16 +797,6 @@ static Janet os_symlink(int32_t argc, Janet *argv) { #endif } -static Janet os_umask(int32_t argc, Janet *argv) { - janet_fixarity(argc, 1); -#ifdef JANET_WINDOWS - janet_panicf("os/umask not supported on Windows"); -#else - int32_t mask = janet_getinteger(argv, 0); - return janet_wrap_integer(umask(mask)); -#endif -} - static Janet os_mkdir(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); const char *path = janet_getcstring(argv, 0); @@ -1152,6 +1142,17 @@ static Janet os_chmod(int32_t argc, Janet *argv) { return janet_wrap_nil(); } +static Janet os_umask(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + int mask = (int) os_getmode(argv, 0); +#ifdef JANET_WINDOWS + int res = _umask(mask); +#else + int res = umask(mask); +#endif + return janet_wrap_integer(janet_perm_to_unix(res)); +} + static Janet os_dir(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); const char *dir = janet_getcstring(argv, 0); From a0d61e45d542190d9926a5160c6a67ca89db0b21 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 15:23:29 -0500 Subject: [PATCH 057/107] Change os/perm-str to os/perm-string. --- CHANGELOG.md | 2 +- src/core/os.c | 6 +++--- test/helper.janet | 3 ++- test/suite8.janet | 14 ++++++++++++++ 4 files changed, 20 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e9d70353..a83b1eab 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? - Add os/umask - Add os/perm-int -- Add os/perm-str +- Add os/perm-string ## 1.8.1 - 2020-03-31 - Fix bugs for big endian systems diff --git a/src/core/os.c b/src/core/os.c index fb1e2c31..35f6841a 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1303,7 +1303,7 @@ static const JanetReg os_cfuns[] = { "os/chmod", os_chmod, JDOC("(os/chmod path mode)\n\n" "Change file permissions, where mode is a permission string as returned by " - "os/perm-str, or an integer as returned by os/perm-int. " + "os/perm-string, or an integer as returned by os/perm-int. " "When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like " "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") }, @@ -1445,8 +1445,8 @@ static const JanetReg os_cfuns[] = { "Returns an absolute path as a string. Will raise an error on Windows.") }, { - "os/perm-str", os_permission_string, - JDOC("(os/perm-str int)\n\n" + "os/perm-string", os_permission_string, + JDOC("(os/perm-string int)\n\n" "Convert a Unix octal permission value from a permission integer as returned by os/stat " "to a human readable string, that follows the formatting " "of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not " diff --git a/test/helper.janet b/test/helper.janet index 1ac099df..373eb816 100644 --- a/test/helper.janet +++ b/test/helper.janet @@ -8,7 +8,8 @@ (defn assert "Override's the default assert with some nice error handling." - [x e] + [x &opt e] + (default e "assert error") (++ num-tests-run) (when x (++ num-tests-passed)) (if x diff --git a/test/suite8.janet b/test/suite8.janet index 5ba1e737..901c04a2 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -194,4 +194,18 @@ (assert (deep= @[] (accumulate2 + [])) "accumulate2 2") (assert (deep= @[] (accumulate 0 + [])) "accumulate 2") +# Perm strings + +(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1") +(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2") +(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3") + +(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4") +(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5") +(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6") + +(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7") +(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8") +(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9") + (end-suite) From b49b510732d403350a73e88043d38475bd7729ac Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 16:58:45 -0500 Subject: [PATCH 058/107] Update os/link docstring. --- src/core/os.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 35f6841a..20408fc1 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1343,8 +1343,9 @@ static const JanetReg os_cfuns[] = { { "os/link", os_link, JDOC("(os/link oldpath newpath &opt symlink)\n\n" - "Create a symlink from oldpath to newpath, returning nil. The 3rd optional parameter " - "enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.") + "Create a symlink from oldpath to newpath, returning nil. The third optional parameter " + "enables a symlink iff truthy. If the third optional parameter is falsey or not " + "provided, os/link creates a hard link. Does not work on Windows.") }, { "os/symlink", os_symlink, From 1aeb317863d841d3e3f6cfa4ff2ae31c7a9a5f59 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 17:04:05 -0500 Subject: [PATCH 059/107] Revise, revise, revise, and proofread. --- src/core/os.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index 20408fc1..6e75cca2 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1343,9 +1343,10 @@ static const JanetReg os_cfuns[] = { { "os/link", os_link, JDOC("(os/link oldpath newpath &opt symlink)\n\n" - "Create a symlink from oldpath to newpath, returning nil. The third optional parameter " - "enables a symlink iff truthy. If the third optional parameter is falsey or not " - "provided, os/link creates a hard link. Does not work on Windows.") + "Create a link at newpath that points to oldpath and returns nil. " + "Iff symlink is truthy, creates a symlink. " + "Iff symlink is falsey or not provided, " + "creates a hard link. Does not work on Windows.") }, { "os/symlink", os_symlink, From 72696600d80ab26287578a897c3571a91f7cf138 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 17:53:41 -0500 Subject: [PATCH 060/107] Add :deps opiton to declare-executable. This allows the addition of custom dependencies. --- auxbin/jpm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/auxbin/jpm b/auxbin/jpm index c2fee871..072bc37e 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -799,13 +799,15 @@ int main(int argc, const char **argv) { is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n This executable can be installed as well to the --binpath given." [&keys {:install install :name name :entry entry :headers headers - :cflags cflags :lflags lflags}] + :cflags cflags :lflags lflags :deps deps}] (def name (if is-win (string name ".exe") name)) (def dest (string "build" sep name)) (create-executable @{:cflags cflags :lflags lflags} entry dest) (add-dep "build" dest) (when headers (each h headers (add-dep dest h))) + (when deps + (each d deps (add-dep dest d))) (when install (install-rule dest (dyn :binpath JANET_BINPATH)))) From 8275da63fbee6ed44cb6e490fb4e6e4732345b9f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 18:28:43 -0500 Subject: [PATCH 061/107] Address #331 - Add :octal-permissions --- src/core/os.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 6e75cca2..cd3c9c53 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1005,6 +1005,9 @@ static Janet os_stat_inode(jstat_t *st) { static Janet os_stat_mode(jstat_t *st) { return janet_wrap_keyword(janet_decode_mode(st->st_mode)); } +static Janet os_stat_int_permissions(jstat_t *st) { + return janet_wrap_integer(janet_perm_to_unix(janet_decode_permissions(st->st_mode))); +} static Janet os_stat_permissions(jstat_t *st) { return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode))); } @@ -1057,6 +1060,7 @@ static const struct OsStatGetter os_stat_getters[] = { {"dev", os_stat_dev}, {"inode", os_stat_inode}, {"mode", os_stat_mode}, + {"octal-permissions", os_stat_int_permissions}, {"permissions", os_stat_permissions}, {"uid", os_stat_uid}, {"gid", os_stat_gid}, @@ -1282,7 +1286,8 @@ static const JanetReg os_cfuns[] = { " only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n" "\t:dev - the device that the file is on\n" "\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n" - "\t:permissions - A Unix permission integer like 8r740\n" + "\t:octal-permissions - A Unix permission integer like 8r744\n" + "\t:permissions - A Unix permission string like \"rwxr--r--\"\n" "\t:uid - File uid\n" "\t:gid - File gid\n" "\t:nlink - number of links to file\n" From 9f8420bf50089717f80dcad6e5fef54cf0356f21 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 3 Apr 2020 19:32:50 -0500 Subject: [PATCH 062/107] Add jpm repl subcommand and post-deps macro for jpm. This will allow more flexibility in writing jpm project files. --- CHANGELOG.md | 2 ++ auxbin/jpm | 73 ++++++++++++++++++++++++++++++++++++++-------------- jpm.1 | 9 +++++++ 3 files changed, 65 insertions(+), 19 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a83b1eab..b1ae5089 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ All notable changes to this project will be documented in this file. - Add os/umask - Add os/perm-int - Add os/perm-string +- Add :octal-permissions option for os/stat. +- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files. ## 1.8.1 - 2020-03-31 - Fix bugs for big endian systems diff --git a/auxbin/jpm b/auxbin/jpm index 072bc37e..80578d5c 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -181,11 +181,12 @@ (put into k (x k)))) into) -(defn import-rules - "Import another file that defines more rules. This ruleset - is merged into the current ruleset." - [path] +(defn require-jpm + "Require a jpm file project file. This is different from a normal require + in that code is loaded in the jpm environment." + [path &opt no-deps] (def env (make-env)) + (put env :jpm-no-deps no-deps) (unless (os/stat path :mode) (error (string "cannot open " path))) (loop [k :keys _env :when (symbol? k)] @@ -194,9 +195,24 @@ (loop [k :keys currenv :when (keyword? k)] (put env k (currenv k))) (dofile path :env env :exit true) + env) + +(defn import-rules + "Import another file that defines more rules. This ruleset + is merged into the current ruleset." + [path &opt no-deps] + (def env (require-jpm path no-deps)) (when-let [rules (env :rules)] (merge-into (getrules) rules)) env) +(defmacro post-deps + "Run code at the top level if jpm dependencies are installed. Build + code that imports dependencies should be wrapped with this macro, as project.janet + needs to be able to run successfully even without dependencies installed." + [& body] + (unless (dyn :jpm-no-deps) + ~',(reduce |(eval $1) nil body))) + # # OS and shell helpers # @@ -914,8 +930,8 @@ int main(int argc, const char **argv) { '(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1)))) (defn- local-rule - [rule] - (import-rules "./project.janet") + [rule &opt no-deps] + (import-rules "./project.janet" no-deps) (do-rule rule)) (defn- help @@ -950,6 +966,8 @@ Subcommands are: name is lockfile.janet. load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The default lockfile name is lockfile.janet. + 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. Keys are: --modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) @@ -963,15 +981,16 @@ Keys are: --pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git Flags are: + --nocolor : Disable color in the jpm repl. --verbose : Print shell commands as they are executed. --test : If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies. `)) -(defn- show-help +(defn show-help [] (print help)) -(defn- show-paths +(defn show-paths [] (print "binpath: " (dyn :binpath JANET_BINPATH)) (print "modpath: " (dyn :modpath JANET_MODPATH)) @@ -979,21 +998,21 @@ Flags are: (print "headerpath: " (dyn :headerpath JANET_HEADERPATH)) (print "syspath: " (dyn :syspath))) -(defn- build +(defn build [] (local-rule "build")) -(defn- clean +(defn clean [] (local-rule "clean")) -(defn- install +(defn install [&opt repo] (if repo (install-git repo) (local-rule "install"))) -(defn- test +(defn test [] (local-rule "test")) @@ -1003,25 +1022,40 @@ Flags are: (uninstall what) (local-rule "uninstall"))) -(defn- deps +(defn deps [] - (local-rule "install-deps")) + (local-rule "install-deps" true)) -(defn- list-rules - [] - (import-rules "./project.janet") +(defn list-rules + [&opt ctx] + (import-rules "./project.janet" true) (def ks (sort (seq [k :keys (dyn :rules)] k))) (each k ks (print k))) -(defn- update-pkgs +(defn update-pkgs [] (install-git (dyn :pkglist default-pkglist))) -(defn- quickbin +(defn quickbin [input output] (create-executable @{} input output) (do-rule output)) +(defn jpm-repl + [] + (def env (require-jpm "./project.janet")) + (def p (env :project)) + (def name (p :name)) + (setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q")) + (setdyn :err-color (if-not (dyn :nocolor) true)) + (print "Project: " name) + (print "Repository: " (p :repo)) + (print "Author: " (p :author)) + (defn getchunk [buf p] + (def [line] (parser/where p)) + (getline (string "jpm[" name "]:" line ":" (parser/state p :delimiters) "> ") buf env)) + (repl getchunk nil env)) + (def- subcommands {"build" build "clean" clean @@ -1030,6 +1064,7 @@ Flags are: "test" test "help" help "deps" deps + "repl" jpm-repl "show-paths" show-paths "clear-cache" clear-cache "run" local-rule diff --git a/jpm.1 b/jpm.1 index 2e749d77..0a0c72e3 100644 --- a/jpm.1 +++ b/jpm.1 @@ -24,6 +24,10 @@ More interesting are the local commands. For more information on jpm usage, see .SH FLAGS +.TP +.BR \-\-nocolor +Disable color in the jpm repl. + .TP .BR \-\-verbose Print detailed messages of what jpm is doing, including compilation commands and other shell commands. @@ -154,6 +158,11 @@ The main function is the entry point of the program and will receive command lin as function arguments. The entry file can import other modules, including native C modules, and jpm will attempt to include the dependencies into the generated executable. +.TP +.BR repl +Load the current project.janet file and start a repl in it's environment. This lets a user better +debug the project file, as well as run rules manually. + .SH ENVIRONMENT .B JANET_PATH From f089b2001f57454541a8ba37da649b27ae3b69ea Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 12:51:47 -0500 Subject: [PATCH 063/107] Add several math functions to the math module. --- CHANGELOG.md | 4 ++++ src/core/math.c | 30 ++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b1ae5089..804ea624 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `math/erf` +- Add `math/erfc` +- Add `math/log1p` +- Add `math/next` - Add os/umask - Add os/perm-int - Add os/perm-string diff --git a/src/core/math.c b/src/core/math.c index 5d853d07..b1c3fda9 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -255,6 +255,10 @@ JANET_DEFINE_MATHOP(fabs, fabs) JANET_DEFINE_MATHOP(floor, floor) JANET_DEFINE_MATHOP(trunc, trunc) JANET_DEFINE_MATHOP(round, round) +JANET_DEFINE_MATHOP(gamma, lgamma) +JANET_DEFINE_MATHOP(log1p, log1p) +JANET_DEFINE_MATHOP(erf, erf) +JANET_DEFINE_MATHOP(erfc, erfc) #define JANET_DEFINE_MATH2OP(name, fop)\ static Janet janet_##name(int32_t argc, Janet *argv) {\ @@ -267,6 +271,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\ JANET_DEFINE_MATH2OP(atan2, atan2) JANET_DEFINE_MATH2OP(pow, pow) JANET_DEFINE_MATH2OP(hypot, hypot) +JANET_DEFINE_MATH2OP(nextafter, nextafter) static Janet janet_not(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); @@ -438,6 +443,26 @@ static const JanetReg math_cfuns[] = { JDOC("(math/exp2 x)\n\n" "Returns 2 to the power of x.") }, + { + "math/log1p", janet_log1p, + JDOC("(math/log1p x)\n\n" + "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)") + }, + { + "math/gamma", janet_gamma, + JDOC("(math/gamma x)\n\n" + "Returns gamma(x).") + }, + { + "math/erfc", janet_erfc, + JDOC("(math/erfc x)\n\n" + "Returns the complementary error function of x.") + }, + { + "math/erf", janet_erf, + JDOC("(math/erf x)\n\n" + "Returns the error function of x.") + }, { "math/expm1", janet_expm1, JDOC("(math/expm1 x)\n\n" @@ -453,6 +478,11 @@ static const JanetReg math_cfuns[] = { JDOC("(math/round x)\n\n" "Returns the integer nearest to x.") }, + { + "math/next", janet_nextafter, + JDOC("(math/next y)\n\n" + "Returns the next representable floating point value after x in the direction of y.") + }, {NULL, NULL, NULL} }; From 1d0e86212901eb0bee6990a64e90134448c81704 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 13:09:59 -0500 Subject: [PATCH 064/107] Update Makefile for pkg-config issues and soname. --- Makefile | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 9b38f6ce..ce9e2cae 100644 --- a/Makefile +++ b/Makefile @@ -146,6 +146,8 @@ build/janet.c: build/janet_boot src/boot/boot.janet ##### Amalgamation ##### ######################## +SONAME=libjanet.so.1 + build/shell.c: src/mainclient/shell.c cp $< $@ @@ -165,7 +167,7 @@ $(JANET_TARGET): build/janet.o build/shell.o $(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS) $(JANET_LIBRARY): build/janet.o build/shell.o - $(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS) + $(CC) $(LDFLAGS) $(CFLAGS) -Wl,-soname,$(SONAME) -shared -o $@ $^ $(CLIBS) $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o $(AR) rcs $@ $^ @@ -228,8 +230,6 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet ##### Installation ##### ######################## -SONAME=libjanet.so.1 - .INTERMEDIATE: build/janet.pc build/janet.pc: $(JANET_TARGET) echo 'prefix=$(PREFIX)' > $@ @@ -242,7 +242,7 @@ build/janet.pc: $(JANET_TARGET) echo "Description: Library for the Janet programming language." >> $@ $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@ echo 'Cflags: -I$${includedir}' >> $@ - echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@ + echo 'Libs: -L$${libdir} -ljanet' >> $@ echo 'Libs.private: $(CLIBS)' >> $@ install: $(JANET_TARGET) build/janet.pc From 5b82b9e101d4a52cb698151832124f32da53d530 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 13:34:16 -0500 Subject: [PATCH 065/107] Address compiler warning on macos. --- src/core/os.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index cd3c9c53..fa006382 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -731,7 +731,10 @@ static timeint_t entry_getint(Janet env_entry, char *field) { static Janet os_mktime(int32_t argc, Janet *argv) { janet_arity(argc, 1, 2); time_t t; - struct tm t_info = { 0 }; + struct tm t_info; + + /* Use memset instead of = {0} to silence paranoid warning in macos */ + memset(&t_info, 0, sizeof(t_info)); if (!janet_checktype(argv[0], JANET_TABLE) && !janet_checktype(argv[0], JANET_STRUCT)) From 6b89da4bb2277c58aee84b8b1399800ec28ce595 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 13:44:21 -0500 Subject: [PATCH 066/107] Use -Wl,-install_name,... on macos. --- Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index ce9e2cae..5ca4e15f 100644 --- a/Makefile +++ b/Makefile @@ -36,6 +36,7 @@ JANET_PATH?=$(LIBDIR)/janet MANPATH?=$(PREFIX)/share/man/man1/ PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig DEBUGGER=gdb +SONAME_SETTER=-Wl,-soname, CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden LDFLAGS:=$(LDFLAGS) -rdynamic @@ -47,6 +48,7 @@ LDCONFIG:=ldconfig "$(LIBDIR)" UNAME:=$(shell uname -s) ifeq ($(UNAME), Darwin) CLIBS:=$(CLIBS) -ldl + SONAME_SETTER:=-Wl,-install_name, LDCONFIG:=true else ifeq ($(UNAME), Linux) CLIBS:=$(CLIBS) -lrt -ldl @@ -167,7 +169,7 @@ $(JANET_TARGET): build/janet.o build/shell.o $(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS) $(JANET_LIBRARY): build/janet.o build/shell.o - $(CC) $(LDFLAGS) $(CFLAGS) -Wl,-soname,$(SONAME) -shared -o $@ $^ $(CLIBS) + $(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS) $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o $(AR) rcs $@ $^ From 320c6c6f05e8d240ccb65d251821c64e71ee5ab6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 13:58:27 -0500 Subject: [PATCH 067/107] Increase NSIS installer verbosity. --- janet-installer.nsi | 1 + 1 file changed, 1 insertion(+) diff --git a/janet-installer.nsi b/janet-installer.nsi index 8348dca5..fc1bb000 100644 --- a/janet-installer.nsi +++ b/janet-installer.nsi @@ -3,6 +3,7 @@ Unicode True +!verbose 4 !echo "Program Files: ${PROGRAMFILES}" !addplugindir "tools\" From ff6601f29eed25480a085ffd03cb7457349db81f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 18:04:22 -0500 Subject: [PATCH 068/107] Add version and soversion to meson libjanet. --- meson.build | 2 ++ 1 file changed, 2 insertions(+) diff --git a/meson.build b/meson.build index 904f030a..23c7cd84 100644 --- a/meson.build +++ b/meson.build @@ -167,6 +167,8 @@ janetc = custom_target('janetc', libjanet = library('janet', janetc, include_directories : incdir, dependencies : [m_dep, dl_dep, thread_dep], + version: meson.project_version(), + soversion: version_parts[0] + '.' + version_parts[1], install : true) # Extra c flags - adding -fvisibility=hidden matches the Makefile and From bb5c478704dfdf3007a8999050cb5773009ec6e3 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 18:30:18 -0500 Subject: [PATCH 069/107] Switch to two digit sonames. Janet's versioning scheme is not 'true' semantic versioning. Minor versions can have and often do have breaking changes. Although such breakages are mostly avoided, only limited effort is made to prevent this, and no system is in place to verify this. Thus, stricter version pinning is needed. --- Makefile | 2 +- janet-installer.nsi | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 5ca4e15f..69d05be3 100644 --- a/Makefile +++ b/Makefile @@ -148,7 +148,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet ##### Amalgamation ##### ######################## -SONAME=libjanet.so.1 +SONAME=libjanet.so.1.8 build/shell.c: src/mainclient/shell.c cp $< $@ diff --git a/janet-installer.nsi b/janet-installer.nsi index fc1bb000..8348dca5 100644 --- a/janet-installer.nsi +++ b/janet-installer.nsi @@ -3,7 +3,6 @@ Unicode True -!verbose 4 !echo "Program Files: ${PROGRAMFILES}" !addplugindir "tools\" From 081d1325389221112f546b6dc3b5e597413c72d0 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 21:12:05 -0500 Subject: [PATCH 070/107] Address #321 Also improve docs for dofile and related functions. --- src/boot/boot.janet | 47 ++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index d17b613b..7332b428 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -32,7 +32,7 @@ (def buf (buffer "(" name)) (while (< index arglen) (buffer/push-string buf " ") - (buffer/format buf "%p" (in args index)) + (buffer/format buf "%j" (in args index)) (set index (+ index 1))) (array/push modifiers (string buf ")\n\n" docstr)) # Build return value @@ -1892,6 +1892,7 @@ (defn run-context "Run a context. This evaluates expressions of janet in an environment, and is encapsulates the parsing, compilation, and evaluation. + Returns (in environment :exit-value environment) when complete. opts is a table or struct of options. The options are as follows:\n\n\t :chunks - callback to read into a buffer - default is getline\n\t :on-parse-error - callback when parsing fails - default is bad-parse\n\t @@ -2149,13 +2150,15 @@ @{}) (defn dofile - "Evaluate a file and return the resulting environment." - [path & args] - (def {:exit exit-on-error - :source source - :env env - :expander expander - :evaluator evaluator} (table ;args)) + "Evaluate a file and return the resulting environment. :env, :expander, and + :evaluator are passed through to the underlying run-context call. + If exit is true, any top level errors will trigger a call to (os/exit 1) + after printing the error." + [path &keys + {:exit exit + :env env + :expander expander + :evaluator evaluator}] (def f (if (= (type path) :core/file) path (file/open path :rb))) @@ -2167,11 +2170,11 @@ (defn chunks [buf _] (file/read f 2048 buf)) (defn bp [&opt x y] (def ret (bad-parse x y)) - (if exit-on-error (os/exit 1)) + (if exit (os/exit 1)) ret) (defn bc [&opt x y z] (def ret (bad-compile x y z)) - (if exit-on-error (os/exit 1)) + (if exit (os/exit 1)) ret) (unless f (error (string "could not find file " path))) @@ -2183,7 +2186,7 @@ :on-status (fn [f x] (when (not= (fiber/status f) :dead) (debug/stacktrace f x) - (if exit-on-error (os/exit 1) (eflush)))) + (if exit (os/exit 1) (eflush)))) :evaluator evaluator :expander expander :source (if path-is-file "" spath)})) @@ -2244,18 +2247,14 @@ any errors encountered at the top level in the module will cause (os/exit 1) to be called. Dynamic bindings will NOT be imported." [path & args] - (def argm (map (fn [x] - (if (keyword? x) - x - (string x))) - args)) + (def argm (map |(if (keyword? $) $ (string $)) args)) (tuple import* (string path) ;argm)) (defmacro use "Similar to import, but imported bindings are not prefixed with a namespace identifier. Can also import multiple modules in one shot." [& modules] - ~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules))) + ~(do ,;(map |~(,import* ,(string $) :prefix "") modules))) ### ### @@ -2271,11 +2270,15 @@ the repl in." [&opt chunks onsignal env] (default env (make-env)) - (default chunks (fn [buf p] (getline (string "repl:" - ((parser/where p) 0) - ":" - (parser/state p :delimiters) "> ") - buf env))) + (default chunks + (fn [buf p] + (getline + (string + "repl:" + ((parser/where p) 0) + ":" + (parser/state p :delimiters) "> ") + buf env))) (defn make-onsignal [e level] From ae70a0338350ba93ea55722b5c671b3853a1cf79 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 21:46:08 -0500 Subject: [PATCH 071/107] Address #306 - Add unicode escapes. Unicode escapes have the same syntax as go - \uXXXX or \UXXXXXXXX. --- src/core/parse.c | 42 ++++++++++++++++++++++++++++++++++++++++- test/suite0.janet | 4 ++++ tools/tm_lang_gen.janet | 2 +- 3 files changed, 46 insertions(+), 2 deletions(-) diff --git a/src/core/parse.c b/src/core/parse.c index f6d6625f..3734d502 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -201,6 +201,8 @@ static int checkescape(uint8_t c) { default: return -1; case 'x': + case 'u': + case 'U': return 1; case 'n': return '\n'; @@ -228,6 +230,24 @@ static int checkescape(uint8_t c) { /* Forward declare */ static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c); +static void write_codepoint(JanetParser *p, int32_t codepoint) { + if (codepoint <= 0x7F) { + push_buf(p, (uint8_t) codepoint); + } else if (codepoint <= 0x7FF) { + push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0); + push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80); + } else if (codepoint <= 0xFFFF) { + push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0); + push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80); + push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80); + } else { + push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0); + push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80); + push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80); + push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80); + } +} + static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) { int digit = to_hex(c); if (digit < 0) { @@ -237,7 +257,23 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) { state->argn = (state->argn << 4) + digit; state->counter--; if (!state->counter) { - push_buf(p, (state->argn & 0xFF)); + push_buf(p, (uint8_t)(state->argn & 0xFF)); + state->argn = 0; + state->consumer = stringchar; + } + return 1; +} + +static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) { + int digit = to_hex(c); + if (digit < 0) { + p->error = "invalid hex digit in unicode escape"; + return 1; + } + state->argn = (state->argn << 4) + digit; + state->counter--; + if (!state->counter) { + write_codepoint(p, state->argn); state->argn = 0; state->consumer = stringchar; } @@ -254,6 +290,10 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) { state->counter = 2; state->argn = 0; state->consumer = escapeh; + } else if (c == 'u' || c == 'U') { + state->counter = c == 'u' ? 4 : 8; + state->argn = 0; + state->consumer = escapeu; } else { push_buf(p, (uint8_t) e); state->consumer = stringchar; diff --git a/test/suite0.janet b/test/suite0.janet index 70c3e6a8..f1d4432c 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -206,6 +206,10 @@ (def 🐮 :cow) (assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)") (assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa") +(assert (= "\U0001F637" "😷") "unicode escape 1") +(assert (= "\u2623" "\U00002623" "☣") "unicode escape 2") +(assert (= "\u24c2" "\U000024c2" "Ⓜ") "unicode escape 3") +(assert (= "\u0061" "a") "unicode escape 4") # Symbols with @ character diff --git a/tools/tm_lang_gen.janet b/tools/tm_lang_gen.janet index 9d283026..f19a23b8 100644 --- a/tools/tm_lang_gen.janet +++ b/tools/tm_lang_gen.janet @@ -308,7 +308,7 @@ match - (\\[nevr0zft"\\']|\\x[0-9a-fA-F][0-9a-fA-f]) + (\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{8}) name constant.character.escape.janet From 810ef7401cecb910deeb45f7b18975170eff4a35 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 4 Apr 2020 21:50:27 -0500 Subject: [PATCH 072/107] Update changelog and bump version to dev version. --- CHANGELOG.md | 1 + Makefile | 2 +- meson.build | 2 +- src/conf/janetconf.h | 6 +++--- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 804ea624..f50a5e79 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXXXX`. - Add `math/erf` - Add `math/erfc` - Add `math/log1p` diff --git a/Makefile b/Makefile index 69d05be3..68367962 100644 --- a/Makefile +++ b/Makefile @@ -148,7 +148,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet ##### Amalgamation ##### ######################## -SONAME=libjanet.so.1.8 +SONAME=libjanet.so.1.9 build/shell.c: src/mainclient/shell.c cp $< $@ diff --git a/meson.build b/meson.build index 23c7cd84..3633b9c3 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.8.1') + version : '1.9.0-dev') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 4a2175ce..4f8a93fe 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -27,10 +27,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 8 -#define JANET_VERSION_PATCH 1 +#define JANET_VERSION_MINOR 9 +#define JANET_VERSION_PATCH 0 #define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.8.1" +#define JANET_VERSION "1.9.0-dev" /* #define JANET_BUILD "local" */ From 98b2fa4d64e11911ea7b33c6404f045e5d5090ac Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Sun, 5 Apr 2020 23:05:18 +1200 Subject: [PATCH 073/107] Setup some simple fuzz helpers for unmarshal. --- tools/afl/README.md | 18 ++++++- tools/afl/generate_unmarshal_testcases.janet | 49 ++++++++++++++++++++ tools/afl/unmarshal_runner.janet | 2 + 3 files changed, 67 insertions(+), 2 deletions(-) create mode 100644 tools/afl/generate_unmarshal_testcases.janet create mode 100644 tools/afl/unmarshal_runner.janet diff --git a/tools/afl/README.md b/tools/afl/README.md index f4a8edb9..d7d76ab6 100644 --- a/tools/afl/README.md +++ b/tools/afl/README.md @@ -3,12 +3,26 @@ To use these, you need to install afl (of course), and xterm. A tiling window manager helps manage many concurrent fuzzer instances. +Note, afl sometimes requires system configuration, if you find AFL quitting prematurely, try manually +launching it and addressing any error messages. + ## Fuzz the parser ``` $ sh ./tools/afl/prepare_to_fuzz.sh -export NFUZZ=1 +$ export NFUZZ=1 $ sh ./tools/afl/fuzz.sh parser Ctrl+C when done to close all fuzzer terminals. $ sh ./tools/afl/aggregate_cases.sh parser $ ls ./fuzz_out/parser_aggregated/ -``` \ No newline at end of file +``` + +## Fuzz the unmarshaller +``` +$ janet ./tools/afl/generate_unmarshal_testcases.janet +$ sh ./tools/afl/prepare_to_fuzz.sh +$ export NFUZZ=1 +$ sh ./tools/afl/fuzz.sh unmarshal +Ctrl+C when done to close all fuzzer terminals. +$ sh ./tools/afl/aggregate_cases.sh unmarshal +$ ls ./fuzz_out/unmarshal_aggregated/ +``` diff --git a/tools/afl/generate_unmarshal_testcases.janet b/tools/afl/generate_unmarshal_testcases.janet new file mode 100644 index 00000000..d04e1890 --- /dev/null +++ b/tools/afl/generate_unmarshal_testcases.janet @@ -0,0 +1,49 @@ + +(os/mkdir "./tools/afl/unmarshal_testcases/") + +(defn spit-case [n v] + (spit + (string "./tools/afl/unmarshal_testcases/" (string n)) + (marshal v make-image-dict))) + +(def cases [ + nil + + "abc" + + :def + + 'hij + + 123 + + (int/s64 123) + + "7" + + [1 2 3] + + @[1 2 3] + + {:a 123} + + @{:b 'xyz} + + (peg/compile + '{:a (* "a" :b "a") + :b (* "b" (+ :a 0) "b") + :main (* "(" :b ")")}) + + (fn f [a] (fn [] {:ab a})) + + (fn f [a] (print "hello world!")) + + (do + (defn f [a] (yield) @[1 "2"]) + (def fb (fiber/new f)) + (resume fb) + fb) +]) + +(eachk i cases + (spit-case i (in cases i))) diff --git a/tools/afl/unmarshal_runner.janet b/tools/afl/unmarshal_runner.janet new file mode 100644 index 00000000..801e8e00 --- /dev/null +++ b/tools/afl/unmarshal_runner.janet @@ -0,0 +1,2 @@ + (pp (unmarshal (slurp ((dyn :args) 1)) load-image-dict)) + From 87ecdb811229f188ab1c832fef869587e49196df Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 07:09:53 -0500 Subject: [PATCH 074/107] Change \UXXXXXXXX -> \UXXXXXX and check codepoint max. No need to add two extra leading zeros, as the max unicode codepoint is 0x10FFFF. --- src/core/parse.c | 6 +++++- test/suite0.janet | 6 +++--- tools/tm_lang_gen.janet | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/core/parse.c b/src/core/parse.c index 3734d502..4ea736a0 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -273,6 +273,10 @@ static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) { state->argn = (state->argn << 4) + digit; state->counter--; if (!state->counter) { + if (state->argn > 0x10FFFF) { + p->error = "invalid unicode codepoint"; + return 1; + } write_codepoint(p, state->argn); state->argn = 0; state->consumer = stringchar; @@ -291,7 +295,7 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) { state->argn = 0; state->consumer = escapeh; } else if (c == 'u' || c == 'U') { - state->counter = c == 'u' ? 4 : 8; + state->counter = c == 'u' ? 4 : 6; state->argn = 0; state->consumer = escapeu; } else { diff --git a/test/suite0.janet b/test/suite0.janet index f1d4432c..c42de3b0 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -206,9 +206,9 @@ (def 🐮 :cow) (assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)") (assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa") -(assert (= "\U0001F637" "😷") "unicode escape 1") -(assert (= "\u2623" "\U00002623" "☣") "unicode escape 2") -(assert (= "\u24c2" "\U000024c2" "Ⓜ") "unicode escape 3") +(assert (= "\U01F637" "😷") "unicode escape 1") +(assert (= "\u2623" "\U002623" "☣") "unicode escape 2") +(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3") (assert (= "\u0061" "a") "unicode escape 4") # Symbols with @ character diff --git a/tools/tm_lang_gen.janet b/tools/tm_lang_gen.janet index f19a23b8..32fcf729 100644 --- a/tools/tm_lang_gen.janet +++ b/tools/tm_lang_gen.janet @@ -308,7 +308,7 @@ match - (\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{8}) + (\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{6}) name constant.character.escape.janet From 095827a2613942f3c2aa8d807cec4e1e8d3d4179 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 07:12:00 -0500 Subject: [PATCH 075/107] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f50a5e79..41208ada 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? -- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXXXX`. +- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. - Add `math/erf` - Add `math/erfc` - Add `math/log1p` From b145d4786380156230cca01bc5a55d14ca402915 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 08:01:18 -0500 Subject: [PATCH 076/107] Address cases 1 and 2 of #336. Mainly related to not checking ints < 0. --- src/core/marsh.c | 96 +++++++++++++++++++++++++++-------------------- test/suite8.janet | 5 +++ 2 files changed, 60 insertions(+), 41 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index d9cd3f70..0f91ae57 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -42,26 +42,26 @@ typedef struct { /* Lead bytes in marshaling protocol */ enum { LB_REAL = 200, - LB_NIL, - LB_FALSE, - LB_TRUE, - LB_FIBER, - LB_INTEGER, - LB_STRING, - LB_SYMBOL, - LB_KEYWORD, - LB_ARRAY, - LB_TUPLE, - LB_TABLE, - LB_TABLE_PROTO, - LB_STRUCT, - LB_BUFFER, - LB_FUNCTION, - LB_REGISTRY, - LB_ABSTRACT, - LB_REFERENCE, - LB_FUNCENV_REF, - LB_FUNCDEF_REF + LB_NIL, /* 201 */ + LB_FALSE, /* 202 */ + LB_TRUE, /* 203 */ + LB_FIBER, /* 204 */ + LB_INTEGER, /* 205 */ + LB_STRING, /* 206 */ + LB_SYMBOL, /* 207 */ + LB_KEYWORD, /* 208 */ + LB_ARRAY, /* 209 */ + LB_TUPLE, /* 210 */ + LB_TABLE, /* 211 */ + LB_TABLE_PROTO, /* 212 */ + LB_STRUCT, /* 213 */ + LB_BUFFER, /* 214 */ + LB_FUNCTION, /* 215 */ + LB_REGISTRY, /* 216 */ + LB_ABSTRACT, /* 217 */ + LB_REFERENCE, /* 218 */ + LB_FUNCENV_REF, /* 219 */ + LB_FUNCDEF_REF /* 220 */ } LeadBytes; /* Helper to look inside an entry in an environment */ @@ -634,6 +634,15 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) { return ret; } +/* Helper to read a natural number (int >= 0). */ +static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) { + int32_t ret = readint(st, atdata); + if (ret < 0) { + janet_panicf("expected integer >= 0, got %d", ret); + } + return ret; +} + /* Helper to read a size_t (up to 8 bytes unsigned). */ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) { uint64_t ret; @@ -704,8 +713,8 @@ static const uint8_t *unmarshal_one_env( env->offset = 0; janet_v_push(st->lookup_envs, env); int32_t offset = readint(st, &data); - int32_t length = readint(st, &data); - if (offset) { + int32_t length = readnat(st, &data); + if (offset > 0) { Janet fiberv; /* On stack variant */ data = unmarshal_one(st, data, &fiberv, flags); @@ -770,6 +779,11 @@ static const uint8_t *unmarshal_one_def( def->name = NULL; def->source = NULL; def->closure_bitset = NULL; + def->defs = NULL; + def->environments = NULL; + def->constants = NULL; + def->bytecode = NULL; + def->sourcemap = NULL; janet_v_push(st->lookup_defs, def); /* Set default lengths to zero */ @@ -780,18 +794,18 @@ static const uint8_t *unmarshal_one_def( /* Read flags and other fixed values */ def->flags = readint(st, &data); - def->slotcount = readint(st, &data); - def->arity = readint(st, &data); - def->min_arity = readint(st, &data); - def->max_arity = readint(st, &data); + def->slotcount = readnat(st, &data); + def->arity = readnat(st, &data); + def->min_arity = readnat(st, &data); + def->max_arity = readnat(st, &data); /* Read some lengths */ - constants_length = readint(st, &data); - bytecode_length = readint(st, &data); + constants_length = readnat(st, &data); + bytecode_length = readnat(st, &data); if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) - environments_length = readint(st, &data); + environments_length = readnat(st, &data); if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) - defs_length = readint(st, &data); + defs_length = readnat(st, &data); /* Check name and source (optional) */ if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) { @@ -866,7 +880,7 @@ static const uint8_t *unmarshal_one_def( for (int32_t i = 0; i < bytecode_length; i++) { current += readint(st, &data); def->sourcemap[i].line = current; - def->sourcemap[i].column = readint(st, &data); + def->sourcemap[i].column = readnat(st, &data); } } else { def->sourcemap = NULL; @@ -920,10 +934,10 @@ static const uint8_t *unmarshal_one_fiber( /* Read ints */ fiber->flags = readint(st, &data); - frame = readint(st, &data); - fiber->stackstart = readint(st, &data); - fiber->stacktop = readint(st, &data); - fiber->maxstack = readint(st, &data); + frame = readnat(st, &data); + fiber->stackstart = readnat(st, &data); + fiber->stacktop = readnat(st, &data); + fiber->maxstack = readnat(st, &data); /* Check for bad flags and ints */ if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart || @@ -947,8 +961,8 @@ static const uint8_t *unmarshal_one_fiber( JanetFuncDef *def = NULL; JanetFuncEnv *env = NULL; int32_t frameflags = readint(st, &data); - int32_t prevframe = readint(st, &data); - int32_t pcdiff = readint(st, &data); + int32_t prevframe = readnat(st, &data); + int32_t pcdiff = readnat(st, &data); /* Get frame items */ Janet *framestack = fiber->data + stack; @@ -984,7 +998,7 @@ static const uint8_t *unmarshal_one_fiber( janet_panic("fiber stackframe has invalid pc"); } if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) { - janet_panic("fibre stackframe does not align with previous frame"); + janet_panic("fiber stackframe does not align with previous frame"); } /* Get stack items */ @@ -1105,7 +1119,7 @@ static const uint8_t *unmarshal_one( MARSH_STACKCHECK; MARSH_EOS(st, data); lead = data[0]; - if (lead < 200) { + if (lead < LB_REAL) { *out = janet_wrap_integer(readint(st, &data)); return data; } @@ -1159,7 +1173,7 @@ static const uint8_t *unmarshal_one( case LB_KEYWORD: case LB_REGISTRY: { data++; - int32_t len = readint(st, &data); + int32_t len = readnat(st, &data); MARSH_EOS(st, data - 1 + len); if (lead == LB_STRING) { const uint8_t *str = janet_string(data, len); @@ -1219,7 +1233,7 @@ static const uint8_t *unmarshal_one( /* Things that open with integers */ { data++; - int32_t len = readint(st, &data); + int32_t len = readnat(st, &data); if (lead == LB_ARRAY) { /* Array */ JanetArray *array = janet_array(len); diff --git a/test/suite8.janet b/test/suite8.janet index 901c04a2..0c573d91 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -208,4 +208,9 @@ (assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8") (assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9") +# Issue #336 cases - don't segfault + +(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9")) +(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc")) + (end-suite) From c4ca0490ee43deadefdedfb634ab90cf0e598c6b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 08:16:40 -0500 Subject: [PATCH 077/107] Prevent unmarsal DOS in arrays,buffers,tables,and structs. --- src/core/marsh.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index 0f91ae57..cf87b187 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -1234,6 +1234,10 @@ static const uint8_t *unmarshal_one( { data++; int32_t len = readnat(st, &data); + /* DOS check */ + if (lead != LB_REFERENCE) { + MARSH_EOS(st, data - 1 + len); + } if (lead == LB_ARRAY) { /* Array */ JanetArray *array = janet_array(len); @@ -1265,7 +1269,7 @@ static const uint8_t *unmarshal_one( *out = janet_wrap_struct(janet_struct_end(struct_)); janet_v_push(st->lookup, *out); } else if (lead == LB_REFERENCE) { - if (len < 0 || len >= janet_v_count(st->lookup)) + if (len >= janet_v_count(st->lookup)) janet_panicf("invalid reference %d", len); *out = st->lookup[len]; } else { From 45156c0c479a8cdb1b50c096dad17ca8ebec9e61 Mon Sep 17 00:00:00 2001 From: Andrew Chambers Date: Mon, 6 Apr 2020 09:57:54 +1200 Subject: [PATCH 078/107] Make unmarshal fuzzer exercise more code paths. --- tools/afl/unmarshal_runner.janet | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tools/afl/unmarshal_runner.janet b/tools/afl/unmarshal_runner.janet index 801e8e00..31f43a53 100644 --- a/tools/afl/unmarshal_runner.janet +++ b/tools/afl/unmarshal_runner.janet @@ -1,2 +1,6 @@ - (pp (unmarshal (slurp ((dyn :args) 1)) load-image-dict)) - +# Unmarshal garbage. +(def v (unmarshal (slurp ((dyn :args) 1)) load-image-dict)) +# Trigger leaks or use after free. +(gccollect) +# Attempt to use generated value. +(marshal v make-image-dict) From 5bbd50785857c0c415469b9ae4848294b5318a29 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 17:38:14 -0500 Subject: [PATCH 079/107] Address #336 case 3 Fix error condition for bad abstract types - don't return NULL, panic. --- src/core/marsh.c | 5 +++-- test/suite8.janet | 1 + tools/afl/generate_unmarshal_testcases.janet | 14 +++++++------- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index cf87b187..f0728d98 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -1098,7 +1098,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t * Janet key; data = unmarshal_one(st, data, &key, flags + 1); const JanetAbstractType *at = janet_get_abstract_type(key); - if (at == NULL) return NULL; + if (at == NULL) goto oops; if (at->unmarshal) { JanetMarshalContext context = {NULL, st, flags, data, at}; *out = janet_wrap_abstract(at->unmarshal(&context)); @@ -1107,7 +1107,8 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t * } return context.data; } - return NULL; +oops: + janet_panic("invalid abstract type"); } static const uint8_t *unmarshal_one( diff --git a/test/suite8.janet b/test/suite8.janet index 0c573d91..8b9e0ea0 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -212,5 +212,6 @@ (assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9")) (assert-error "unmarshal errors 2" (unmarshal @"\xd7bc")) +(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict)) (end-suite) diff --git a/tools/afl/generate_unmarshal_testcases.janet b/tools/afl/generate_unmarshal_testcases.janet index d04e1890..d1eef322 100644 --- a/tools/afl/generate_unmarshal_testcases.janet +++ b/tools/afl/generate_unmarshal_testcases.janet @@ -8,15 +8,15 @@ (def cases [ nil - + "abc" - + :def - + 'hij - + 123 - + (int/s64 123) "7" @@ -28,12 +28,12 @@ {:a 123} @{:b 'xyz} - + (peg/compile '{:a (* "a" :b "a") :b (* "b" (+ :a 0) "b") :main (* "(" :b ")")}) - + (fn f [a] (fn [] {:ab a})) (fn f [a] (print "hello world!")) From fcc610f5396b1d9bf75c0ea4851ae3878ea04d7b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 19:18:59 -0500 Subject: [PATCH 080/107] Address #336 case 4 Set funcenv fields to NULL before any possible panics. --- src/core/marsh.c | 9 ++++++++- test/suite8.janet | 8 ++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index f0728d98..ef22de0d 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -711,8 +711,9 @@ static const uint8_t *unmarshal_one_env( JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv)); env->length = 0; env->offset = 0; + env->as.values = NULL; janet_v_push(st->lookup_envs, env); - int32_t offset = readint(st, &data); + int32_t offset = readnat(st, &data); int32_t length = readnat(st, &data); if (offset > 0) { Janet fiberv; @@ -727,6 +728,9 @@ static const uint8_t *unmarshal_one_env( janet_panic("invalid funcenv length"); } else { /* Off stack variant */ + if (length == 0) { + janet_panic("invalid funcenv length"); + } env->as.values = malloc(sizeof(Janet) * (size_t) length); if (!env->as.values) { JANET_OUT_OF_MEMORY; @@ -980,6 +984,9 @@ static const uint8_t *unmarshal_one_fiber( frameflags &= ~JANET_STACKFRAME_HASENV; int32_t offset = stack; int32_t length = stacktop - stack; + if (length <= 0) { + janet_panic("invalid funcenv length"); + } data = unmarshal_one_env(st, data, &env, flags + 1); if (env->offset != 0 && env->offset != offset) janet_panic("funcenv offset does not match fiber frame"); diff --git a/test/suite8.janet b/test/suite8.janet index 8b9e0ea0..2ab968a4 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -213,5 +213,13 @@ (assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9")) (assert-error "unmarshal errors 2" (unmarshal @"\xd7bc")) (assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict)) +(assert-error "unmarshal errors 4" + (unmarshal + @"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools + \0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE + \xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja + neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 + \0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict)) + (end-suite) From a3c55681b2e95022d76b06592f1de9826b635587 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Apr 2020 21:39:39 -0500 Subject: [PATCH 081/107] Address #336 case 6 --- src/core/marsh.c | 34 ++++++++++++++++++++-------------- test/suite8.janet | 13 +++++++++---- 2 files changed, 29 insertions(+), 18 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index ef22de0d..bb30eed6 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -916,7 +916,7 @@ static const uint8_t *unmarshal_one_fiber( JanetFiber **out, int flags) { - /* Initialize a new fiber */ + /* Initialize a new fiber with gc friendly defaults */ JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber)); fiber->flags = 0; fiber->frame = 0; @@ -937,16 +937,16 @@ static const uint8_t *unmarshal_one_fiber( int32_t stacktop = 0; /* Read ints */ - fiber->flags = readint(st, &data); + int32_t fiber_flags = readint(st, &data); frame = readnat(st, &data); - fiber->stackstart = readnat(st, &data); - fiber->stacktop = readnat(st, &data); - fiber->maxstack = readnat(st, &data); + int32_t fiber_stackstart = readnat(st, &data); + int32_t fiber_stacktop = readnat(st, &data); + int32_t fiber_maxstack = readnat(st, &data); /* Check for bad flags and ints */ - if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart || - fiber->stackstart > fiber->stacktop || - fiber->stacktop > fiber->maxstack) { + if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart || + fiber_stackstart > fiber_stacktop || + fiber_stacktop > fiber_maxstack) { janet_panic("fiber has incorrect stack setup"); } @@ -959,7 +959,7 @@ static const uint8_t *unmarshal_one_fiber( /* get frames */ stack = frame; - stacktop = fiber->stackstart - JANET_FRAME_SIZE; + stacktop = fiber_stackstart - JANET_FRAME_SIZE; while (stack > 0) { JanetFunction *func = NULL; JanetFuncDef *def = NULL; @@ -1028,25 +1028,31 @@ static const uint8_t *unmarshal_one_fiber( } /* Check for fiber env */ - if (fiber->flags & JANET_FIBER_FLAG_HASENV) { + if (fiber_flags & JANET_FIBER_FLAG_HASENV) { Janet envv; - fiber->flags &= ~JANET_FIBER_FLAG_HASENV; + fiber_flags &= ~JANET_FIBER_FLAG_HASENV; data = unmarshal_one(st, data, &envv, flags + 1); janet_asserttype(envv, JANET_TABLE); fiber->env = janet_unwrap_table(envv); } /* Check for child fiber */ - if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) { + if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) { Janet fiberv; - fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD; + fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD; data = unmarshal_one(st, data, &fiberv, flags + 1); janet_asserttype(fiberv, JANET_FIBER); fiber->child = janet_unwrap_fiber(fiberv); } - /* Return data */ + /* We have valid fiber, finally construct remaining fields. */ fiber->frame = frame; + fiber->flags = fiber_flags; + fiber->stackstart = fiber_stackstart; + fiber->stacktop = fiber_stacktop; + fiber->maxstack = fiber_maxstack; + + /* Return data */ *out = fiber; return data; } diff --git a/test/suite8.janet b/test/suite8.janet index 2ab968a4..b2b51740 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -216,10 +216,15 @@ (assert-error "unmarshal errors 4" (unmarshal @"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools - \0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE - \xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja - neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 - \0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict)) +\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE +\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja +neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 +\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict)) +# No segfault, valgrind clean. +(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF") +(unmarshal x load-image-dict) +(gccollect) +(marshal x make-image-dict) (end-suite) From c3c42ef56f530aa3b36c5b6f3b955fab08ca1dd7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Apr 2020 00:11:22 -0500 Subject: [PATCH 082/107] Fix case for #336. Also consider ascii 127 (delete) non-printable for string escapes. --- src/core/marsh.c | 20 ++++++++++---------- src/core/pp.c | 2 +- test/suite8.janet | 5 +++++ 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index bb30eed6..e9fb821b 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -931,17 +931,13 @@ static const uint8_t *unmarshal_one_fiber( /* Push fiber to seen stack */ janet_v_push(st->lookup, janet_wrap_fiber(fiber)); - /* Set frame later so fiber can be GCed at anytime if unmarshalling fails */ - int32_t frame = 0; - int32_t stack = 0; - int32_t stacktop = 0; - /* Read ints */ int32_t fiber_flags = readint(st, &data); - frame = readnat(st, &data); + int32_t frame = readnat(st, &data); int32_t fiber_stackstart = readnat(st, &data); int32_t fiber_stacktop = readnat(st, &data); int32_t fiber_maxstack = readnat(st, &data); + JanetTable *fiber_env = NULL; /* Check for bad flags and ints */ if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart || @@ -951,15 +947,18 @@ static const uint8_t *unmarshal_one_fiber( } /* Allocate stack memory */ - fiber->capacity = fiber->stacktop + 10; + fiber->capacity = fiber_stacktop + 10; fiber->data = malloc(sizeof(Janet) * fiber->capacity); if (!fiber->data) { JANET_OUT_OF_MEMORY; } + for (int32_t i = 0; i < fiber->capacity; i++) { + fiber->data[i] = janet_wrap_nil(); + } /* get frames */ - stack = frame; - stacktop = fiber_stackstart - JANET_FRAME_SIZE; + int32_t stack = frame; + int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE; while (stack > 0) { JanetFunction *func = NULL; JanetFuncDef *def = NULL; @@ -1033,7 +1032,7 @@ static const uint8_t *unmarshal_one_fiber( fiber_flags &= ~JANET_FIBER_FLAG_HASENV; data = unmarshal_one(st, data, &envv, flags + 1); janet_asserttype(envv, JANET_TABLE); - fiber->env = janet_unwrap_table(envv); + fiber_env = janet_unwrap_table(envv); } /* Check for child fiber */ @@ -1051,6 +1050,7 @@ static const uint8_t *unmarshal_one_fiber( fiber->stackstart = fiber_stackstart; fiber->stacktop = fiber_stacktop; fiber->maxstack = fiber_maxstack; + fiber->env = fiber_env; /* Return data */ *out = fiber; diff --git a/src/core/pp.c b/src/core/pp.c index 23e708de..b0c914fb 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -156,7 +156,7 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2); break; default: - if (c < 32 || c > 127) { + if (c < 32 || c > 126) { uint8_t buf[4]; buf[0] = '\\'; buf[1] = 'x'; diff --git a/test/suite8.janet b/test/suite8.janet index b2b51740..3855aa47 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -222,9 +222,14 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 \0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict)) # No segfault, valgrind clean. + (def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF") (unmarshal x load-image-dict) (gccollect) (marshal x make-image-dict) +(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9") +(unmarshal b load-image-dict) +(gccollect) + (end-suite) From 72beeeeaaabf72d5f659027900b67d668fecafa9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Apr 2020 10:58:47 -0500 Subject: [PATCH 083/107] Move funcenv verification to runtime. Lazy verification makes it easier to not leave funcenvs in an invalid state, as well as be more precise with the validation. We needed to verify the FuncEnvs actually pointed to a stack frame if they were of the "on-stack" variant. There was some minor checking before, but it was not enough to prevent func envs from pointing to memory that was off of the fiber stack, overlapping stack frames, etc. --- src/core/fiber.c | 31 ++++++++++++++++++++++++++++++- src/core/fiber.h | 1 + src/core/gc.c | 2 +- src/core/marsh.c | 25 ++++++------------------- src/core/vm.c | 6 ++++-- test/suite8.janet | 6 ++++++ 6 files changed, 48 insertions(+), 23 deletions(-) diff --git a/src/core/fiber.c b/src/core/fiber.c index ab45f58a..6ebb73d7 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -218,6 +218,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) { static void janet_env_detach(JanetFuncEnv *env) { /* Check for closure environment */ if (env) { + janet_env_valid(env); int32_t len = env->length; size_t s = sizeof(Janet) * (size_t) len; Janet *vmem = malloc(s); @@ -244,10 +245,38 @@ static void janet_env_detach(JanetFuncEnv *env) { } } +/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */ +int janet_env_valid(JanetFuncEnv *env) { + if (env->offset < 0) { + int32_t real_offset = -(env->offset); + JanetFiber *fiber = env->as.fiber; + int32_t i = fiber->frame; + while (i > 0) { + JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); + if (real_offset == i && + frame->env == env && + frame->func && + frame->func->def->slotcount == env->length) { + env->offset = real_offset; + return 1; + } + i = frame->prevframe; + } + /* Invalid, set to empty off-stack variant. */ + env->offset = 0; + env->length = 0; + env->as.values = NULL; + return 0; + } else { + return 1; + } +} + /* Detach a fiber from the env if the target fiber has stopped mutating */ void janet_env_maybe_detach(JanetFuncEnv *env) { /* Check for detachable closure envs */ - if (env->offset) { + janet_env_valid(env); + if (env->offset > 0) { JanetFiberStatus s = janet_fiber_status(env->as.fiber); int isFinished = s == JANET_STATUS_DEAD || s == JANET_STATUS_ERROR || diff --git a/src/core/fiber.h b/src/core/fiber.h index 50daf0f1..e99fa718 100644 --- a/src/core/fiber.h +++ b/src/core/fiber.h @@ -74,5 +74,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func); void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun); void janet_fiber_popframe(JanetFiber *fiber); void janet_env_maybe_detach(JanetFuncEnv *env); +int janet_env_valid(JanetFuncEnv *env); #endif diff --git a/src/core/gc.c b/src/core/gc.c index 5fc491bb..e90ef04b 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -193,7 +193,7 @@ static void janet_mark_funcenv(JanetFuncEnv *env) { /* If closure env references a dead fiber, we can just copy out the stack frame we need so * we don't need to keep around the whole dead fiber. */ janet_env_maybe_detach(env); - if (env->offset) { + if (env->offset > 0) { /* On stack */ janet_mark_fiber(env->as.fiber); } else { diff --git a/src/core/marsh.c b/src/core/marsh.c index e9fb821b..8aac488b 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -183,8 +183,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { return; } } + janet_env_valid(env); janet_v_push(st->seen_envs, env); - if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) { + if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) { pushint(st, 0); pushint(st, env->length); Janet *values = env->as.fiber->data + env->offset; @@ -200,7 +201,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { janet_env_maybe_detach(env); pushint(st, env->offset); pushint(st, env->length); - if (env->offset) { + if (env->offset > 0) { /* On stack variant */ marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1); } else { @@ -721,11 +722,8 @@ static const uint8_t *unmarshal_one_env( data = unmarshal_one(st, data, &fiberv, flags); janet_asserttype(fiberv, JANET_FIBER); env->as.fiber = janet_unwrap_fiber(fiberv); - /* Unmarshalling fiber may set values */ - if (env->offset != 0 && env->offset != offset) - janet_panic("invalid funcenv offset"); - if (env->length != 0 && env->length != length) - janet_panic("invalid funcenv length"); + /* Negative offset indicates untrusted input */ + env->offset = -offset; } else { /* Off stack variant */ if (length == 0) { @@ -735,10 +733,10 @@ static const uint8_t *unmarshal_one_env( if (!env->as.values) { JANET_OUT_OF_MEMORY; } + env->offset = 0; for (int32_t i = 0; i < length; i++) data = unmarshal_one(st, data, env->as.values + i, flags); } - env->offset = offset; env->length = length; *out = env; } @@ -981,18 +979,7 @@ static const uint8_t *unmarshal_one_fiber( /* Check env */ if (frameflags & JANET_STACKFRAME_HASENV) { frameflags &= ~JANET_STACKFRAME_HASENV; - int32_t offset = stack; - int32_t length = stacktop - stack; - if (length <= 0) { - janet_panic("invalid funcenv length"); - } data = unmarshal_one_env(st, data, &env, flags + 1); - if (env->offset != 0 && env->offset != offset) - janet_panic("funcenv offset does not match fiber frame"); - if (env->length != 0 && env->length != length) - janet_panic("funcenv length does not match fiber frame"); - env->offset = offset; - env->length = length; } /* Error checking */ diff --git a/src/core/vm.c b/src/core/vm.c index e96507b3..6ef676b1 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -824,7 +824,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { vm_assert(func->def->environments_length > eindex, "invalid upvalue environment"); env = func->envs[eindex]; vm_assert(env->length > vindex, "invalid upvalue index"); - if (env->offset) { + vm_assert(janet_env_valid(env), "invalid upvalue environment"); + if (env->offset > 0) { /* On stack */ stack[A] = env->as.fiber->data[env->offset + vindex]; } else { @@ -841,7 +842,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { vm_assert(func->def->environments_length > eindex, "invalid upvalue environment"); env = func->envs[eindex]; vm_assert(env->length > vindex, "invalid upvalue index"); - if (env->offset) { + vm_assert(janet_env_valid(env), "invalid upvalue environment"); + if (env->offset > 0) { env->as.fiber->data[env->offset + vindex] = stack[A]; } else { env->as.values[vindex] = stack[A]; diff --git a/test/suite8.janet b/test/suite8.janet index 3855aa47..3b982972 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -232,4 +232,10 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (unmarshal b load-image-dict) (gccollect) +(def v + (unmarshal + @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000" + load-image-dict)) +(gccollect) + (end-suite) From b75a22b753a741d8b6ea0f075cb9a982ceee1181 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Apr 2020 12:41:56 -0500 Subject: [PATCH 084/107] Make JANET_FRAME_SIZE consistent across architectures. This means unmarshalling fibers should work across arches. --- src/core/marsh.c | 2 +- src/include/janet.h | 5 +++-- test/suite8.janet | 7 +++---- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/marsh.c b/src/core/marsh.c index 8aac488b..edf154a2 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -987,7 +987,7 @@ static const uint8_t *unmarshal_one_fiber( if (expected_framesize != stacktop - stack) { janet_panic("fiber stackframe size mismatch"); } - if (pcdiff < 0 || pcdiff >= def->bytecode_length) { + if (pcdiff >= def->bytecode_length) { janet_panic("fiber stackframe has invalid pc"); } if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) { diff --git a/src/include/janet.h b/src/include/janet.h index d874cb53..00975136 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -733,8 +733,9 @@ struct JanetStackFrame { int32_t flags; }; -/* Number of Janets a frame takes up in the stack */ -#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet)) +/* Number of Janets a frame takes up in the stack + * Should be constant across architectures */ +#define JANET_FRAME_SIZE 4 /* A dynamic array type. */ struct JanetArray { diff --git a/test/suite8.janet b/test/suite8.janet index 3b982972..516b7a12 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -232,10 +232,9 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (unmarshal b load-image-dict) (gccollect) -(def v - (unmarshal - @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000" - load-image-dict)) +(unmarshal + @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000" + load-image-dict) (gccollect) (end-suite) From e6d4e729fb941718eb998706d72dc2afde2d097a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Apr 2020 17:24:52 -0500 Subject: [PATCH 085/107] Keep reference alive so unmarshalled object not collected. --- test/suite8.janet | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/suite8.janet b/test/suite8.janet index 516b7a12..5accdcc0 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -232,9 +232,9 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (unmarshal b load-image-dict) (gccollect) -(unmarshal +(def v (unmarshal @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000" - load-image-dict) + load-image-dict)) (gccollect) (end-suite) From b63a0796fd781b39dea48b6b919e8d63c2d7e185 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Josef=20Pospi=CC=81s=CC=8Cil?= Date: Thu, 9 Apr 2020 14:35:57 +0200 Subject: [PATCH 086/107] Fix last for empty collection, add tests --- src/boot/boot.janet | 2 +- test/suite8.janet | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 7332b428..26e99b47 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -648,7 +648,7 @@ (defn last "Get the last element from an indexed data structure." [xs] - (in xs (- (length xs) 1))) + (get xs (- (length xs) 1))) ### ### diff --git a/test/suite8.janet b/test/suite8.janet index 5accdcc0..591427ee 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -237,4 +237,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 load-image-dict)) (gccollect) +# in vs get regression +(assert (nil? (first @"")) "in vs get 1") +(assert (nil? (last @"")) "in vs get 1") + (end-suite) From 02f17bd4e40098aaf05f0e1ace046b5af4b546e0 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 9 Apr 2020 20:42:49 -0500 Subject: [PATCH 087/107] Add sort-by and sorted-by. --- CHANGELOG.md | 1 + src/boot/boot.janet | 65 +++++++++++++++++++++++++++------------------ test/suite0.janet | 5 ++++ 3 files changed, 45 insertions(+), 26 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 41208ada..49fce35b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `sort-by` and `sorted-by` to core. - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. - Add `math/erf` - Add `math/erfc` diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 7332b428..cb914cad 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -656,41 +656,54 @@ ### ### -(def sort - "(sort xs [, by])\n\nSort an array in-place. Uses quick-sort and is not a stable sort." - (do +(defn- sort-part + [a lo hi by] + (def pivot (in a hi)) + (var i lo) + (for j lo hi + (def aj (in a j)) + (when (by aj pivot) + (def ai (in a i)) + (set (a i) aj) + (set (a j) ai) + (++ i))) + (set (a hi) (in a i)) + (set (a i) pivot) + i) - (defn part - [a lo hi by] - (def pivot (in a hi)) - (var i lo) - (for j lo hi - (def aj (in a j)) - (when (by aj pivot) - (def ai (in a i)) - (set (a i) aj) - (set (a j) ai) - (++ i))) - (set (a hi) (in a i)) - (set (a i) pivot) - i) +(defn- sort-help + [a lo hi by] + (when (> hi lo) + (def piv (sort-part a lo hi by)) + (sort-help a lo (- piv 1) by) + (sort-help a (+ piv 1) hi by)) + a) - (defn sort-help - [a lo hi by] - (when (> hi lo) - (def piv (part a lo hi by)) - (sort-help a lo (- piv 1) by) - (sort-help a (+ piv 1) hi by)) - a) +(defn sort + "Sort an array in-place. Uses quick-sort and is not a stable sort." + [a &opt by] + (sort-help a 0 (- (length a) 1) (or by <))) - (fn sort [a &opt by] - (sort-help a 0 (- (length a) 1) (or by <))))) +(put _env 'sort-part nil) +(put _env 'sort-help nil) + +(defn sort-by + "Returns a new sorted array that compares elements by invoking + a function on each element and comparing the result with <." + [f ind] + (sort ind (fn [x y] (< (f x) (f y))))) (defn sorted "Returns a new sorted array without modifying the old one." [ind &opt by] (sort (array/slice ind) by)) +(defn sorted-by + "Returns a new sorted array that compares elements by invoking + a function on each element and comparing the result with <." + [f ind] + (sorted ind (fn [x y] (< (f x) (f y))))) + (defn reduce "Reduce, also know as fold-left in many languages, transforms an indexed type (array, tuple) with a function to produce a value." diff --git a/test/suite0.janet b/test/suite0.janet index c42de3b0..2af92f63 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -254,6 +254,11 @@ (assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3") (assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4") +(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1") +(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2") +(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3") +(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4") + # Gensym tests (assert (not= (gensym) (gensym)) "two gensyms not equal") From 3b0e6357ad27e9499c1d1988e4990cff2100f221 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Apr 2020 11:36:23 -0500 Subject: [PATCH 088/107] Make Ctrl-G in repl show docstring for symbol. Can be used to browse docs without poluting your repl session. --- src/boot/boot.janet | 6 +- src/mainclient/shell.c | 159 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 150 insertions(+), 15 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index cb914cad..82f5d806 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -467,7 +467,7 @@ (for-template i start stop 1 < + body)) (defmacro eachk - "loop over each key in ds. returns nil." + "Loop over each key in ds. Returns nil." [x ds & body] (keys-template x ds false body)) @@ -1495,9 +1495,9 @@ (defn doc-format "Reformat text to wrap at a given line." - [text] + [text &opt width] - (def maxcol (- (dyn :doc-width 80) 8)) + (def maxcol (- (or width (dyn :doc-width 80)) 8)) (var buf @" ") (var word @"") (var current 0) diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index 65834376..31befdac 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -515,6 +515,147 @@ static void check_specials(JanetByteView src) { check_cmatch(src, "while"); } +static void resolve_format(JanetTable *entry) { + int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro"))); + Janet refv = janet_table_get(entry, janet_ckeywordv("ref")); + int is_ref = janet_checktype(refv, JANET_ARRAY); + Janet value = janet_wrap_nil(); + if (is_ref) { + JanetArray *a = janet_unwrap_array(refv); + if (a->count) value = a->data[0]; + } else { + value = janet_table_get(entry, janet_ckeywordv("value")); + } + if (is_macro) { + fprintf(stderr, " macro\n"); + gbl_lines_below++; + } else if (is_ref) { + janet_eprintf(" var (%t)\n", value); + gbl_lines_below++; + } else { + janet_eprintf(" %t\n", value); + gbl_lines_below++; + } + Janet sm = janet_table_get(entry, janet_ckeywordv("source-map")); + Janet path = janet_get(sm, janet_wrap_integer(0)); + Janet line = janet_get(sm, janet_wrap_integer(1)); + Janet col = janet_get(sm, janet_wrap_integer(2)); + if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) { + janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col); + gbl_lines_below++; + } +} + +static void doc_format(JanetString doc, int32_t width) { + int32_t maxcol = width - 8; + uint8_t wordbuf[256] = {0}; + int32_t wordp = 0; + int32_t current = 0; + if (maxcol > 200) maxcol = 200; + fprintf(stderr, " "); + for (int32_t i = 0; i < janet_string_length(doc); i++) { + uint8_t b = doc[i]; + switch (b) { + default: { + if (maxcol <= current + wordp + 1) { + if (!current) { + fwrite(wordbuf, wordp, 1, stderr); + wordp = 0; + } + fprintf(stderr, "\n "); + gbl_lines_below++; + current = 0; + } + wordbuf[wordp++] = b; + break; + } + case '\t': { + if (maxcol <= current + wordp + 2) { + if (!current) { + fwrite(wordbuf, wordp, 1, stderr); + wordp = 0; + } + fprintf(stderr, "\n "); + gbl_lines_below++; + current = 0; + } + wordbuf[wordp++] = ' '; + wordbuf[wordp++] = ' '; + break; + } + case '\n': + case ' ': { + if (wordp) { + int32_t oldcur = current; + int spacer = maxcol > current + wordp + 1; + if (spacer) current++; + else current = 0; + current += wordp; + if (oldcur) fprintf(stderr, spacer ? " " : "\n "); + if (oldcur && !spacer) gbl_lines_below++; + fwrite(wordbuf, wordp, 1, stderr); + wordp = 0; + } + if (b == '\n') { + fprintf(stderr, "\n "); + gbl_lines_below++; + current = 0; + } + } + } + } + if (wordp) { + int32_t oldcur = current; + int spacer = maxcol > current + wordp + 1; + if (spacer) current++; + else current = 0; + current += wordp + 1; + if (oldcur) fprintf(stderr, spacer ? " " : "\n "); + if (oldcur && !spacer) gbl_lines_below++; + fwrite(wordbuf, wordp, 1, stderr); + wordp = 0; + } +} + +static void find_matches(JanetByteView prefix) { + JanetTable *env = gbl_complete_env; + gbl_match_count = 0; + while (NULL != env) { + JanetKV *kvend = env->data + env->capacity; + for (JanetKV *kv = env->data; kv < kvend; kv++) { + if (!janet_checktype(kv->key, JANET_SYMBOL)) continue; + const uint8_t *sym = janet_unwrap_symbol(kv->key); + check_match(prefix, sym, janet_string_length(sym)); + } + env = env->proto; + } +} + +static void kshowdoc(void) { + if (!gbl_complete_env) return; + while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++; + JanetByteView prefix = get_symprefix(); + Janet symbol = janet_symbolv(prefix.bytes, prefix.len); + Janet entry = janet_table_get(gbl_complete_env, symbol); + if (!janet_checktype(entry, JANET_TABLE)) return; + Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc")); + if (!janet_checktype(doc, JANET_STRING)) return; + JanetString docs = janet_unwrap_string(doc); + int num_cols = getcols(); + clearlines(); + fprintf(stderr, "\n\n\n"); + gbl_lines_below += 3; + resolve_format(janet_unwrap_table(entry)); + fprintf(stderr, "\n"); + gbl_lines_below += 1; + doc_format(docs, num_cols); + fprintf(stderr, "\n\n"); + gbl_lines_below += 2; + /* Go up to original line (zsh-like autocompletion) */ + fprintf(stderr, "\x1B[%dA", gbl_lines_below); + fflush(stderr); +} + static void kshowcomp(void) { JanetTable *env = gbl_complete_env; if (env == NULL) { @@ -528,19 +669,9 @@ static void kshowcomp(void) { gbl_pos++; JanetByteView prefix = get_symprefix(); - if (prefix.len == 0) return; + if (prefix.len == 0) return; - /* Find all matches */ - gbl_match_count = 0; - while (NULL != env) { - JanetKV *kvend = env->data + env->capacity; - for (JanetKV *kv = env->data; kv < kvend; kv++) { - if (!janet_checktype(kv->key, JANET_SYMBOL)) continue; - const uint8_t *sym = janet_unwrap_symbol(kv->key); - check_match(prefix, sym, janet_string_length(sym)); - } - env = env->proto; - } + find_matches(prefix); check_specials(prefix); @@ -633,6 +764,10 @@ static int line() { case 6: /* ctrl-f */ kright(); break; + case 7: /* ctrl-g */ + kshowdoc(); + refresh(); + break; case 127: /* backspace */ case 8: /* ctrl-h */ kbackspace(1); From e1f4cadf4169c0516e01e8f74879590c8861cf5d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Apr 2020 17:01:41 -0500 Subject: [PATCH 089/107] Add debugger to the core repl. Debugger functions are prefixed by periods. --- CHANGELOG.md | 2 + examples/debugger.janet | 8 +- janet.1 | 10 +++ src/boot/boot.janet | 160 +++++++++++++++++++++++++++++++++++++++- 4 files changed, 174 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 49fce35b..ca4976d2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add debugger to core. The debugger functions are only available + in a debug repl, and are prefixed by a `.`. - Add `sort-by` and `sorted-by` to core. - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. - Add `math/erf` diff --git a/examples/debugger.janet b/examples/debugger.janet index bcc0dcd9..588e55f3 100644 --- a/examples/debugger.janet +++ b/examples/debugger.janet @@ -1,20 +1,18 @@ ### ### A useful debugger library for Janet. Should be used -### inside a debug repl. +### inside a debug repl. This has been moved into the core. ### (defn .fiber "Get the current fiber being debugged." [] - (if-let [entry (dyn '_fiber)] - (entry :value) - (dyn :fiber))) + (dyn :fiber)) (defn .stack "Print the current fiber stack" [] (print) - (debug/stacktrace (.fiber) "") + (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) (print)) (defn .frame diff --git a/janet.1 b/janet.1 index dfc415ee..5f8a9c02 100644 --- a/janet.1 +++ b/janet.1 @@ -96,6 +96,10 @@ Delete everything before the cursor on the input line. .BR Ctrl\-W Delete one word before the cursor. +.TP 16 +.BR Ctrl\-G +Show documentation for the current symbol under the cursor. + .TP 16 .BR Alt\-B/Alt\-F Move cursor backwards and forwards one word. @@ -148,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier arguments are executed before later ones. +.TP +.BR \-d +Enable debug mode. On all terminating signals as well the debug signal, this will +cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a +default repl. + .TP .BR \-n Disable ANSI colors in the repl. Has no effect if no repl is run. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 82f5d806..47a00b8a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2269,6 +2269,157 @@ [& modules] ~(do ,;(map |~(,import* ,(string $) :prefix "") modules))) +### +### +### Debugger +### +### + +(defn .fiber + "Get the current fiber being debugged." + [] + (dyn :fiber)) + +(defn .stack + "Print the current fiber stack" + [] + (print) + (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) + (print)) + +(defn .frame + "Show a stack frame" + [&opt n] + (def stack (debug/stack (.fiber))) + (in stack (or n 0))) + +(defn .fn + "Get the current function" + [&opt n] + (in (.frame n) :function)) + +(defn .slots + "Get an array of slots in a stack frame" + [&opt n] + (in (.frame n) :slots)) + +(defn .slot + "Get the value of the nth slot." + [&opt nth frame-idx] + (in (.slots frame-idx) (or nth 0))) + +(defn .disasm + "Gets the assembly for the current function." + [&opt n] + (def frame (.frame n)) + (def func (frame :function)) + (disasm func)) + +(defn .bytecode + "Get the bytecode for the current function." + [&opt n] + ((.disasm n) 'bytecode)) + +(defn .ppasm + "Pretty prints the assembly for the current function" + [&opt n] + (def frame (.frame n)) + (def func (frame :function)) + (def dasm (disasm func)) + (def bytecode (dasm 'bytecode)) + (def pc (frame :pc)) + (def sourcemap (dasm 'sourcemap)) + (var last-loc [-2 -2]) + (print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]") + (when-let [constants (dasm 'constants)] + (printf " constants: %.4q" constants)) + (printf " slots: %.4q\n" (frame :slots)) + (def padding (string/repeat " " 20)) + (loop [i :range [0 (length bytecode)] + :let [instr (bytecode i)]] + (prin (if (= (tuple/type instr) :brackets) "*" " ")) + (prin (if (= i pc) "> " " ")) + (prinf "%.20s" (string (string/join (map string instr) " ") padding)) + (when sourcemap + (let [[sl sc] (sourcemap i) + loc [sl sc]] + (when (not= loc last-loc) + (set last-loc loc) + (prin " # line " sl ", column " sc)))) + (print)) + (print)) + +(defn .source + "Show the source code for the function being debugged." + [&opt n] + (def frame (.frame n)) + (def s (frame :source)) + (def all-source (slurp s)) + (print "\n" all-source "\n")) + +(defn .breakall + "Set breakpoints on all instructions in the current function." + [&opt n] + (def fun (.fn n)) + (def bytecode (.bytecode n)) + (for i 0 (length bytecode) + (debug/fbreak fun i)) + (print "Set " (length bytecode) " breakpoints in " fun)) + +(defn .clearall + "Clear all breakpoints on the current function." + [&opt n] + (def fun (.fn n)) + (def bytecode (.bytecode n)) + (for i 0 (length bytecode) + (debug/unfbreak fun i)) + (print "Cleared " (length bytecode) " breakpoints in " fun)) + +(defn .break + "Set breakpoint at the current pc." + [] + (def frame (.frame)) + (def fun (frame :function)) + (def pc (frame :pc)) + (debug/fbreak fun pc) + (print "Set breakpoint in " fun " at pc=" pc)) + +(defn .clear + "Clear the current breakpoint" + [] + (def frame (.frame)) + (def fun (frame :function)) + (def pc (frame :pc)) + (debug/unfbreak fun pc) + (print "Cleared breakpoint in " fun " at pc=" pc)) + +(defn .next + "Go to the next breakpoint." + [&opt n] + (var res nil) + (for i 0 (or n 1) + (set res (resume (.fiber)))) + res) + +(defn .nextc + "Go to the next breakpoint, clearing the current breakpoint." + [&opt n] + (.clear) + (.next n)) + +(defn .step + "Execute the next n instructions." + [&opt n] + (var res nil) + (for i 0 (or n 1) + (set res (debug/step (.fiber)))) + res) + +(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env))) +(def- debugger-env @{}) +(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil)) +(put _env 'debugger-keys nil) + ### ### ### REPL @@ -2301,6 +2452,7 @@ (put nextenv :fiber f) (put nextenv :debug-level level) (put nextenv :signal x) + (merge-into nextenv debugger-env) (debug/stacktrace f x) (eflush) (defn debugger-chunks [buf p] @@ -2327,6 +2479,8 @@ :on-status (or onsignal (make-onsignal env 1)) :source "repl"})) +(put _env 'debugger-env nil) + ### ### ### CLI Tool Main @@ -2370,6 +2524,7 @@ (var *handleopts* true) (var *exit-on-error* true) (var *colorize* true) + (var *debug* false) (var *compile-only* false) (if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp)) @@ -2385,6 +2540,7 @@ -v : Print the version string -s : Use raw stdin instead of getline like functionality -e code : Execute a string of janet + -d : Set the debug flag in the repl -r : Enter the repl after running all scripts -p : Keep on executing if there is a top level error (persistent) -q : Hide prompt, logo, and repl output (quiet) @@ -2417,7 +2573,8 @@ "e" (fn [i &] (set *no-file* false) (eval-string (in args (+ i 1))) - 2)}) + 2) + "d" (fn [&] (set *debug* true) 1)}) (defn- dohandler [n i &] (def h (in handlers n)) @@ -2476,6 +2633,7 @@ (file/flush stdout) (file/read stdin :line buf)) (def env (make-env)) + (if *debug* (put env :debug true)) (def getter (if *raw-stdin* getstdin getline)) (defn getchunk [buf p] (getter (prompter p) buf env)) From 5ed76f197a12683791df815a741eb3908cc114c8 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Apr 2020 18:29:10 -0500 Subject: [PATCH 090/107] Differentiate error from resume and error from resumed fiber. --- src/boot/boot.janet | 14 ++++++++++---- src/core/vm.c | 32 ++++++++++++++++++++++++++------ 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 47a00b8a..d9c2e132 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2280,11 +2280,16 @@ [] (dyn :fiber)) +(defn .signal + "Get the current signal being debugged." + [] + (dyn :signal)) + (defn .stack "Print the current fiber stack" [] (print) - (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) + (with-dyns [:err-color false] (debug/stacktrace (.fiber) (.signal))) (print)) (defn .frame @@ -2330,7 +2335,8 @@ (def pc (frame :pc)) (def sourcemap (dasm 'sourcemap)) (var last-loc [-2 -2]) - (print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]") + (print "\n signal: " (.signal)) + (print " function: " (dasm 'name) " [" (in dasm 'source "") "]") (when-let [constants (dasm 'constants)] (printf " constants: %.4q" constants)) (printf " slots: %.4q\n" (frame :slots)) @@ -2458,8 +2464,8 @@ (defn debugger-chunks [buf p] (def status (parser/state p :delimiters)) (def c ((parser/where p) 0)) - (def prompt (string "debug[" level "]:" c ":" status "> ")) - (getline prompt buf nextenv)) + (def prpt (string "debug[" level "]:" c ":" status "> ")) + (getline prpt buf nextenv)) (print "entering debug[" level "] - (quit) to exit") (flush) (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv) diff --git a/src/core/vm.c b/src/core/vm.c index 6ef676b1..868a7b96 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -89,8 +89,8 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL; func = janet_stack_frame(stack)->func; \ } while (0) #define vm_return(sig, val) do { \ - vm_commit(); \ janet_vm_return_reg[0] = (val); \ + vm_commit(); \ return (sig); \ } while (0) @@ -290,6 +290,10 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh } } +/* Forward declaration */ +static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out); +static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out); + /* Interpreter main loop */ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { @@ -999,8 +1003,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { Janet retreg; vm_assert_type(stack[B], JANET_FIBER); JanetFiber *child = janet_unwrap_fiber(stack[B]); + if (janet_check_can_resume(child, &retreg)) { + vm_commit(); + janet_panicv(retreg); + } fiber->child = child; - JanetSignal sig = janet_continue(child, stack[C], &retreg); + JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg); if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) { vm_return(sig, retreg); } @@ -1241,10 +1249,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) { return *janet_vm_return_reg; } -/* Enter the main vm loop */ -JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { - jmp_buf buf; - +static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) { /* Check conditions */ JanetFiberStatus old_status = janet_fiber_status(fiber); if (janet_vm_stackn >= JANET_RECURSION_GUARD) { @@ -1261,6 +1266,13 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { *out = janet_wrap_string(str); return JANET_SIGNAL_ERROR; } + return JANET_SIGNAL_OK; +} + +static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) { + jmp_buf buf; + + JanetFiberStatus old_status = janet_fiber_status(fiber); /* Continue child fiber if it exists */ if (fiber->child) { @@ -1330,6 +1342,14 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { return signal; } +/* Enter the main vm loop */ +JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) { + /* Check conditions */ + JanetSignal tmp_signal = janet_check_can_resume(fiber, out); + if (tmp_signal) return tmp_signal; + return janet_continue_no_check(fiber, in, out); +} + JanetSignal janet_pcall( JanetFunction *fun, int32_t argc, From 8bc2987a71d049b1d8e368771881995e31dee1b9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Apr 2020 12:49:39 -0500 Subject: [PATCH 091/107] (struct ...) with duped keys will use last value. --- CHANGELOG.md | 2 ++ src/core/parse.c | 14 ++++++++------ src/core/struct.c | 3 ++- test/suite0.janet | 6 ++++++ 4 files changed, 18 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ca4976d2..c21568c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- A struct/table literal/constructor with duplicate keys will use the last value given. + Previously, this was inconsistent between tables and structs, literals and constructor functions. - Add debugger to core. The debugger functions are only available in a debug repl, and are prefixed by a `.`. - Add `sort-by` and `sorted-by` to core. diff --git a/src/core/parse.c b/src/core/parse.c index 4ea736a0..6e479478 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -437,21 +437,23 @@ static Janet close_array(JanetParser *p, JanetParseState *state) { static Janet close_struct(JanetParser *p, JanetParseState *state) { JanetKV *st = janet_struct_begin(state->argn >> 1); - for (int32_t i = state->argn; i > 0; i -= 2) { - Janet value = p->args[--p->argcount]; - Janet key = p->args[--p->argcount]; + for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) { + Janet key = p->args[i]; + Janet value = p->args[i + 1]; janet_struct_put(st, key, value); } + p->argcount -= state->argn; return janet_wrap_struct(janet_struct_end(st)); } static Janet close_table(JanetParser *p, JanetParseState *state) { JanetTable *table = janet_table(state->argn >> 1); - for (int32_t i = state->argn; i > 0; i -= 2) { - Janet value = p->args[--p->argcount]; - Janet key = p->args[--p->argcount]; + for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) { + Janet key = p->args[i]; + Janet value = p->args[i + 1]; janet_table_put(table, key, value); } + p->argcount -= state->argn; return janet_wrap_table(table); } diff --git a/src/core/struct.c b/src/core/struct.c index f23c0bd1..18356925 100644 --- a/src/core/struct.c +++ b/src/core/struct.c @@ -123,7 +123,8 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) { dist = otherdist; hash = otherhash; } else if (status == 0) { - /* A key was added to the struct more than once */ + /* A key was added to the struct more than once - replace old value */ + kv->value = value; return; } } diff --git a/test/suite0.janet b/test/suite0.janet index 2af92f63..606e2fb5 100644 --- a/test/suite0.janet +++ b/test/suite0.janet @@ -328,5 +328,11 @@ (assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values") (assert (= false ;(map truthy? [nil false])) "non-truthy values") +# Struct and Table duplicate elements +(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys") +(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys") +(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys") +(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys") + (end-suite) From 6c4ed0409dfbd45acf7f656d7cbeacf596ace62f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Apr 2020 14:13:55 -0500 Subject: [PATCH 092/107] Add emscripten check to features.h. --- src/core/features.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/features.h b/src/core/features.h index 7ae18edf..4604d195 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -30,7 +30,7 @@ #endif /* Needed for realpath on linux */ -#if !defined(_XOPEN_SOURCE) && defined(__linux__) +#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__)) #define _XOPEN_SOURCE 500 #endif From 4faa129b8eeeb4779b1879ea324b9daaf2d3c2f9 Mon Sep 17 00:00:00 2001 From: davkor Date: Mon, 13 Apr 2020 17:33:58 +0100 Subject: [PATCH 093/107] Added a first fuzzer. --- test/fuzzers/fuzz_dostring.c | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 test/fuzzers/fuzz_dostring.c diff --git a/test/fuzzers/fuzz_dostring.c b/test/fuzzers/fuzz_dostring.c new file mode 100644 index 00000000..cc1dbe27 --- /dev/null +++ b/test/fuzzers/fuzz_dostring.c @@ -0,0 +1,22 @@ +#include +#include +#include + +int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size){ + char *new_str = (char *)malloc(size+1); + if (new_str == NULL){ + return 0; + } + memcpy(new_str, data, size); + new_str[size] = '\0'; + + /* janet logic */ + janet_init(); + JanetTable *env = janet_core_env(NULL); + janet_dostring(env, new_str, "main", NULL); + janet_deinit(); + + free(new_str); + return 0; +} + From 93fc11ea2179ac2cba7de96583b910879a64a5f4 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 Apr 2020 20:24:11 -0500 Subject: [PATCH 094/107] Add edefer. Also improve error messages from vm internal errors. (Show bad value, not its type). --- CHANGELOG.md | 1 + src/boot/boot.janet | 16 ++++++++++++++-- src/core/vm.c | 6 +++--- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c21568c7..22bef911 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `edefer` macro to core. - A struct/table literal/constructor with duplicate keys will use the last value given. Previously, this was inconsistent between tables and structs, literals and constructor functions. - Add debugger to core. The debugger functions are only available diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8f48151c..89357727 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -301,7 +301,19 @@ ,form (if (= (,fiber/status ,f) :dead) ,r - (propagate ,r ,f))))) + (,propagate ,r ,f))))) + +(defmacro edefer + "Run form after body in the case that body terminates abnormally (an error or user signal 0-4). + Otherwise, return last form in body." + [form & body] + (with-syms [f r] + ~(do + (def ,f (,fiber/new (fn [] ,;body) :ti)) + (def ,r (,resume ,f)) + (if (= (,fiber/status ,f) :dead) + ,r + (do ,form (,propagate ,r ,f)))))) (defmacro prompt "Set up a checkpoint that can be returned to. Tag should be a value @@ -314,7 +326,7 @@ (def [,target ,payload] ,res) (if (,= ,tag ,target) ,payload - (propagate ,res ,fib))))) + (,propagate ,res ,fib))))) (defmacro chr "Convert a string of length 1 to its byte (ascii) value at compile time." diff --git a/src/core/vm.c b/src/core/vm.c index 868a7b96..4355d650 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -107,13 +107,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL; #define vm_assert_type(X, T) do { \ if (!(janet_checktype((X), (T)))) { \ vm_commit(); \ - janet_panicf("expected %T, got %t", (1 << (T)), (X)); \ + janet_panicf("expected %T, got %v", (1 << (T)), (X)); \ } \ } while (0) #define vm_assert_types(X, TS) do { \ if (!(janet_checktypes((X), (TS)))) { \ vm_commit(); \ - janet_panicf("expected %T, got %t", (TS), (X)); \ + janet_panicf("expected %T, got %v", (TS), (X)); \ } \ } while (0) @@ -910,7 +910,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { if (janet_indexed_view(stack[D], &vals, &len)) { janet_fiber_pushn(fiber, vals, len); } else { - janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]); + janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]); } } stack = fiber->data + fiber->frame; From a09112404d40c1b3d5261a314b36e2f71b931f25 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 Apr 2020 23:18:27 -0500 Subject: [PATCH 095/107] Add better error message on unexpected eos. Show innermost open delimiter --- src/core/parse.c | 59 +++++++++++++++++++++++++++++++++------------ src/core/pp.c | 8 ++++++ src/include/janet.h | 1 + 3 files changed, 53 insertions(+), 15 deletions(-) diff --git a/src/core/parse.c b/src/core/parse.c index 6e479478..4e8bba04 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -26,6 +26,9 @@ #include "util.h" #endif +#define JANET_PARSER_DEAD 0x1 +#define JANET_PARSER_GENERATED_ERROR 0x2 + /* Check if a character is whitespace */ static int is_whitespace(uint8_t c) { return c == ' ' @@ -637,11 +640,30 @@ void janet_parser_eof(JanetParser *parser) { size_t oldline = parser->line; janet_parser_consume(parser, '\n'); if (parser->statecount > 1) { - parser->error = "unexpected end of source"; + JanetParseState *s = parser->states + (parser->statecount - 1); + JanetBuffer *buffer = janet_buffer(40); + janet_buffer_push_cstring(buffer, "unexpected end of source: "); + if (s->flags & PFLAG_PARENS) { + janet_buffer_push_u8(buffer, '('); + } else if (s->flags & PFLAG_SQRBRACKETS) { + janet_buffer_push_u8(buffer, '['); + } else if (s->flags & PFLAG_CURLYBRACKETS) { + janet_buffer_push_u8(buffer, '{'); + } else if (s->flags & PFLAG_STRING) { + janet_buffer_push_u8(buffer, '"'); + } else if (s->flags & PFLAG_LONGSTRING) { + int32_t i; + for (i = 0; i < s->argn; i++) { + janet_buffer_push_u8(buffer, '`'); + } + } + janet_formatbb(buffer, " opened at line %d, column %d", s->line, s->column); + parser->error = (const char *) janet_string(buffer->data, buffer->count); + parser->flag |= JANET_PARSER_GENERATED_ERROR; } parser->line = oldline; parser->column = oldcolumn; - parser->flag = 1; + parser->flag |= JANET_PARSER_DEAD; } enum JanetParserStatus janet_parser_status(JanetParser *parser) { @@ -663,6 +685,7 @@ const char *janet_parser_error(JanetParser *parser) { if (status == JANET_PARSE_ERROR) { const char *e = parser->error; parser->error = NULL; + parser->flag &= ~JANET_PARSER_GENERATED_ERROR; janet_parser_flush(parser); return e; } @@ -766,6 +789,9 @@ static int parsermark(void *p, size_t size) { for (i = 0; i < parser->argcount; i++) { janet_mark(parser->args[i]); } + if (parser->flag & JANET_PARSER_GENERATED_ERROR) { + janet_mark(janet_wrap_string(parser->error)); + } return 0; } @@ -900,7 +926,11 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); const char *err = janet_parser_error(p); - if (err) return janet_cstringv(err); + if (err) { + return (p->flag & JANET_PARSER_GENERATED_ERROR) + ? janet_wrap_string(err) + : janet_cstringv(err); + } return janet_wrap_nil(); } @@ -999,31 +1029,30 @@ struct ParserStateGetter { }; static Janet parser_state_delimiters(const JanetParser *_p) { - JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser)); - janet_parser_clone(_p, clone); + JanetParser *p = (JanetParser *)_p; size_t i; const uint8_t *str; size_t oldcount; - oldcount = clone->bufcount; - for (i = 0; i < clone->statecount; i++) { - JanetParseState *s = clone->states + i; + oldcount = p->bufcount; + for (i = 0; i < p->statecount; i++) { + JanetParseState *s = p->states + i; if (s->flags & PFLAG_PARENS) { - push_buf(clone, '('); + push_buf(p, '('); } else if (s->flags & PFLAG_SQRBRACKETS) { - push_buf(clone, '['); + push_buf(p, '['); } else if (s->flags & PFLAG_CURLYBRACKETS) { - push_buf(clone, '{'); + push_buf(p, '{'); } else if (s->flags & PFLAG_STRING) { - push_buf(clone, '"'); + push_buf(p, '"'); } else if (s->flags & PFLAG_LONGSTRING) { int32_t i; for (i = 0; i < s->argn; i++) { - push_buf(clone, '`'); + push_buf(p, '`'); } } } - str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount)); - clone->bufcount = oldcount; + str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount)); + p->bufcount = oldcount; return janet_wrap_string(str); } diff --git a/src/core/pp.c b/src/core/pp.c index b0c914fb..828e4c11 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -863,6 +863,14 @@ const uint8_t *janet_formatc(const char *format, ...) { return ret; } +JanetBuffer *janet_formatbb(JanetBuffer *buffer, const char *format, ...) { + va_list args; + va_start(args, format); + janet_formatb(buffer, format, args); + va_end(args); + return buffer; +} + /* Shared implementation between string/format and * buffer/format */ void janet_buffer_format( diff --git a/src/include/janet.h b/src/include/janet.h index 00975136..66cd1813 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1239,6 +1239,7 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x); #define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len))) JANET_API JanetString janet_formatc(const char *format, ...); JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args); +JANET_API JanetBuffer *janet_formatbb(JanetBuffer *bufp, const char *format, ...); /* Symbol functions */ JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len); From a3d29a15df17219ab8bc6e8daaceacc9b92a4b79 Mon Sep 17 00:00:00 2001 From: sogaiu <983021772@users.noreply.github.com> Date: Tue, 14 Apr 2020 10:22:45 +0100 Subject: [PATCH 096/107] Check some *alloc return values --- src/core/asm.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/asm.c b/src/core/asm.c index 9d31d020..d2099d83 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -707,6 +707,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int if (janet_indexed_view(x, &arr, &count)) { janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode"); def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count); + if (NULL == def->sourcemap) { + JANET_OUT_OF_MEMORY; + } for (i = 0; i < count; i++) { const Janet *tup; Janet entry = arr[i]; @@ -730,6 +733,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int /* Set environments */ def->environments = realloc(def->environments, def->environments_length * sizeof(int32_t)); + if (NULL == def->environments) { + JANET_OUT_OF_MEMORY; + } /* Verify the func def */ if (janet_verify(def)) { From 71882475d6eb3ee86429298e9944f7661fca90ca Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 Apr 2020 07:33:33 -0500 Subject: [PATCH 097/107] janet_formatb -> janet_formatbv, new janet_formatb The old function was not very useable. In the likely case that there is no external code using this (not well documented/janet_formatc is more convenient), we can change this. --- CHANGELOG.md | 2 ++ src/core/capi.c | 2 +- src/core/io.c | 4 ++-- src/core/parse.c | 4 ++-- src/core/pp.c | 8 ++++---- src/include/janet.h | 4 ++-- 6 files changed, 13 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 22bef911..597a4451 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Change C api's `janet_formatb` -> `janet_formatbv`. +- Add C `janet_formatb` to C api. - Add `edefer` macro to core. - A struct/table literal/constructor with duplicate keys will use the last value given. Previously, this was inconsistent between tables and structs, literals and constructor functions. diff --git a/src/core/capi.c b/src/core/capi.c index 28c59ea7..ce7ef70b 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -54,7 +54,7 @@ void janet_panicf(const char *format, ...) { while (format[len]) len++; janet_buffer_init(&buffer, len); va_start(args, format); - janet_formatb(&buffer, format, args); + janet_formatbv(&buffer, format, args); va_end(args); ret = janet_string(buffer.data, buffer.count); janet_buffer_deinit(&buffer); diff --git a/src/core/io.c b/src/core/io.c index fe6c2625..7312c266 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -502,7 +502,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) int32_t len = 0; while (format[len]) len++; janet_buffer_init(&buffer, len); - janet_formatb(&buffer, format, args); + janet_formatbv(&buffer, format, args); if (xtype == JANET_ABSTRACT) { void *abstract = janet_unwrap_abstract(x); if (janet_abstract_type(abstract) != &janet_file_type) @@ -515,7 +515,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) break; } case JANET_BUFFER: - janet_formatb(janet_unwrap_buffer(x), format, args); + janet_formatbv(janet_unwrap_buffer(x), format, args); break; } va_end(args); diff --git a/src/core/parse.c b/src/core/parse.c index 4e8bba04..4feaebe4 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -642,7 +642,7 @@ void janet_parser_eof(JanetParser *parser) { if (parser->statecount > 1) { JanetParseState *s = parser->states + (parser->statecount - 1); JanetBuffer *buffer = janet_buffer(40); - janet_buffer_push_cstring(buffer, "unexpected end of source: "); + janet_buffer_push_cstring(buffer, "unexpected end of source, "); if (s->flags & PFLAG_PARENS) { janet_buffer_push_u8(buffer, '('); } else if (s->flags & PFLAG_SQRBRACKETS) { @@ -657,7 +657,7 @@ void janet_parser_eof(JanetParser *parser) { janet_buffer_push_u8(buffer, '`'); } } - janet_formatbb(buffer, " opened at line %d, column %d", s->line, s->column); + janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column); parser->error = (const char *) janet_string(buffer->data, buffer->count); parser->flag |= JANET_PARSER_GENERATED_ERROR; } diff --git a/src/core/pp.c b/src/core/pp.c index 828e4c11..95fca574 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -728,7 +728,7 @@ static const char *scanformat( return p; } -void janet_formatb(JanetBuffer *b, const char *format, va_list args) { +void janet_formatbv(JanetBuffer *b, const char *format, va_list args) { const char *format_end = format + strlen(format); const char *c = format; int32_t startlen = b->count; @@ -853,7 +853,7 @@ const uint8_t *janet_formatc(const char *format, ...) { va_start(args, format); /* Run format */ - janet_formatb(&buffer, format, args); + janet_formatbv(&buffer, format, args); /* Iterate length */ va_end(args); @@ -863,10 +863,10 @@ const uint8_t *janet_formatc(const char *format, ...) { return ret; } -JanetBuffer *janet_formatbb(JanetBuffer *buffer, const char *format, ...) { +JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) { va_list args; va_start(args, format); - janet_formatb(buffer, format, args); + janet_formatbv(buffer, format, args); va_end(args); return buffer; } diff --git a/src/include/janet.h b/src/include/janet.h index 66cd1813..848fe7b9 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1238,8 +1238,8 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x); #define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr)) #define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len))) JANET_API JanetString janet_formatc(const char *format, ...); -JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args); -JANET_API JanetBuffer *janet_formatbb(JanetBuffer *bufp, const char *format, ...); +JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...); +JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args); /* Symbol functions */ JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len); From 058f63b44094b78ebe0fdff2ea56593efc8a4fcc Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 Apr 2020 20:43:53 -0500 Subject: [PATCH 098/107] Add sh-rule and sh-phony to jpm dialect. Provides useful shorthand for writing rules that invoke shell commands. --- auxbin/jpm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/auxbin/jpm b/auxbin/jpm index 80578d5c..19f7d9e9 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -34,7 +34,7 @@ (defmacro rule "Add a rule to the rule graph." [target deps & body] - ~(,rule-impl ,target ,deps (fn [] nil ,;body))) + ~(,rule-impl ,target ,deps (fn [] ,;body))) (defmacro phony "Add a phony rule to the rule graph. A phony rule will run every time @@ -43,6 +43,16 @@ [target deps & body] ~(,rule-impl ,target ,deps (fn [] nil ,;body) true)) +(defmacro sh-rule + "Add a rule that invokes a shell command, and fails if the command returns non-zero." + [target deps & body] + ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))))) + +(defmacro sh-phony + "Add a phony rule that invokes a shell command, and fails if the command returns non-zero." + [target deps & body] + ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true)) + (defn add-dep "Add a dependency to an existing rule. Useful for extending phony rules or extending the dependency graph of existing rules." From 605a205008168b3fff4cc5678184e68514ee206b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 Apr 2020 21:27:48 -0500 Subject: [PATCH 099/107] Range errors for `slice`-likes include negatives. Makes for less confusing errors when calling something like `(slice [] 0 -10)`. --- CHANGELOG.md | 1 + src/core/capi.c | 18 ++++++++++-------- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 597a4451..5baeaa38 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet. - Change C api's `janet_formatb` -> `janet_formatbv`. - Add C `janet_formatb` to C api. - Add `edefer` macro to core. diff --git a/src/core/capi.c b/src/core/capi.c index ce7ef70b..797642c5 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -235,18 +235,20 @@ size_t janet_getsize(const Janet *argv, int32_t n) { int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) { int32_t raw = janet_getinteger(argv, n); - if (raw < 0) raw += length + 1; - if (raw < 0 || raw > length) - janet_panicf("%s index %d out of range [0,%d]", which, raw, length); - return raw; + int32_t not_raw = raw; + if (not_raw < 0) not_raw += length + 1; + if (not_raw < 0 || not_raw > length) + janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length); + return not_raw; } int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) { int32_t raw = janet_getinteger(argv, n); - if (raw < 0) raw += length; - if (raw < 0 || raw > length) - janet_panicf("%s index %d out of range [0,%d)", which, raw, length); - return raw; + int32_t not_raw = raw; + if (not_raw < 0) not_raw += length; + if (not_raw < 0 || not_raw > length) + janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length); + return not_raw; } JanetView janet_getindexed(const Janet *argv, int32_t n) { From ef3b953a4209e263018de10be403a5b38a94efd6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 14 Apr 2020 21:32:50 -0500 Subject: [PATCH 100/107] Fix docstrings. --- src/core/corelib.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/corelib.c b/src/core/corelib.c index 5498fe6a..4f6a4d4c 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -646,7 +646,7 @@ static const JanetReg corelib_cfuns[] = { "getline", janet_core_getline, JDOC("(getline &opt prompt buf env)\n\n" "Reads a line of input into a buffer, including the newline character, using a prompt. " - "An optional environment table can be provided for autocomplete. " + "An optional environment table can be provided for auto-complete. " "Returns the modified buffer. " "Use this function to implement a simple interface for a terminal program.") }, @@ -680,7 +680,7 @@ static const JanetReg corelib_cfuns[] = { "\t:all:\tthe value of path verbatim\n" "\t:cur:\tthe current file, or (dyn :current-file)\n" "\t:dir:\tthe directory containing the current file\n" - "\t:name:\tthe filename component of path, with extenion if given\n" + "\t:name:\tthe filename component of path, with extension if given\n" "\t:native:\tthe extension used to load natives, .so or .dll\n" "\t:sys:\tthe system path, or (syn :syspath)") }, @@ -697,7 +697,7 @@ static const JanetReg corelib_cfuns[] = { { "slice", janet_core_slice, JDOC("(slice x &opt start end)\n\n" - "Extract a sub-range of an indexed data strutrue or byte sequence.") + "Extract a sub-range of an indexed data structure or byte sequence.") }, { "signal", janet_core_signal, From f5433dcaa4c5db0bc1304ab98832728d8a3a0b26 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 15 Apr 2020 19:45:17 -0500 Subject: [PATCH 101/107] Fix core getline that doesn't use replacement. --- src/core/corelib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/corelib.c b/src/core/corelib.c index 4f6a4d4c..c4be2704 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -435,7 +435,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) { static Janet janet_core_getline(int32_t argc, Janet *argv) { FILE *in = janet_dynfile("in", stdin); FILE *out = janet_dynfile("out", stdout); - janet_arity(argc, 0, 2); + janet_arity(argc, 0, 3); JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10); if (argc >= 1) { const char *prompt = (const char *) janet_getstring(argv, 0); From 3eb84fcb138f043dc5a2dc861fd37337692532df Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 16 Apr 2020 12:11:17 -0500 Subject: [PATCH 102/107] Fix some typos, make jpm repl work without a project.janet. --- CHANGELOG.md | 1 + auxbin/jpm | 37 ++++++++++++++++++++++++------------- src/boot/boot.janet | 28 +++++++++++++++------------- 3 files changed, 40 insertions(+), 26 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5baeaa38..b789352d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Fix bug in `getline`. - Add `sh-rule` and `sh-phony` to jpm's dialect of Janet. - Change C api's `janet_formatb` -> `janet_formatbv`. - Add C `janet_formatb` to C api. diff --git a/auxbin/jpm b/auxbin/jpm index 19f7d9e9..1963a89e 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -187,20 +187,25 @@ [into x] (when x (proto-flatten into (table/getproto x)) - (loop [k :keys x] - (put into k (x k)))) + (merge-into into x)) into) +(defn make-jpm-env + "Build an environment table with jpm functions preloaded." + [&opt no-deps] + (def env (make-env)) + (put env :jpm-no-deps no-deps) + (loop [k :keys _env :when (symbol? k)] + (unless ((_env k) :private) (put env k (_env k)))) + env) + (defn require-jpm "Require a jpm file project file. This is different from a normal require in that code is loaded in the jpm environment." [path &opt no-deps] - (def env (make-env)) - (put env :jpm-no-deps no-deps) (unless (os/stat path :mode) (error (string "cannot open " path))) - (loop [k :keys _env :when (symbol? k)] - (unless ((_env k) :private) (put env k (_env k)))) + (def env (make-jpm-env no-deps)) (def currenv (proto-flatten @{} (fiber/getenv (fiber/current)))) (loop [k :keys currenv :when (keyword? k)] (put env k (currenv k))) @@ -1053,17 +1058,23 @@ Flags are: (defn jpm-repl [] - (def env (require-jpm "./project.janet")) - (def p (env :project)) - (def name (p :name)) + (def env + (try + (require-jpm "./project.janet") + ([err f] + (if (= "cannot open ./project.janet" err) + (put (make-jpm-env) :project {}) + (propagate err f))))) (setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q")) (setdyn :err-color (if-not (dyn :nocolor) true)) - (print "Project: " name) - (print "Repository: " (p :repo)) - (print "Author: " (p :author)) + (def p (env :project)) + (def name (p :name)) + (if name (print "Project: " name)) + (if-let [r (p :repo)] (print "Repository: " r)) + (if-let [a (p :author)] (print "Author: " a)) (defn getchunk [buf p] (def [line] (parser/where p)) - (getline (string "jpm[" name "]:" line ":" (parser/state p :delimiters) "> ") buf env)) + (getline (string "jpm[" (or name "repl") "]:" line ":" (parser/state p :delimiters) "> ") buf env)) (repl getchunk nil env)) (def- subcommands diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 89357727..84d55c5a 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -501,7 +501,7 @@ that define something to loop over. They are formatted like:\n\n \tbinding :verb object/expression\n\n Where binding is a binding as passed to def, :verb is one of a set of keywords, - and object is any janet expression. The available verbs are:\n\n + and object is any expression. The available verbs are:\n\n \t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n \t:range - loop over a range. The object should be two element tuple with a start and end value, and an optional positive step. The range is half open, [start, end).\n @@ -1482,10 +1482,10 @@ ### (defn- env-walk - [pred &opt env] + [pred &opt env local] (default env (fiber/getenv (fiber/current))) (def envs @[]) - (do (var e env) (while e (array/push envs e) (set e (table/getproto e)))) + (do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break)))) (def ret-set @{}) (loop [envi :in envs k :keys envi @@ -1494,16 +1494,18 @@ (sort (keys ret-set))) (defn all-bindings - "Get all symbols available in an enviroment. Defaults to the current - fiber's environment." - [&opt env] - (env-walk symbol? env)) + "Get all symbols available in an environment. Defaults to the current + fiber's environment. If local is truthy, will not show inherited bindings + (from prototype tables)." + [&opt env local] + (env-walk symbol? env local)) (defn all-dynamics "Get all dynamic bindings in an environment. Defaults to the current - fiber's environment." - [&opt env] - (env-walk keyword? env)) + fiber's environment. If local is truthy, will not show inherited bindings + (from prototype tables)." + [&opt env local] + (env-walk keyword? env local)) (defn doc-format "Reformat text to wrap at a given line." @@ -1701,7 +1703,7 @@ ret) (defn all - "Returns true if all xs are truthy, otherwise the resulty of first + "Returns true if all xs are truthy, otherwise the result of first falsey predicate value, (pred x)." [pred xs] (var ret true) @@ -1915,7 +1917,7 @@ (eflush)) (defn run-context - "Run a context. This evaluates expressions of janet in an environment, + "Run a context. This evaluates expressions in an environment, and is encapsulates the parsing, compilation, and evaluation. Returns (in environment :exit-value environment) when complete. opts is a table or struct of options. The options are as follows:\n\n\t @@ -2672,7 +2674,7 @@ ### ### -(def root-env "The root environment used to create envionments with (make-env)" _env) +(def root-env "The root environment used to create environments with (make-env)" _env) (do (put _env 'boot/opts nil) From 67fb2c212ff352c9df926ce820f374cd9d1e933f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 16 Apr 2020 18:44:21 -0500 Subject: [PATCH 103/107] Address #348 Remove extreneous data from lockfile. --- auxbin/jpm | 2 +- src/core/pp.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/auxbin/jpm b/auxbin/jpm index 1963a89e..19e29f32 100755 --- a/auxbin/jpm +++ b/auxbin/jpm @@ -730,7 +730,7 @@ int main(int argc, const char **argv) { (def dep-urls (map |(if (string? $) $ ($ :repo)) d)) (unless (resolved r) (when (all resolved dep-urls) - (array/push ordered-packages p) + (array/push ordered-packages {:repo r :sha s}) (set made-progress true) (put resolved r true)))) (unless made-progress diff --git a/src/core/pp.c b/src/core/pp.c index 95fca574..febc9ec4 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -459,8 +459,8 @@ static const char *janet_pretty_colors[] = { #define JANET_PRETTY_DICT_ONELINE 4 #define JANET_PRETTY_IND_ONELINE 10 -#define JANET_PRETTY_DICT_LIMIT 16 -#define JANET_PRETTY_ARRAY_LIMIT 16 +#define JANET_PRETTY_DICT_LIMIT 30 +#define JANET_PRETTY_ARRAY_LIMIT 160 /* Helper for pretty printing */ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { From a147ea3e80c2055039f7ee30943234d76cb3d1cf Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 16 Apr 2020 19:01:36 -0500 Subject: [PATCH 104/107] Use JANET_PRETTY_DICT_LIMIT. --- src/core/pp.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/pp.c b/src/core/pp.c index febc9ec4..35ed9b12 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -591,6 +591,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0); for (i = 0; i < cap; i++) { if (!janet_checktype(kvs[i].key, JANET_NIL)) { + if (counter == JANET_PRETTY_DICT_LIMIT) { + print_newline(S, 0); + janet_buffer_push_cstring(S->buffer, "..."); + break; + } if (first_kv_pair) { first_kv_pair = 0; } else { @@ -600,11 +605,6 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { janet_buffer_push_u8(S->buffer, ' '); janet_pretty_one(S, kvs[i].value, 1); counter++; - if (counter == 10) { - print_newline(S, 0); - janet_buffer_push_cstring(S->buffer, "..."); - break; - } } } } From 8a89e50c1387819d19003ad8bba9107157c60b0f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 16 Apr 2020 19:03:35 -0500 Subject: [PATCH 105/107] :octal-permissions -> :int-permissions (#347) --- src/core/os.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index fa006382..70cd6288 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1063,7 +1063,7 @@ static const struct OsStatGetter os_stat_getters[] = { {"dev", os_stat_dev}, {"inode", os_stat_inode}, {"mode", os_stat_mode}, - {"octal-permissions", os_stat_int_permissions}, + {"int-permissions", os_stat_int_permissions}, {"permissions", os_stat_permissions}, {"uid", os_stat_uid}, {"gid", os_stat_gid}, @@ -1289,7 +1289,7 @@ static const JanetReg os_cfuns[] = { " only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n" "\t:dev - the device that the file is on\n" "\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n" - "\t:octal-permissions - A Unix permission integer like 8r744\n" + "\t:int-permissions - A Unix permission integer like 8r744\n" "\t:permissions - A Unix permission string like \"rwxr--r--\"\n" "\t:uid - File uid\n" "\t:gid - File gid\n" From fbe903b27712306b81a085020a98e9b3d5d20057 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Apr 2020 13:37:52 -0500 Subject: [PATCH 106/107] Add janet_cfuns_prefix to janet.h Makes adding functions to the current environment easier. --- src/core/util.c | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/core/util.c b/src/core/util.c index f2df7421..1f04aa22 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -380,7 +380,7 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) { } /* Load many cfunctions at once */ -void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { +static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) { uint8_t *longname_buffer = NULL; size_t prefixlen = 0; size_t bufsize = 0; @@ -414,13 +414,29 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) name = janet_csymbolv(cfuns->name); } Janet fun = janet_wrap_cfunction(cfuns->cfun); - janet_def(env, cfuns->name, fun, cfuns->documentation); + if (defprefix) { + JanetTable *subt = janet_table(2); + janet_table_put(subt, janet_ckeywordv("value"), fun); + if (cfuns->documentation) + janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation)); + janet_table_put(env, name, janet_wrap_table(subt)); + } else { + janet_def(env, cfuns->name, fun, cfuns->documentation); + } janet_table_put(janet_vm_registry, fun, name); cfuns++; } free(longname_buffer); } +void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { + _janet_cfuns_prefix(env, regprefix, cfuns, 1); +} + +void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { + _janet_cfuns_prefix(env, regprefix, cfuns, 0); +} + /* Abstract type introspection */ void janet_register_abstract_type(const JanetAbstractType *at) { From e202d3083594f678931c834e8e7dc1f1f80c480f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Apr 2020 13:39:23 -0500 Subject: [PATCH 107/107] Use make format. --- test/fuzzers/fuzz_dostring.c | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/test/fuzzers/fuzz_dostring.c b/test/fuzzers/fuzz_dostring.c index cc1dbe27..625ab0a4 100644 --- a/test/fuzzers/fuzz_dostring.c +++ b/test/fuzzers/fuzz_dostring.c @@ -2,21 +2,21 @@ #include #include -int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size){ - char *new_str = (char *)malloc(size+1); - if (new_str == NULL){ - return 0; - } - memcpy(new_str, data, size); - new_str[size] = '\0'; +int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) { + char *new_str = (char *)malloc(size + 1); + if (new_str == NULL) { + return 0; + } + memcpy(new_str, data, size); + new_str[size] = '\0'; - /* janet logic */ - janet_init(); - JanetTable *env = janet_core_env(NULL); - janet_dostring(env, new_str, "main", NULL); - janet_deinit(); + /* janet logic */ + janet_init(); + JanetTable *env = janet_core_env(NULL); + janet_dostring(env, new_str, "main", NULL); + janet_deinit(); - free(new_str); - return 0; + free(new_str); + return 0; }