25 |
26 | #include "tests.h"
27 |
28 | int table_test() {
29 |
30 | JanetTable *t1, *t2;
31 |
32 | t1 = janet_table(10);
33 | t2 = janet_table(0);
34 |
35 | janet_table_put(t1, janet_cstringv("hello"), janet_wrap_integer(2));
36 | janet_table_put(t1, janet_cstringv("akey"), janet_wrap_integer(5));
37 | janet_table_put(t1, janet_cstringv("box"), janet_wrap_boolean(0));
38 | janet_table_put(t1, janet_cstringv("square"), janet_cstringv("avalue"));
39 |
40 | assert(t1->count == 4);
41 | assert(t1->capacity >= t1->count);
42 |
43 | assert(janet_equals(janet_table_get(t1, janet_cstringv("hello")), janet_wrap_integer(2)));
44 | assert(janet_equals(janet_table_get(t1, janet_cstringv("akey")), janet_wrap_integer(5)));
45 | assert(janet_equals(janet_table_get(t1, janet_cstringv("box")), janet_wrap_boolean(0)));
46 | assert(janet_equals(janet_table_get(t1, janet_cstringv("square")), janet_cstringv("avalue")));
47 |
48 | janet_table_remove(t1, janet_cstringv("hello"));
49 | janet_table_put(t1, janet_cstringv("box"), janet_wrap_nil());
50 |
51 | assert(t1->count == 2);
52 |
53 | assert(janet_equals(janet_table_get(t1, janet_cstringv("hello")), janet_wrap_nil()));
54 | assert(janet_equals(janet_table_get(t1, janet_cstringv("box")), janet_wrap_nil()));
55 |
56 | janet_table_put(t2, janet_csymbolv("t2key1"), janet_wrap_integer(10));
57 | janet_table_put(t2, janet_csymbolv("t2key2"), janet_wrap_integer(100));
58 | janet_table_put(t2, janet_csymbolv("some key "), janet_wrap_integer(-2));
59 | janet_table_put(t2, janet_csymbolv("a thing"), janet_wrap_integer(10));
60 |
61 | assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
62 | assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
63 |
64 | assert(t2->count == 4);
65 | assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
66 | assert(t2->count == 3);
67 | assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
68 | assert(t2->count == 2);
69 |
70 | return 0;
71 | }
72 |
--------------------------------------------------------------------------------
/tools/gendoc.janet:
--------------------------------------------------------------------------------
1 | # Generate documentation
2 |
3 | (def- prelude
4 | ```
5 |
6 |
7 |
8 |
9 | Janet Language Documentation
10 |
11 |
23 |
24 | ```)
25 |
26 | (def- postlude
27 | ```
28 |
29 | ```)
30 |
31 | (def- escapes
32 | {10 "
"
33 | 09 " "
34 | 38 "&"
35 | 60 "<"
36 | 62 ">"
37 | 34 """
38 | 39 "'"
39 | 47 "/"})
40 |
41 | (defn- trim-lead
42 | "Trim leading newlines"
43 | [str]
44 | (var i 0)
45 | (while (= 10 (get str i)) (++ i))
46 | (string/slice str i))
47 |
48 | (defn- html-escape
49 | "Escape special characters for HTML encoding."
50 | [str]
51 | (def buf @"")
52 | (loop [byte :in str]
53 | (if-let [rep (get escapes byte)]
54 | (buffer/push-string buf rep)
55 | (buffer/push-byte buf byte)))
56 | buf)
57 |
58 | (def- months '("January" "February" "March" "April" "May" "June" "July" "August" "September"
59 | "October" "November" "December"))
60 | (defn nice-date
61 | "Get the current date nicely formatted"
62 | []
63 | (let [date (os/date)
64 | M (months (date :month))
65 | D (+ (date :month-day) 1)
66 | Y (date :year)
67 | HH (date :hours)
68 | MM (date :minutes)
69 | SS (date :seconds)]
70 | (string/format "%s %d, %d at %.2d:%.2d:%.2d"
71 | M D Y HH MM SS)))
72 |
73 | (defn- make-title
74 | "Generate title"
75 | []
76 | (string "Janet Core API
"
77 | "Version " janet/version "-" janet/build "
"
78 | "Generated "
79 | (nice-date)
80 | "
"
81 | "
"))
82 |
83 | (defn- emit-item
84 | "Generate documentation for one entry."
85 | [key env-entry]
86 | (let [{:macro macro
87 | :value val
88 | :ref ref
89 | :source-map sm
90 | :doc docstring} env-entry
91 | html-key (html-escape key)
92 | binding-type (cond
93 | macro :macro
94 | ref (string :var " (" (type (get ref 0)) ")")
95 | (type val))
96 | source-ref (if-let [[path start end] sm]
97 | (string "" path " (" start ":" end ")")
98 | "")]
99 | (string "\n"
100 | "" binding-type "\n"
101 | "" (trim-lead (html-escape docstring)) "
\n"
102 | source-ref)))
103 |
104 | # Generate parts and print them to stdout
105 | (def parts (seq [[k entry]
106 | :in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
107 | :when (symbol? k)
108 | :when (and (get entry :doc) (not (get entry :private)))]
109 | (emit-item k entry)))
110 | (print
111 | prelude
112 | (make-title)
113 | ;(interpose "
\n" parts)
114 | postlude)
115 |
--------------------------------------------------------------------------------
/src/boot/system_test.c:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #include
24 | #include
25 | #include
26 | #include
27 |
28 | #include "tests.h"
29 |
30 | int system_test() {
31 |
32 | #ifdef JANET_32
33 | assert(sizeof(void *) == 4);
34 | #else
35 | assert(sizeof(void *) == 8);
36 | #endif
37 |
38 | /* Check the version defines are self consistent */
39 | char version_combined[256];
40 | sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
41 | assert(!strcmp(JANET_VERSION, version_combined));
42 |
43 | /* Reflexive testing and nanbox testing */
44 | assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
45 | assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
46 | assert(janet_equals(janet_wrap_true(), janet_wrap_true()));
47 | assert(janet_equals(janet_wrap_integer(1), janet_wrap_integer(1)));
48 | assert(janet_equals(janet_wrap_integer(INT32_MAX), janet_wrap_integer(INT32_MAX)));
49 | assert(janet_equals(janet_wrap_integer(-2), janet_wrap_integer(-2)));
50 | assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
51 | assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
52 | assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
53 | #ifdef NAN
54 | #ifdef JANET_PLAN9
55 | // Plan 9 traps NaNs by default; disable that.
56 | setfcr(0);
57 | #endif
58 | assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
59 | #else
60 | assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
61 | #endif
62 |
63 | assert(NULL != &janet_wrap_nil);
64 |
65 | assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
66 | assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
67 |
68 | Janet *t1 = janet_tuple_begin(3);
69 | t1[0] = janet_wrap_nil();
70 | t1[1] = janet_wrap_integer(4);
71 | t1[2] = janet_cstringv("hi");
72 | Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
73 |
74 | Janet *t2 = janet_tuple_begin(3);
75 | t2[0] = janet_wrap_nil();
76 | t2[1] = janet_wrap_integer(4);
77 | t2[2] = janet_cstringv("hi");
78 | Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
79 |
80 | assert(janet_equals(tuple1, tuple2));
81 |
82 | return 0;
83 | }
84 |
--------------------------------------------------------------------------------
/src/core/fiber.h:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #ifndef JANET_FIBER_H_defined
24 | #define JANET_FIBER_H_defined
25 |
26 | #ifndef JANET_AMALG
27 | #include
28 | #endif
29 |
30 | /* Fiber signal masks. */
31 | #define JANET_FIBER_MASK_ERROR 2
32 | #define JANET_FIBER_MASK_DEBUG 4
33 | #define JANET_FIBER_MASK_YIELD 8
34 |
35 | #define JANET_FIBER_MASK_USER0 (16 << 0)
36 | #define JANET_FIBER_MASK_USER1 (16 << 1)
37 | #define JANET_FIBER_MASK_USER2 (16 << 2)
38 | #define JANET_FIBER_MASK_USER3 (16 << 3)
39 | #define JANET_FIBER_MASK_USER4 (16 << 4)
40 | #define JANET_FIBER_MASK_USER5 (16 << 5)
41 | #define JANET_FIBER_MASK_USER6 (16 << 6)
42 | #define JANET_FIBER_MASK_USER7 (16 << 7)
43 | #define JANET_FIBER_MASK_USER8 (16 << 8)
44 | #define JANET_FIBER_MASK_USER9 (16 << 9)
45 |
46 | #define JANET_FIBER_MASK_USERN(N) (16 << (N))
47 | #define JANET_FIBER_MASK_USER 0x3FF0
48 |
49 | #define JANET_FIBER_STATUS_MASK 0x3F0000
50 | #define JANET_FIBER_RESUME_SIGNAL 0x400000
51 | #define JANET_FIBER_STATUS_OFFSET 16
52 |
53 | #define JANET_FIBER_BREAKPOINT 0x1000000
54 | #define JANET_FIBER_RESUME_NO_USEVAL 0x2000000
55 | #define JANET_FIBER_RESUME_NO_SKIP 0x4000000
56 | #define JANET_FIBER_DID_LONGJUMP 0x8000000
57 | #define JANET_FIBER_FLAG_MASK 0xF000000
58 |
59 | #define JANET_FIBER_EV_FLAG_CANCELED 0x10000
60 | #define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
61 | #define JANET_FIBER_FLAG_ROOT 0x40000
62 | #define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
63 |
64 | /* used only on windows, should otherwise be unset */
65 |
66 | #define janet_fiber_set_status(f, s) do {\
67 | (f)->flags &= ~JANET_FIBER_STATUS_MASK;\
68 | (f)->flags |= (s) << JANET_FIBER_STATUS_OFFSET;\
69 | } while (0)
70 |
71 | #define janet_stack_frame(s) ((JanetStackFrame *)((s) - JANET_FRAME_SIZE))
72 | #define janet_fiber_frame(f) janet_stack_frame((f)->data + (f)->frame)
73 | void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n);
74 | void janet_fiber_push(JanetFiber *fiber, Janet x);
75 | void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y);
76 | void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z);
77 | void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n);
78 | int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
79 | int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
80 | void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
81 | void janet_fiber_popframe(JanetFiber *fiber);
82 | void janet_env_maybe_detach(JanetFuncEnv *env);
83 | int janet_env_valid(JanetFuncEnv *env);
84 |
85 | #ifdef JANET_EV
86 | void janet_fiber_did_resume(JanetFiber *fiber);
87 | #endif
88 |
89 | #endif
90 |
--------------------------------------------------------------------------------
/test/suite-array.janet:
--------------------------------------------------------------------------------
1 | # Copyright (c) 2025 Calvin Rose
2 | #
3 | # Permission is hereby granted, free of charge, to any person obtaining a copy
4 | # of this software and associated documentation files (the "Software"), to
5 | # deal in the Software without restriction, including without limitation the
6 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
7 | # sell copies of the Software, and to permit persons to whom the Software is
8 | # furnished to do so, subject to the following conditions:
9 | #
10 | # The above copyright notice and this permission notice shall be included in
11 | # all copies or substantial portions of the Software.
12 | #
13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16 | # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17 | # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
18 | # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
19 | # IN THE SOFTWARE.
20 |
21 | (import ./helper :prefix "" :exit true)
22 | (start-suite)
23 |
24 | # Array tests
25 | # e05022f
26 | (defn array=
27 | "Check if two arrays are equal in an element by element comparison"
28 | [a b]
29 | (if (and (array? a) (array? b))
30 | (= (apply tuple a) (apply tuple b))))
31 | (assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
32 | (def arr (array))
33 | (array/push arr :hello)
34 | (array/push arr :world)
35 | (assert (array= arr @[:hello :world]) "array comparison")
36 | (assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
37 | (assert (array= @[:one :two :three :four :five]
38 | @[:one :two :three :four :five]) "array comparison 3")
39 | (assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
40 | (assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
41 |
42 | # Array remove
43 | # 687a3c9
44 | (assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
45 | (assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
46 | (assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
47 | (assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
48 |
49 | # array/peek
50 | (assert (nil? (array/peek @[])) "array/peek empty")
51 |
52 | # array/fill
53 | (assert (deep= (array/fill @[1 1] 2) @[2 2]) "array/fill 1")
54 |
55 | # array/concat
56 | (assert (deep= (array/concat @[1 2] @[3 4] 5 6) @[1 2 3 4 5 6]) "array/concat 1")
57 | (def a @[1 2])
58 | (assert (deep= (array/concat a a) @[1 2 1 2]) "array/concat self")
59 |
60 | # array/insert
61 | (assert (deep= (array/insert @[:a :a :a :a] 2 :b :b) @[:a :a :b :b :a :a]) "array/insert 1")
62 | (assert (deep= (array/insert @[:a :b] -1 :c :d) @[:a :b :c :d]) "array/insert 2")
63 |
64 | # array/remove
65 | (assert-error "removal index 3 out of range [0,2]" (array/remove @[1 2] 3))
66 | (assert-error "expected non-negative integer for argument n, got -1" (array/remove @[1 2] 1 -1))
67 |
68 | # array/pop
69 | (assert (= (array/pop @[1]) 1) "array/pop 1")
70 | (assert (= (array/pop @[]) nil) "array/pop empty")
71 |
72 | # Code coverage
73 | (def a @[1])
74 | (array/pop a)
75 | (array/trim a)
76 | (array/ensure @[1 1] 6 2)
77 |
78 | # array/join
79 | (assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1")
80 | (assert (deep= @[] (array/join @[])) "array/join 2")
81 | (assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3")
82 | (assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4")
83 | (assert-error "array/join error 1" (array/join))
84 | (assert-error "array/join error 2" (array/join []))
85 | (assert-error "array/join error 3" (array/join [] "abc123"))
86 | (assert-error "array/join error 4" (array/join @[] "abc123"))
87 | (assert-error "array/join error 5" (array/join @[] "abc123"))
88 |
89 | (end-suite)
90 |
91 |
--------------------------------------------------------------------------------
/src/boot/boot.c:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #include
24 | #include "tests.h"
25 |
26 | #ifdef JANET_WINDOWS
27 | #include
28 | #define chdir(x) _chdir(x)
29 | #else
30 | #include
31 | #endif
32 |
33 | extern const unsigned char *janet_gen_boot;
34 | extern int32_t janet_gen_boot_size;
35 |
36 | int main(int argc, const char **argv) {
37 |
38 | /* Init janet */
39 | janet_init();
40 |
41 | /* Run tests */
42 | array_test();
43 | buffer_test();
44 | number_test();
45 | system_test();
46 | table_test();
47 |
48 | /* C tests passed */
49 |
50 | /* Set up VM */
51 | int status;
52 | JanetTable *env;
53 |
54 | env = janet_core_env(NULL);
55 |
56 | /* Create args tuple */
57 | JanetArray *args = janet_array(argc);
58 | for (int i = 0; i < argc; i++)
59 | janet_array_push(args, janet_cstringv(argv[i]));
60 | janet_def(env, "boot/args", janet_wrap_array(args), "Command line arguments.");
61 |
62 | /* Add in options from janetconf.h so boot.janet can configure the image as needed. */
63 | JanetTable *opts = janet_table(0);
64 | #ifdef JANET_NO_DOCSTRINGS
65 | janet_table_put(opts, janet_ckeywordv("no-docstrings"), janet_wrap_true());
66 | #endif
67 | #ifdef JANET_NO_SOURCEMAPS
68 | janet_table_put(opts, janet_ckeywordv("no-sourcemaps"), janet_wrap_true());
69 | #endif
70 | janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
71 |
72 | /* Run bootstrap script to generate core image */
73 | const char *boot_filename;
74 | #ifdef JANET_NO_SOURCEMAPS
75 | boot_filename = NULL;
76 | #else
77 | boot_filename = "boot.janet";
78 | #endif
79 |
80 | int chdir_status = chdir(argv[1]);
81 | if (chdir_status) {
82 | fprintf(stderr, "Could not change to directory %s\n", argv[1]);
83 | exit(1);
84 | }
85 |
86 | FILE *boot_file = fopen("src/boot/boot.janet", "rb");
87 | if (NULL == boot_file) {
88 | fprintf(stderr, "Could not open src/boot/boot.janet\n");
89 | exit(1);
90 | }
91 |
92 | /* Slurp file into buffer */
93 | fseek(boot_file, 0, SEEK_END);
94 | size_t boot_size = ftell(boot_file);
95 | fseek(boot_file, 0, SEEK_SET);
96 | unsigned char *boot_buffer = janet_malloc(boot_size);
97 | if (NULL == boot_buffer) {
98 | fprintf(stderr, "Failed to allocate boot buffer\n");
99 | exit(1);
100 | }
101 | if (!fread(boot_buffer, 1, boot_size, boot_file)) {
102 | fprintf(stderr, "Failed to read into boot buffer\n");
103 | exit(1);
104 | }
105 | fclose(boot_file);
106 |
107 | status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
108 | janet_free(boot_buffer);
109 |
110 | /* Deinitialize vm */
111 | janet_deinit();
112 |
113 | return status;
114 | }
115 |
--------------------------------------------------------------------------------
/test/suite-struct.janet:
--------------------------------------------------------------------------------
1 | # Copyright (c) 2025 Calvin Rose
2 | #
3 | # Permission is hereby granted, free of charge, to any person obtaining a copy
4 | # of this software and associated documentation files (the "Software"), to
5 | # deal in the Software without restriction, including without limitation the
6 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
7 | # sell copies of the Software, and to permit persons to whom the Software is
8 | # furnished to do so, subject to the following conditions:
9 | #
10 | # The above copyright notice and this permission notice shall be included in
11 | # all copies or substantial portions of the Software.
12 | #
13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16 | # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17 | # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
18 | # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
19 | # IN THE SOFTWARE.
20 |
21 | (import ./helper :prefix "" :exit true)
22 | (start-suite)
23 |
24 | # 21bd960
25 | (assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2))
26 | "struct order does not matter 1")
27 | # 42a88de
28 | (assert (= (struct
29 | :apple 1
30 | 6 :bork
31 | '(1 2 3) 5)
32 | (struct
33 | 6 :bork
34 | '(1 2 3) 5
35 | :apple 1)) "struct order does not matter 2")
36 |
37 | # Denormal structs
38 | # 38a7e4faf
39 | (assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
40 | (assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
41 |
42 | (assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
43 | (assert (= (length {1 2 (/ 0 0) 3}) 1) "nan key struct literal")
44 |
45 | (assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
46 | (assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
47 |
48 | # Struct duplicate elements
49 | # 8bc2987a7
50 | (assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
51 | (assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3))
52 | "struct constructor duplicate keys")
53 |
54 | # Struct prototypes
55 | # 4d983e5
56 | (def x (struct/with-proto {1 2 3 4} 5 6))
57 | (def y (-> x marshal unmarshal))
58 | (def z {1 2 3 4})
59 | (assert (= 2 (get x 1)) "struct get proto value 1")
60 | (assert (= 4 (get x 3)) "struct get proto value 2")
61 | (assert (= 6 (get x 5)) "struct get proto value 3")
62 | (assert (= x y) "struct proto marshal equality 1")
63 | (assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
64 | (assert (= 0 (cmp x y)) "struct proto comparison 1")
65 | (assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
66 | (assert (not= (cmp x z) 0) "struct proto comparison 3")
67 | (assert (not= (cmp y z) 0) "struct proto comparison 4")
68 | (assert (not= x z) "struct proto comparison 5")
69 | (assert (not= y z) "struct proto comparison 6")
70 | (assert (= (x 5) 6) "struct proto get 1")
71 | (assert (= (y 5) 6) "struct proto get 1")
72 | (assert (deep= x y) "struct proto deep= 1")
73 | (assert (deep-not= x z) "struct proto deep= 2")
74 | (assert (deep-not= y z) "struct proto deep= 3")
75 |
76 | # Check missing struct proto bug
77 | # 868ec1a7e, e08394c8
78 | (assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil))
79 | "missing struct proto")
80 |
81 | # struct/with-proto
82 | (assert-error "expected odd number of arguments" (struct/with-proto {} :a))
83 |
84 | # struct/to-table
85 | (def s (struct/with-proto {:a 1 :b 2} :name "john" ))
86 | (def t1 (struct/to-table s true))
87 | (def t2 (struct/to-table s false))
88 | (assert (deep= t1 @{:name "john"}) "struct/to-table 1")
89 | (assert (deep= t2 @{:name "john"}) "struct/to-table 2")
90 | (assert (deep= (getproto t1) @{:a 1 :b 2}) "struct/to-table 3")
91 | (assert (deep= (getproto t2) nil) "struct/to-table 4")
92 |
93 | (end-suite)
94 |
95 |
--------------------------------------------------------------------------------
/examples/numarray/numarray.c:
--------------------------------------------------------------------------------
1 | #include
2 | #include
3 |
4 | typedef struct {
5 | double *data;
6 | size_t size;
7 | } num_array;
8 |
9 | static num_array *num_array_init(num_array *array, size_t size) {
10 | array->data = (double *)janet_calloc(size, sizeof(double));
11 | array->size = size;
12 | return array;
13 | }
14 |
15 | static void num_array_deinit(num_array *array) {
16 | janet_free(array->data);
17 | }
18 |
19 | static int num_array_gc(void *p, size_t s) {
20 | (void) s;
21 | num_array *array = (num_array *)p;
22 | num_array_deinit(array);
23 | return 0;
24 | }
25 |
26 | int num_array_get(void *p, Janet key, Janet *out);
27 | void num_array_put(void *p, Janet key, Janet value);
28 |
29 | static const JanetAbstractType num_array_type = {
30 | "numarray",
31 | num_array_gc,
32 | NULL,
33 | num_array_get,
34 | num_array_put,
35 | JANET_ATEND_PUT
36 | };
37 |
38 | static Janet num_array_new(int32_t argc, Janet *argv) {
39 | janet_fixarity(argc, 1);
40 | int32_t size = janet_getinteger(argv, 0);
41 | num_array *array = (num_array *)janet_abstract(&num_array_type, sizeof(num_array));
42 | num_array_init(array, size);
43 | return janet_wrap_abstract(array);
44 | }
45 |
46 | static Janet num_array_scale(int32_t argc, Janet *argv) {
47 | janet_fixarity(argc, 2);
48 | num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
49 | double factor = janet_getnumber(argv, 1);
50 | size_t i;
51 | for (i = 0; i < array->size; i++) {
52 | array->data[i] *= factor;
53 | }
54 | return argv[0];
55 | }
56 |
57 | static Janet num_array_sum(int32_t argc, Janet *argv) {
58 | janet_fixarity(argc, 1);
59 | num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
60 | double sum = 0;
61 | for (size_t i = 0; i < array->size; i++) sum += array->data[i];
62 | return janet_wrap_number(sum);
63 | }
64 |
65 | void num_array_put(void *p, Janet key, Janet value) {
66 | size_t index;
67 | num_array *array = (num_array *)p;
68 | if (!janet_checkint(key))
69 | janet_panic("expected integer key");
70 | if (!janet_checktype(value, JANET_NUMBER))
71 | janet_panic("expected number value");
72 |
73 | index = (size_t)janet_unwrap_integer(key);
74 | if (index < array->size) {
75 | array->data[index] = janet_unwrap_number(value);
76 | }
77 | }
78 |
79 | static Janet num_array_length(int32_t argc, Janet *argv) {
80 | janet_fixarity(argc, 1);
81 | num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
82 | return janet_wrap_number(array->size);
83 | }
84 |
85 | static const JanetMethod methods[] = {
86 | {"scale", num_array_scale},
87 | {"sum", num_array_sum},
88 | {"length", num_array_length},
89 | {NULL, NULL}
90 | };
91 |
92 | int num_array_get(void *p, Janet key, Janet *out) {
93 | size_t index;
94 | num_array *array = (num_array *)p;
95 | if (janet_checktype(key, JANET_KEYWORD))
96 | return janet_getmethod(janet_unwrap_keyword(key), methods, out);
97 | if (!janet_checkint(key))
98 | janet_panic("expected integer key");
99 | index = (size_t)janet_unwrap_integer(key);
100 | if (index >= array->size) {
101 | return 0;
102 | } else {
103 | *out = janet_wrap_number(array->data[index]);
104 | }
105 | return 1;
106 | }
107 |
108 | static const JanetReg cfuns[] = {
109 | {
110 | "new", num_array_new,
111 | "(numarray/new size)\n\n"
112 | "Create new numarray"
113 | },
114 | {
115 | "scale", num_array_scale,
116 | "(numarray/scale numarray factor)\n\n"
117 | "scale numarray by factor"
118 | },
119 | {
120 | "sum", num_array_sum,
121 | "(numarray/sum numarray)\n\n"
122 | "sums numarray"
123 | },
124 | {NULL, NULL, NULL}
125 | };
126 |
127 | JANET_MODULE_ENTRY(JanetTable *env) {
128 | janet_cfuns(env, "numarray", cfuns);
129 | }
130 |
--------------------------------------------------------------------------------
/.github/workflows/release.yml:
--------------------------------------------------------------------------------
1 | name: Release
2 |
3 | on:
4 | push:
5 | tags:
6 | - "v*.*.*"
7 |
8 | permissions:
9 | contents: read
10 |
11 | jobs:
12 |
13 | release:
14 | permissions:
15 | contents: write # for softprops/action-gh-release to create GitHub release
16 | name: Build release binaries
17 | runs-on: ${{ matrix.os }}
18 | strategy:
19 | matrix:
20 | os: [ ubuntu-latest, macos-13 ]
21 | steps:
22 | - name: Checkout the repository
23 | uses: actions/checkout@master
24 | - name: Set the version
25 | run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
26 | - name: Set the platform
27 | run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
28 | - name: Compile the project
29 | run: make clean && make
30 | - name: Build the artifact
31 | run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-x64.tar.gz
32 | - name: Draft the release
33 | uses: softprops/action-gh-release@v1
34 | with:
35 | draft: true
36 | files: |
37 | build/*.gz
38 | build/janet.h
39 | build/c/janet.c
40 | build/c/shell.c
41 |
42 | release-arm:
43 | permissions:
44 | contents: write # for softprops/action-gh-release to create GitHub release
45 | name: Build release binaries
46 | runs-on: ${{ matrix.os }}
47 | strategy:
48 | matrix:
49 | os: [ macos-latest ]
50 | steps:
51 | - name: Checkout the repository
52 | uses: actions/checkout@master
53 | - name: Set the version
54 | run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
55 | - name: Set the platform
56 | run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
57 | - name: Compile the project
58 | run: make clean && make
59 | - name: Build the artifact
60 | run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz
61 | - name: Draft the release
62 | uses: softprops/action-gh-release@v1
63 | with:
64 | draft: true
65 | files: |
66 | build/*.gz
67 | build/janet.h
68 | build/c/janet.c
69 | build/c/shell.c
70 |
71 | release-windows:
72 | permissions:
73 | contents: write # for softprops/action-gh-release to create GitHub release
74 | name: Build release binaries for windows
75 | runs-on: windows-latest
76 | steps:
77 | - name: Checkout the repository
78 | uses: actions/checkout@master
79 | - name: Setup MSVC
80 | uses: ilammy/msvc-dev-cmd@v1
81 | - name: Build the project
82 | shell: cmd
83 | run: build_win all
84 | - name: Draft the release
85 | uses: softprops/action-gh-release@v1
86 | with:
87 | draft: true
88 | files: |
89 | ./dist/*.zip
90 | ./*.zip
91 | ./*.msi
92 |
93 | release-cosmo:
94 | permissions:
95 | contents: write # for softprops/action-gh-release to create GitHub release
96 | name: Build release binaries for Cosmo
97 | runs-on: ubuntu-latest
98 | steps:
99 | - name: Checkout the repository
100 | uses: actions/checkout@master
101 | - name: create build folder
102 | run: |
103 | sudo mkdir -p /sc
104 | sudo chmod -R 0777 /sc
105 | - name: setup Cosmopolitan Libc
106 | run: bash ./.github/cosmo/setup
107 | - name: Set the version
108 | run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
109 | - name: Set the platform
110 | run: echo "platform=cosmo" >> $GITHUB_ENV
111 | - name: build Janet APE binary
112 | run: bash ./.github/cosmo/build
113 | - name: push binary to github
114 | uses: softprops/action-gh-release@v1
115 | with:
116 | draft: true
117 | files: |
118 | /sc/cosmocc/janet.com
119 |
--------------------------------------------------------------------------------
/examples/debugger.janet:
--------------------------------------------------------------------------------
1 | ###
2 | ### A useful debugger library for Janet. Should be used
3 | ### inside a debug repl. This has been moved into the core.
4 | ###
5 |
6 | (defn .fiber
7 | "Get the current fiber being debugged."
8 | []
9 | (dyn :fiber))
10 |
11 | (defn .stack
12 | "Print the current fiber stack"
13 | []
14 | (print)
15 | (with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
16 | (print))
17 |
18 | (defn .frame
19 | "Show a stack frame"
20 | [&opt n]
21 | (def stack (debug/stack (.fiber)))
22 | (in stack (or n 0)))
23 |
24 | (defn .fn
25 | "Get the current function"
26 | [&opt n]
27 | (in (.frame n) :function))
28 |
29 | (defn .slots
30 | "Get an array of slots in a stack frame"
31 | [&opt n]
32 | (in (.frame n) :slots))
33 |
34 | (defn .slot
35 | "Get the value of the nth slot."
36 | [&opt nth frame-idx]
37 | (in (.slots frame-idx) (or nth 0)))
38 |
39 | (defn .quit
40 | "Resume (dyn :fiber) with the value passed to it after exiting the debugger."
41 | [&opt val]
42 | (setdyn :exit true)
43 | (setdyn :resume-value val)
44 | nil)
45 |
46 | (defn .disasm
47 | "Gets the assembly for the current function."
48 | [&opt n]
49 | (def frame (.frame n))
50 | (def func (frame :function))
51 | (disasm func))
52 |
53 | (defn .bytecode
54 | "Get the bytecode for the current function."
55 | [&opt n]
56 | ((.disasm n) 'bytecode))
57 |
58 | (defn .ppasm
59 | "Pretty prints the assembly for the current function"
60 | [&opt n]
61 | (def frame (.frame n))
62 | (def func (frame :function))
63 | (def dasm (disasm func))
64 | (def bytecode (dasm 'bytecode))
65 | (def pc (frame :pc))
66 | (def sourcemap (dasm 'sourcemap))
67 | (var last-loc [-2 -2])
68 | (print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]")
69 | (when-let [constants (dasm 'constants)]
70 | (printf " constants: %.4Q" constants))
71 | (printf " slots: %.4Q\n" (frame :slots))
72 | (def padding (string/repeat " " 20))
73 | (loop [i :range [0 (length bytecode)]
74 | :let [instr (bytecode i)]]
75 | (prin (if (= (tuple/type instr) :brackets) "*" " "))
76 | (prin (if (= i pc) "> " " "))
77 | (prinf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
78 | (when sourcemap
79 | (let [[sl sc] (sourcemap i)
80 | loc [sl sc]]
81 | (when (not= loc last-loc)
82 | (set last-loc loc)
83 | (prin " # line " sl ", column " sc))))
84 | (print))
85 | (print))
86 |
87 | (defn .source
88 | "Show the source code for the function being debugged."
89 | [&opt n]
90 | (def frame (.frame n))
91 | (def s (frame :source))
92 | (def all-source (slurp s))
93 | (print "\n\e[33m" all-source "\e[0m\n"))
94 |
95 | (defn .breakall
96 | "Set breakpoints on all instructions in the current function."
97 | [&opt n]
98 | (def fun (.fn n))
99 | (def bytecode (.bytecode n))
100 | (for i 0 (length bytecode)
101 | (debug/fbreak fun i))
102 | (print "Set " (length bytecode) " breakpoints in " fun))
103 |
104 | (defn .clearall
105 | "Clear all breakpoints on the current function."
106 | [&opt n]
107 | (def fun (.fn n))
108 | (def bytecode (.bytecode n))
109 | (for i 0 (length bytecode)
110 | (debug/unfbreak fun i))
111 | (print "Cleared " (length bytecode) " breakpoints in " fun))
112 |
113 | (defn .break
114 | "Set breakpoint at the current pc."
115 | []
116 | (def frame (.frame))
117 | (def fun (frame :function))
118 | (def pc (frame :pc))
119 | (debug/fbreak fun pc)
120 | (print "Set breakpoint in " fun " at pc=" pc))
121 |
122 | (defn .clear
123 | "Clear the current breakpoint"
124 | []
125 | (def frame (.frame))
126 | (def fun (frame :function))
127 | (def pc (frame :pc))
128 | (debug/unfbreak fun pc)
129 | (print "Cleared breakpoint in " fun " at pc=" pc))
130 |
131 | (defn .next
132 | "Go to the next breakpoint."
133 | [&opt n]
134 | (var res nil)
135 | (for i 0 (or n 1)
136 | (set res (resume (.fiber))))
137 | res)
138 |
139 | (defn .nextc
140 | "Go to the next breakpoint, clearing the current breakpoint."
141 | [&opt n]
142 | (.clear)
143 | (.next n))
144 |
145 | (defn .step
146 | "Execute the next n instructions."
147 | [&opt n]
148 | (var res nil)
149 | (for i 0 (or n 1)
150 | (set res (debug/step (.fiber))))
151 | res)
152 |
--------------------------------------------------------------------------------
/CONTRIBUTING.md:
--------------------------------------------------------------------------------
1 | # Guidelines for contributing to Janet
2 |
3 | Thanks for taking time to contribute to Janet!
4 |
5 | Please read this document before making contributions.
6 |
7 | ## Reporting bugs
8 |
9 | * Check past and current issues to see if your problem has been run into before.
10 | * If you can't find a past issue for your problem, or if the issues has been closed
11 | you should open a new issue. If there is a closed issue that is relevant, make
12 | sure to reference it.
13 | * As with any project, include a comprehensive description of the problem and instructions
14 | on how to reproduce it. If it is a compiler or language bug, please try to include a minimal
15 | example. This means don't post all 200 lines of code from your project, but spend some time
16 | distilling the problem to just the relevant code.
17 |
18 | ## Contributing Changes
19 |
20 | If you want to contribute some code to the project, please submit a pull request and
21 | follow the below guidelines. Not all changes will be merged, and some pull requests
22 | may require changes before being merged.
23 |
24 | * Include a description of the changes.
25 | * If there are changes to the compiler or the language, please include tests in the test folder.
26 | The test suites are not organized in any particular way now, so simply add your tests
27 | to one of the test suite files (test/suite0.janet, test/suite1.janet, etc.). You can
28 | run tests with `make test`. If you want to add a new test suite, simply add a file to
29 | the test folder and make sure it is run when`make test` is invoked.
30 | * Be consistent with the style. For C this means follow the indentation and style in
31 | other files (files have MIT license at top, 4 spaces indentation, no trailing
32 | whitespace, cuddled brackets, etc.) Use `make format` to automatically format your C code with
33 | [astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
34 | to install this, but it can be installed with most package managers.
35 |
36 | For janet code, use lisp indentation with 2 spaces. One can use janet.vim to
37 | do this indentation, or approximate as close as possible. There is a janet formatter
38 | in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
39 |
40 | ## C style
41 |
42 | For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
43 | a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
44 | omissions.
45 |
46 | * No `restrict`
47 | * Certain functions in the standard library are not always available
48 |
49 | In practice, this means programming for both MSVC on one hand and everything else on the other.
50 | The code must also build with emscripten, even if some features are not available, although
51 | this is not a priority.
52 |
53 | Code should compile warning free and run valgrind clean. I find that these two criteria are some
54 | of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
55 | valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
56 |
57 | ### Formatting
58 |
59 | Use [astyle](http://astyle.sourceforge.net/astyle.html) via `make format` to
60 | ensure a consistent code style for C.
61 |
62 | ## Janet style
63 |
64 | All janet code in the project should be formatted similar to the code in src/boot/boot.janet.
65 | The auto formatting from janet.vim will work well.
66 |
67 | ## Typo Fixing and One-Line changes
68 |
69 | Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
70 | individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
71 | CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
72 | specific changes, these can be addressed in the review process before the final merge, if the changes
73 | are accepted.
74 |
75 | Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
76 | immediately without response.
77 |
78 | ## Contributions from Automated Tools
79 |
80 | People making changes found or generated by automated tools MUST note this when opening an issue
81 | or creating a pull request. This can help give context to developers if the change/issue is
82 | confusing or nonsensical.
83 |
84 | ## Suggesting Changes
85 |
86 | To suggest changes, open an issue on GitHub. Check GitHub for other issues
87 | that may be related to your issue before opening a new suggestion. Suggestions
88 | put forth without code will be considered, but not necessarily implemented in any
89 | timely manner. In short, if you want extra functionality now, then build it.
90 |
91 | * Include a good description of the problem that is being solved
92 | * Include descriptions of potential solutions if you have some in mind.
93 |
--------------------------------------------------------------------------------
/.github/workflows/test.yml:
--------------------------------------------------------------------------------
1 | name: Test
2 |
3 | on: [push, pull_request]
4 |
5 | permissions:
6 | contents: read
7 |
8 | jobs:
9 |
10 | test-posix:
11 | name: Build and test on POSIX systems
12 | runs-on: ${{ matrix.os }}
13 | strategy:
14 | matrix:
15 | os: [ ubuntu-latest, macos-latest, macos-14 ]
16 | steps:
17 | - name: Checkout the repository
18 | uses: actions/checkout@master
19 | - name: Compile the project
20 | run: make clean && make
21 | - name: Test the project
22 | run: make test
23 |
24 | test-windows:
25 | name: Build and test on Windows
26 | strategy:
27 | matrix:
28 | os: [ windows-latest, windows-2022 ]
29 | runs-on: ${{ matrix.os }}
30 | steps:
31 | - name: Checkout the repository
32 | uses: actions/checkout@master
33 | - name: Setup MSVC
34 | uses: ilammy/msvc-dev-cmd@v1
35 | - name: Build the project
36 | shell: cmd
37 | run: build_win
38 | - name: Test the project
39 | shell: cmd
40 | run: build_win test
41 | - name: Test installer build
42 | shell: cmd
43 | run: build_win dist
44 |
45 | test-windows-min:
46 | name: Build and test on Windows Minimal build
47 | strategy:
48 | matrix:
49 | os: [ windows-2022 ]
50 | runs-on: ${{ matrix.os }}
51 | steps:
52 | - name: Checkout the repository
53 | uses: actions/checkout@master
54 | - name: Setup MSVC
55 | uses: ilammy/msvc-dev-cmd@v1
56 | - name: Setup Python
57 | uses: actions/setup-python@v2
58 | with:
59 | python-version: '3.x'
60 | - name: Install Python Dependencies
61 | run: pip install meson ninja
62 | - name: Build
63 | shell: cmd
64 | run: |
65 | meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
66 | cd build_meson_min
67 | ninja
68 |
69 | test-mingw:
70 | name: Build on Windows with Mingw
71 | runs-on: windows-latest
72 | defaults:
73 | run:
74 | shell: msys2 {0}
75 | strategy:
76 | matrix:
77 | msystem: [ UCRT64, CLANG64 ]
78 | steps:
79 | - name: Checkout the repository
80 | uses: actions/checkout@master
81 | - name: Setup Mingw
82 | uses: msys2/setup-msys2@v2
83 | with:
84 | msystem: ${{ matrix.msystem }}
85 | update: true
86 | install: >-
87 | base-devel
88 | git
89 | gcc
90 | - name: Build
91 | shell: cmd
92 | run: make -j4 CC=gcc
93 | - name: Test
94 | shell: cmd
95 | run: make -j4 CC=gcc test
96 |
97 | test-mingw-linux:
98 | name: Build and test with Mingw on Linux + Wine
99 | runs-on: ubuntu-latest
100 | steps:
101 | - name: Checkout the repository
102 | uses: actions/checkout@master
103 | - name: Setup Mingw and wine
104 | run: |
105 | sudo dpkg --add-architecture i386
106 | sudo apt-get update
107 | sudo apt-get install libstdc++6:i386 libgcc-s1:i386
108 | sudo apt-get install gcc-mingw-w64-x86-64-win32 wine wine32 wine64
109 | - name: Compile the project
110 | run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
111 | - name: Test the project
112 | run: make test UNAME=MINGW RUN=wine VERBOSE=1
113 |
114 | test-arm-linux:
115 | name: Build and test ARM32 cross compilation
116 | runs-on: ubuntu-latest
117 | steps:
118 | - name: Checkout the repository
119 | uses: actions/checkout@master
120 | - name: Setup qemu and cross compiler
121 | run: |
122 | sudo apt-get update
123 | sudo apt-get install gcc-arm-linux-gnueabi qemu-user
124 | - name: Compile the project
125 | run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
126 | - name: Test the project
127 | run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
128 |
129 | test-s390x-linux:
130 | name: Build and test s390x in qemu
131 | runs-on: ubuntu-latest
132 | steps:
133 | - name: Checkout the repository
134 | uses: actions/checkout@master
135 | - name: Enable qemu
136 | run: docker run --privileged --rm tonistiigi/binfmt --install s390x
137 | - name: Build and run on emulated architecture
138 | run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"
139 |
--------------------------------------------------------------------------------
/examples/ffi/so.c:
--------------------------------------------------------------------------------
1 | #include
2 | #include
3 | #include
4 |
5 | #ifdef _WIN32
6 | #define EXPORTER __declspec(dllexport)
7 | #else
8 | #define EXPORTER
9 | #endif
10 |
11 | /* Structs */
12 |
13 | typedef struct {
14 | int a, b;
15 | float c, d;
16 | } Split;
17 |
18 | typedef struct {
19 | float c, d;
20 | int a, b;
21 | } SplitFlip;
22 |
23 | typedef struct {
24 | int u, v, w, x, y, z;
25 | } SixInts;
26 |
27 | typedef struct {
28 | int a;
29 | int b;
30 | } intint;
31 |
32 | typedef struct {
33 | int a;
34 | int b;
35 | int c;
36 | } intintint;
37 |
38 | typedef struct {
39 | uint64_t a;
40 | uint64_t b;
41 | } uint64pair;
42 |
43 | typedef struct {
44 | int64_t a;
45 | int64_t b;
46 | int64_t c;
47 | } big;
48 |
49 | /* Functions */
50 |
51 | EXPORTER
52 | int int_fn(int a, int b) {
53 | return (a << 2) + b;
54 | }
55 |
56 | EXPORTER
57 | double my_fn(int64_t a, int64_t b, const char *x) {
58 | return (double)(a + b) + 0.5 + strlen(x);
59 | }
60 |
61 | EXPORTER
62 | double double_fn(double x, double y, double z) {
63 | return (x + y) * z * 3;
64 | }
65 |
66 | EXPORTER
67 | double double_many(double x, double y, double z, double w, double a, double b) {
68 | return x + y + z + w + a + b;
69 | }
70 |
71 | EXPORTER
72 | double double_lots(
73 | double a,
74 | double b,
75 | double c,
76 | double d,
77 | double e,
78 | double f,
79 | double g,
80 | double h,
81 | double i,
82 | double j) {
83 | return i + j;
84 | }
85 |
86 | EXPORTER
87 | double double_lots_2(
88 | double a,
89 | double b,
90 | double c,
91 | double d,
92 | double e,
93 | double f,
94 | double g,
95 | double h,
96 | double i,
97 | double j) {
98 | return a +
99 | 10.0 * b +
100 | 100.0 * c +
101 | 1000.0 * d +
102 | 10000.0 * e +
103 | 100000.0 * f +
104 | 1000000.0 * g +
105 | 10000000.0 * h +
106 | 100000000.0 * i +
107 | 1000000000.0 * j;
108 | }
109 |
110 | EXPORTER
111 | double float_fn(float x, float y, float z) {
112 | return (x + y) * z;
113 | }
114 |
115 | EXPORTER
116 | int intint_fn(double x, intint ii) {
117 | printf("double: %g\n", x);
118 | return ii.a + ii.b;
119 | }
120 |
121 | EXPORTER
122 | int intintint_fn(double x, intintint iii) {
123 | printf("double: %g\n", x);
124 | return iii.a + iii.b + iii.c;
125 | }
126 |
127 | EXPORTER
128 | intint return_struct(int i) {
129 | intint ret;
130 | ret.a = i;
131 | ret.b = i * i;
132 | return ret;
133 | }
134 |
135 | EXPORTER
136 | big struct_big(int i, double d) {
137 | big ret;
138 | ret.a = i;
139 | ret.b = (int64_t) d;
140 | ret.c = ret.a + ret.b + 1000;
141 | return ret;
142 | }
143 |
144 | EXPORTER
145 | void void_fn(void) {
146 | printf("void fn ran\n");
147 | }
148 |
149 | EXPORTER
150 | void void_fn_2(double y) {
151 | printf("y = %f\n", y);
152 | }
153 |
154 | EXPORTER
155 | void void_ret_fn(int x) {
156 | printf("void fn ran: %d\n", x);
157 | }
158 |
159 | EXPORTER
160 | int intintint_fn_2(intintint iii, int i) {
161 | fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
162 | return i * (iii.a + iii.b + iii.c);
163 | }
164 |
165 | EXPORTER
166 | float split_fn(Split s) {
167 | return s.a * s.c + s.b * s.d;
168 | }
169 |
170 | EXPORTER
171 | float split_flip_fn(SplitFlip s) {
172 | return s.a * s.c + s.b * s.d;
173 | }
174 |
175 | EXPORTER
176 | Split split_ret_fn(int x, float y) {
177 | Split ret;
178 | ret.a = x;
179 | ret.b = x;
180 | ret.c = y;
181 | ret.d = y;
182 | return ret;
183 | }
184 |
185 | EXPORTER
186 | SplitFlip split_flip_ret_fn(int x, float y) {
187 | SplitFlip ret;
188 | ret.a = x;
189 | ret.b = x;
190 | ret.c = y;
191 | ret.d = y;
192 | return ret;
193 | }
194 |
195 | EXPORTER
196 | SixInts sixints_fn(void) {
197 | return (SixInts) {
198 | 6666, 1111, 2222, 3333, 4444, 5555
199 | };
200 | }
201 |
202 | EXPORTER
203 | int sixints_fn_2(int x, SixInts s) {
204 | return x + s.u + s.v + s.w + s.x + s.y + s.z;
205 | }
206 |
207 | EXPORTER
208 | int sixints_fn_3(SixInts s, int x) {
209 | return x + s.u + s.v + s.w + s.x + s.y + s.z;
210 | }
211 |
212 | EXPORTER
213 | intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d,
214 | uint8_t e, uint8_t f, uint8_t g, uint8_t h,
215 | float i, float j, float k, float l,
216 | float m, float n, float o, float p,
217 | float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) {
218 | return (intint) {
219 | (a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p),
220 | s1 *s6.a + s2 *s6.b + s3 *s4 *s5
221 | };
222 | }
223 |
224 | EXPORTER
225 | double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) {
226 | return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d;
227 | }
228 |
--------------------------------------------------------------------------------
/test/suite-vm.janet:
--------------------------------------------------------------------------------
1 | # Copyright (c) 2025 Calvin Rose
2 | #
3 | # Permission is hereby granted, free of charge, to any person obtaining a copy
4 | # of this software and associated documentation files (the "Software"), to
5 | # deal in the Software without restriction, including without limitation the
6 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
7 | # sell copies of the Software, and to permit persons to whom the Software is
8 | # furnished to do so, subject to the following conditions:
9 | #
10 | # The above copyright notice and this permission notice shall be included in
11 | # all copies or substantial portions of the Software.
12 | #
13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16 | # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17 | # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
18 | # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
19 | # IN THE SOFTWARE.
20 |
21 | (import ./helper :prefix "" :exit true)
22 | (start-suite)
23 |
24 | # More fiber semantics
25 | # 0fd9224e4
26 | (var myvar 0)
27 | (defn fiberstuff [&]
28 | (++ myvar)
29 | (def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
30 | (resume f)
31 | (++ myvar))
32 |
33 | (def myfiber (fiber/new fiberstuff :dey))
34 |
35 | (assert (= myvar 0) "fiber creation does not call fiber function")
36 | (resume myfiber)
37 | (assert (= myvar 2) "fiber debug statement breaks at proper point")
38 | (assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
39 | (resume myfiber)
40 | (assert (= myvar 4) "fiber resumes properly from debug state")
41 | (assert (= (fiber/status myfiber) :dead)
42 | "fiber properly dies from debug state")
43 |
44 | # yield tests
45 | # 171c0ce
46 | (def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
47 |
48 | (assert (= 1 (resume t)) "initial transfer to new fiber")
49 | (assert (= 2 (resume t)) "second transfer to fiber")
50 | (assert (= 3 (resume t)) "return from fiber")
51 | (assert (= (fiber/status t) :dead) "finished fiber is dead")
52 |
53 | # Fix yields inside nested fibers
54 | # 909c906
55 | (def yielder
56 | (coro
57 | (defer (yield :end)
58 | (repeat 5 (yield :item)))))
59 | (def items (seq [x :in yielder] x))
60 | (assert (deep= @[:item :item :item :item :item :end] items)
61 | "yield within nested fibers")
62 |
63 | # Calling non functions
64 | # b9c0fc820
65 | (assert (= 1 ({:ok 1} :ok)) "calling struct")
66 | (assert (= 2 (@{:ok 2} :ok)) "calling table")
67 | (assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad)))
68 | "calling table too many arguments")
69 | (assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad)))
70 | "calling keyword too many arguments")
71 | (assert (= :oops (try ((+ 2 -1) 1) ([err] :oops)))
72 | "calling number fails")
73 |
74 | # Method test
75 | # d5bab7262
76 | (def Dog @{:bark (fn bark [self what]
77 | (string (self :name) " says " what "!"))})
78 | (defn make-dog
79 | [name]
80 | (table/setproto @{:name name} Dog))
81 |
82 | (assert (= "fido" ((make-dog "fido") :name)) "oo 1")
83 | (def spot (make-dog "spot"))
84 | (assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
85 |
86 | # Negative tests
87 | # 67f26b7d7
88 | (assert-error "+ check types" (+ 1 ()))
89 | (assert-error "- check types" (- 1 ()))
90 | (assert-error "* check types" (* 1 ()))
91 | (assert-error "/ check types" (/ 1 ()))
92 | (assert-error "band check types" (band 1 ()))
93 | (assert-error "bor check types" (bor 1 ()))
94 | (assert-error "bxor check types" (bxor 1 ()))
95 | (assert-error "bnot check types" (bnot ()))
96 |
97 | # Comparisons
98 | # 10dcbc639
99 | (assert (> 1e23 100) "less than immediate 1")
100 | (assert (> 1e23 1000) "less than immediate 2")
101 | (assert (< 100 1e23) "greater than immediate 1")
102 | (assert (< 1000 1e23) "greater than immediate 2")
103 |
104 | # Quasiquote bracketed tuples
105 | # e239980da
106 | (assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3]))
107 | "quasiquote bracket tuples")
108 |
109 | # Regression #638
110 | # c68264802
111 | (compwhen
112 | (dyn 'ev/go)
113 | (assert
114 | (= [true :caught]
115 | (protect
116 | (try
117 | (do
118 | (ev/sleep 0)
119 | (with-dyns []
120 | (ev/sleep 0)
121 | (error "oops")))
122 | ([err] :caught))))
123 | "regression #638"))
124 |
125 | #
126 | # Test propagation of signals via fibers
127 | #
128 | # b8032ec61
129 | (def f (fiber/new (fn [] (error :abc) 1) :ei))
130 | (def res (resume f))
131 | (assert-error :abc (propagate res f) "propagate 1")
132 |
133 | # Cancel test
134 | # 28439d822
135 | (def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
136 | (assert (= 1 (resume f)) "cancel resume 1")
137 | (assert (= 2 (resume f)) "cancel resume 2")
138 | (assert (= :hi (cancel f :hi)) "cancel resume 3")
139 | (assert (= :error (fiber/status f)) "cancel resume 4")
140 |
141 | (end-suite)
142 |
143 |
--------------------------------------------------------------------------------
/examples/ffi/test.janet:
--------------------------------------------------------------------------------
1 | #
2 | # Simple FFI test script that tests against a simple shared object
3 | #
4 |
5 | (def is-windows (= :windows (os/which)))
6 | (def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
7 | (def ffi/source-loc "examples/ffi/so.c")
8 |
9 | (if is-windows
10 | (os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
11 | (os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px))
12 |
13 | (ffi/context ffi/loc)
14 |
15 | (def intint (ffi/struct :int :int))
16 | (def intintint (ffi/struct :int :int :int))
17 | (def uint64pair (ffi/struct :u64 :u64))
18 | (def big (ffi/struct :s64 :s64 :s64))
19 | (def split (ffi/struct :int :int :float :float))
20 | (def split-flip (ffi/struct :float :float :int :int))
21 | (def six-ints (ffi/struct :int :int :int :int :int :int))
22 |
23 | (ffi/defbind int-fn :int [a :int b :int])
24 | (ffi/defbind double-fn :double [a :double b :double c :double])
25 | (ffi/defbind double-many :double
26 | [x :double y :double z :double w :double a :double b :double])
27 | (ffi/defbind double-lots :double
28 | [a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
29 | (ffi/defbind float-fn :double
30 | [x :float y :float z :float])
31 | (ffi/defbind intint-fn :int
32 | [x :double ii [:int :int]])
33 | (ffi/defbind return-struct [:int :int]
34 | [i :int])
35 | (ffi/defbind intintint-fn :int
36 | [x :double iii intintint])
37 | (ffi/defbind struct-big big
38 | [i :int d :double])
39 | (ffi/defbind void-fn :void [])
40 | (ffi/defbind double-lots-2 :double
41 | [a :double
42 | b :double
43 | c :double
44 | d :double
45 | e :double
46 | f :double
47 | g :double
48 | h :double
49 | i :double
50 | j :double])
51 | (ffi/defbind void-fn-2 :void [y :double])
52 | (ffi/defbind intintint-fn-2 :int [iii intintint i :int])
53 | (ffi/defbind split-fn :float [s split])
54 | (ffi/defbind split-flip-fn :float [s split-flip])
55 | (ffi/defbind split-ret-fn split [x :int y :float])
56 | (ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
57 | (ffi/defbind sixints-fn six-ints [])
58 | (ffi/defbind sixints-fn-2 :int [x :int s six-ints])
59 | (ffi/defbind sixints-fn-3 :int [s six-ints x :int])
60 | (ffi/defbind stack-spill-fn intint
61 | [a :u8 b :u8 c :u8 d :u8
62 | e :u8 f :u8 g :u8 h :u8
63 | i :float j :float k :float l :float
64 | m :float n :float o :float p :float
65 | s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint])
66 | (ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8])
67 | (ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
68 |
69 | #
70 | # Struct reading and writing
71 | #
72 |
73 | (defn check-round-trip
74 | [t value]
75 | (def buf (ffi/write t value))
76 | (def same-value (ffi/read t buf))
77 | (assert (deep= value same-value)
78 | (string/format "round trip %j (got %j)" value same-value)))
79 |
80 | (check-round-trip :bool true)
81 | (check-round-trip :bool false)
82 | (check-round-trip :void nil)
83 | (check-round-trip :void nil)
84 | (check-round-trip :s8 10)
85 | (check-round-trip :s8 0)
86 | (check-round-trip :s8 -10)
87 | (check-round-trip :u8 10)
88 | (check-round-trip :u8 0)
89 | (check-round-trip :s16 10)
90 | (check-round-trip :s16 0)
91 | (check-round-trip :s16 -12312)
92 | (check-round-trip :u16 10)
93 | (check-round-trip :u16 0)
94 | (check-round-trip :u32 0)
95 | (check-round-trip :u32 10)
96 | (check-round-trip :u32 0xFFFF7777)
97 | (check-round-trip :s32 0x7FFF7777)
98 | (check-round-trip :s32 0)
99 | (check-round-trip :s32 -1234567)
100 |
101 | (def s (ffi/struct :s8 :s8 :s8 :float))
102 | (check-round-trip s [1 3 5 123.5])
103 | (check-round-trip s [-1 -3 -5 -123.5])
104 |
105 | #
106 | # Call functions
107 | #
108 |
109 | (tracev (sixints-fn))
110 | (tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
111 | (tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
112 | (tracev (split-ret-fn 10 12))
113 | (tracev (split-flip-ret-fn 10 12))
114 | (tracev (split-flip-ret-fn 12 10))
115 | (tracev (intintint-fn-2 [10 20 30] 3))
116 | (tracev (split-fn [5 6 1.2 3.4]))
117 | (tracev (void-fn-2 10.3))
118 | (tracev (double-many 1 2 3 4 5 6))
119 | (tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
120 | (tracev (type (double-many 1 2 3 4 5 6)))
121 | (tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
122 | (tracev (void-fn))
123 | (tracev (int-fn 10 20))
124 | (tracev (double-fn 1.5 2.5 3.5))
125 | (tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
126 | (tracev (float-fn 8 4 17))
127 | (tracev (intint-fn 123.456 [10 20]))
128 | (tracev (intintint-fn 123.456 [10 20 30]))
129 | (tracev (return-struct 42))
130 | (tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
131 | (tracev (struct-big 11 99.5))
132 | (tracev (int-fn-aliased 10 20))
133 |
134 | (assert (= [10 10 12 12] (split-ret-fn 10 12)))
135 | (assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
136 | (assert (= 183 (intintint-fn-2 [10 20 31] 3)))
137 | (assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
138 | (assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
139 | (assert (= 60 (int-fn 10 20)))
140 | (assert (= 42 (double-fn 1.5 2.5 3.5)))
141 | (assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
142 | (assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
143 | (assert (= 204 (float-fn 8 4 17)))
144 | (assert (= [0 38534415] (stack-spill-fn
145 | 0 0 0 0 0 0 0 0
146 | 0 0 0 0 0 0 0 0
147 | 1.5 -32 196 65536.5 3 [-15 32])))
148 | (assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23)))
149 |
150 | (print "Done.")
151 |
--------------------------------------------------------------------------------
/src/core/regalloc.c:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #ifndef JANET_AMALG
24 | #include "features.h"
25 | #include
26 | #include "regalloc.h"
27 | #include "util.h"
28 | #endif
29 |
30 | /* The JanetRegisterAllocator is really just a bitset. */
31 |
32 | void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
33 | ra->chunks = NULL;
34 | ra->count = 0;
35 | ra->capacity = 0;
36 | ra->max = 0;
37 | ra->regtemps = 0;
38 | }
39 |
40 | void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
41 | janet_free(ra->chunks);
42 | }
43 |
44 | /* Fallbacks for when ctz not available */
45 | #ifdef __GNUC__
46 | #define count_trailing_zeros(x) __builtin_ctz(x)
47 | #define count_trailing_ones(x) __builtin_ctz(~(x))
48 | #else
49 | static int32_t count_trailing_ones(uint32_t x) {
50 | int32_t ret = 0;
51 | while (x & 1) {
52 | ret++;
53 | x >>= 1;
54 | }
55 | return ret;
56 | }
57 | #define count_trailing_zeros(x) count_trailing_ones(~(x))
58 | #endif
59 |
60 | /* Get ith bit */
61 | #define ithbit(I) ((uint32_t)1 << (I))
62 |
63 | /* Get N bits */
64 | #define nbits(N) (ithbit(N) - 1)
65 |
66 | /* Copy a register allocator */
67 | void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
68 | size_t size;
69 | dest->count = src->count;
70 | dest->capacity = src->capacity;
71 | dest->max = src->max;
72 | size = sizeof(uint32_t) * (size_t) dest->capacity;
73 | dest->regtemps = 0;
74 | if (size) {
75 | dest->chunks = janet_malloc(size);
76 | if (!dest->chunks) {
77 | JANET_OUT_OF_MEMORY;
78 | }
79 | memcpy(dest->chunks, src->chunks, size);
80 | } else {
81 | dest->chunks = NULL;
82 | }
83 | }
84 |
85 | /* Allocate one more chunk in chunks */
86 | static void pushchunk(JanetcRegisterAllocator *ra) {
87 | /* Registers 240-255 are always allocated (reserved) */
88 | uint32_t chunk = ra->count == 7 ? 0xFFFF0000 : 0;
89 | int32_t newcount = ra->count + 1;
90 | if (newcount > ra->capacity) {
91 | int32_t newcapacity = newcount * 2;
92 | ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
93 | if (!ra->chunks) {
94 | JANET_OUT_OF_MEMORY;
95 | }
96 | ra->capacity = newcapacity;
97 | }
98 | ra->chunks[ra->count] = chunk;
99 | ra->count = newcount;
100 | }
101 |
102 | /* Reallocate a given register */
103 | void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg) {
104 | int32_t chunk = reg >> 5;
105 | int32_t bit = reg & 0x1F;
106 | while (chunk >= ra->count) pushchunk(ra);
107 | ra->chunks[chunk] |= ithbit(bit);
108 | }
109 |
110 | /* Allocate one register. */
111 | int32_t janetc_regalloc_1(JanetcRegisterAllocator *ra) {
112 | /* Get the nth bit in the array */
113 | int32_t bit, chunk, nchunks, reg;
114 | bit = -1;
115 | nchunks = ra->count;
116 | for (chunk = 0; chunk < nchunks; chunk++) {
117 | uint32_t block = ra->chunks[chunk];
118 | if (block == 0xFFFFFFFF) continue;
119 | bit = count_trailing_ones(block);
120 | break;
121 | }
122 | /* No reg found */
123 | if (bit == -1) {
124 | pushchunk(ra);
125 | bit = 0;
126 | chunk = nchunks;
127 | }
128 | /* set the bit at index bit in chunk */
129 | ra->chunks[chunk] |= ithbit(bit);
130 | reg = (chunk << 5) + bit;
131 | if (reg > ra->max)
132 | ra->max = reg;
133 | return reg;
134 | }
135 |
136 | /* Free a register. The register must have been previously allocated
137 | * without being freed. */
138 | void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
139 | int32_t chunk = reg >> 5;
140 | int32_t bit = reg & 0x1F;
141 | ra->chunks[chunk] &= ~ithbit(bit);
142 | }
143 |
144 | /* Check if a register is set. */
145 | int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg) {
146 | int32_t chunk = reg >> 5;
147 | int32_t bit = reg & 0x1F;
148 | while (chunk >= ra->count) pushchunk(ra);
149 | return !!(ra->chunks[chunk] & ithbit(bit));
150 | }
151 |
152 | /* Get a register that will fit in 8 bits (< 256). Do not call this
153 | * twice with the same value of nth without calling janetc_regalloc_free
154 | * on the returned register before. */
155 | int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
156 | int32_t oldmax = ra->max;
157 | if (ra->regtemps & (1 << nth)) {
158 | JANET_EXIT("regtemp already allocated");
159 | }
160 | ra->regtemps |= 1 << nth;
161 | int32_t reg = janetc_regalloc_1(ra);
162 | if (reg > 0xFF) {
163 | reg = 0xF0 + nth;
164 | ra->max = (reg > oldmax) ? reg : oldmax;
165 | }
166 | return reg;
167 | }
168 |
169 | void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth) {
170 | ra->regtemps &= ~(1 << nth);
171 | if (reg < 0xF0)
172 | janetc_regalloc_free(ra, reg);
173 | }
174 |
--------------------------------------------------------------------------------
/test/suite-bundle.janet:
--------------------------------------------------------------------------------
1 | # Copyright (c) 2025 Calvin Rose
2 | #
3 | # Permission is hereby granted, free of charge, to any person obtaining a copy
4 | # of this software and associated documentation files (the "Software"), to
5 | # deal in the Software without restriction, including without limitation the
6 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
7 | # sell copies of the Software, and to permit persons to whom the Software is
8 | # furnished to do so, subject to the following conditions:
9 | #
10 | # The above copyright notice and this permission notice shall be included in
11 | # all copies or substantial portions of the Software.
12 | #
13 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16 | # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17 | # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
18 | # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
19 | # IN THE SOFTWARE.
20 |
21 | (import ./helper :prefix "" :exit true)
22 | (start-suite)
23 |
24 | (assert true) # smoke test
25 |
26 | # Testing here is stateful since we are manipulating the filesystem.
27 |
28 | # Copy since not exposed in boot.janet
29 | (defn- bundle-rpath
30 | [path]
31 | (string/replace-all "\\" "/" (os/realpath path)))
32 |
33 | # Test mkdir -> rmdir
34 | (assert (os/mkdir "tempdir123"))
35 | (rmrf "tempdir123")
36 |
37 | # Setup a temporary syspath for manipultation
38 | (math/seedrandom (os/cryptorand 16))
39 | (def syspath (randdir))
40 | (rmrf syspath)
41 | (assert (os/mkdir syspath))
42 | (put root-env *syspath* (bundle-rpath syspath))
43 | (unless (os/getenv "VERBOSE")
44 | (setdyn *out* @""))
45 | (assert (empty? (bundle/list)) "initial bundle/list")
46 | (assert (empty? (bundle/topolist)) "initial bundle/topolist")
47 |
48 | # Try (and fail) to install sample-bundle (missing deps)
49 | (assert-error "missing dependencies sample-dep1, sample-dep2"
50 | (bundle/install "./examples/sample-bundle"))
51 | (assert (empty? (bundle/list)))
52 |
53 | # Install deps (dep1 as :auto-remove)
54 | (assert-no-error "sample-dep2"
55 | (bundle/install "./examples/sample-dep2"))
56 | (assert (= 1 (length (bundle/list))))
57 | (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1"))
58 | (assert (= 2 (length (bundle/list))))
59 |
60 | (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2"))
61 | (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true))
62 |
63 | (assert (= 2 (length (bundle/list))) "bundles are listed correctly 1")
64 | (assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2")
65 |
66 | # Now install sample-bundle
67 | (assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle"))
68 |
69 | (assert-error "" (bundle/install "./examples/sample-dep11111"))
70 |
71 | (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
72 | (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
73 |
74 | # Check topolist has not bad order
75 | (def tlist (bundle/topolist))
76 | (assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep2" tlist)) "topolist 1")
77 | (assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep1" tlist)) "topolist 2")
78 | (assert (> (index-of "sample-dep1" tlist) (index-of "sample-dep2" tlist)) "topolist 3")
79 |
80 | # Prune should do nothing
81 | (assert-no-error "first prune" (bundle/prune))
82 | (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
83 | (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
84 |
85 | # Check that we can import the main dependency
86 | (import mymod)
87 | (assert (= 288 (mymod/myfn 12)) "using sample-bundle")
88 |
89 | # Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies
90 | (assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
91 | (bundle/uninstall "sample-dep1"))
92 |
93 | # Check bundle file aliases
94 | (assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases"))
95 | (assert (= 4 (length (bundle/list))) "bundles are listed correctly 5")
96 | (assert-no-error "import aliases" (import aliases-mod))
97 | (assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases")
98 | (assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases"))
99 |
100 | # Now re-install sample-bundle as auto-remove
101 | (assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
102 |
103 | # Reinstallation should also work without being concerned about breaking dependencies
104 | (assert-no-error "reinstall dep" (bundle/reinstall "sample-dep2"))
105 |
106 | # Now prune should get rid of everything except sample-dep2
107 | (assert-no-error "second prune" (bundle/prune))
108 |
109 | # Now check that we exactly one package left, which is dep2
110 | (assert (= 1 (length (bundle/list))) "bundles are listed correctly 5")
111 | (assert (= 1 (length (bundle/topolist))) "bundles are listed correctly 6")
112 |
113 | # Which we can uninstall manually
114 | (assert-no-error "uninstall dep2" (bundle/uninstall "sample-dep2"))
115 |
116 | # Now check bundle listing is again empty
117 | (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
118 | (assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
119 |
120 | # Try installing a bundle that is missing bundle script
121 | (assert-error-value "bundle missing bundle script"
122 | "bundle must contain bundle.janet or bundle/init.janet"
123 | (bundle/install "./examples/sample-bad-bundle1"))
124 | (assert (= 0 (length (bundle/list))) "check failure 0")
125 | (assert (= 0 (length (bundle/topolist))) "check failure 1")
126 |
127 | # Try installing a bundle that fails check
128 | (assert-error-value "bundle check hook fails"
129 | "Check failed!"
130 | (bundle/install "./examples/sample-bad-bundle2" :check true))
131 | (assert (= 0 (length (bundle/list))) "check failure 0")
132 | (assert (= 0 (length (bundle/topolist))) "check failure 1")
133 |
134 | (rmrf syspath)
135 |
136 | (end-suite)
137 |
--------------------------------------------------------------------------------
/src/core/state.h:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #ifndef JANET_STATE_H_defined
24 | #define JANET_STATE_H_defined
25 |
26 | #ifndef JANET_AMALG
27 | #include "features.h"
28 | #include
29 | #include
30 | #endif
31 |
32 | #ifdef JANET_EV
33 | #ifdef JANET_WINDOWS
34 | #include
35 | #else
36 | #include
37 | #endif
38 | #endif
39 |
40 | typedef int64_t JanetTimestamp;
41 |
42 | typedef struct JanetScratch {
43 | JanetScratchFinalizer finalize;
44 | long long mem[]; /* for proper alignment */
45 | } JanetScratch;
46 |
47 | typedef struct {
48 | JanetGCObject *self;
49 | JanetGCObject *other;
50 | int32_t index;
51 | int32_t index2;
52 | } JanetTraversalNode;
53 |
54 | typedef struct {
55 | int32_t capacity;
56 | int32_t head;
57 | int32_t tail;
58 | void *data;
59 | } JanetQueue;
60 |
61 | #ifdef JANET_EV
62 | typedef struct {
63 | JanetTimestamp when;
64 | JanetFiber *fiber;
65 | JanetFiber *curr_fiber;
66 | uint32_t sched_id;
67 | int is_error;
68 | int has_worker;
69 | #ifdef JANET_WINDOWS
70 | HANDLE worker;
71 | HANDLE worker_event;
72 | #else
73 | pthread_t worker;
74 | #endif
75 | } JanetTimeout;
76 | #endif
77 |
78 | /* Registry table for C functions - contains metadata that can
79 | * be looked up by cfunction pointer. All strings here are pointing to
80 | * static memory not managed by Janet. */
81 | typedef struct {
82 | JanetCFunction cfun;
83 | const char *name;
84 | const char *name_prefix;
85 | const char *source_file;
86 | int32_t source_line;
87 | /* int32_t min_arity; */
88 | /* int32_t max_arity; */
89 | } JanetCFunRegistry;
90 |
91 | struct JanetVM {
92 | /* Place for user data */
93 | void *user;
94 |
95 | /* Top level dynamic bindings */
96 | JanetTable *top_dyns;
97 |
98 | /* Cache the core environment */
99 | JanetTable *core_env;
100 |
101 | /* How many VM stacks have been entered */
102 | int stackn;
103 |
104 | /* If this flag is true, suspend on function calls and backwards jumps.
105 | * When this occurs, this flag will be reset to 0. */
106 | volatile JanetAtomicInt auto_suspend;
107 |
108 | /* The current running fiber on the current thread.
109 | * Set and unset by functions in vm.c */
110 | JanetFiber *fiber;
111 | JanetFiber *root_fiber;
112 |
113 | /* The current pointer to the inner most jmp_buf. The current
114 | * return point for panics. */
115 | jmp_buf *signal_buf;
116 | Janet *return_reg;
117 | int coerce_error;
118 |
119 | /* The global registry for c functions. Used to store meta-data
120 | * along with otherwise bare c function pointers. */
121 | JanetCFunRegistry *registry;
122 | size_t registry_cap;
123 | size_t registry_count;
124 | int registry_dirty;
125 |
126 | /* Registry for abstract types that can be marshalled.
127 | * We need this to look up the constructors when unmarshalling. */
128 | JanetTable *abstract_registry;
129 |
130 | /* Immutable value cache */
131 | const uint8_t **cache;
132 | uint32_t cache_capacity;
133 | uint32_t cache_count;
134 | uint32_t cache_deleted;
135 | uint8_t gensym_counter[8];
136 |
137 | /* Garbage collection */
138 | void *blocks;
139 | void *weak_blocks;
140 | size_t gc_interval;
141 | size_t next_collection;
142 | size_t block_count;
143 | int gc_suspend;
144 | int gc_mark_phase;
145 |
146 | /* GC roots */
147 | Janet *roots;
148 | size_t root_count;
149 | size_t root_capacity;
150 |
151 | /* Scratch memory */
152 | JanetScratch **scratch_mem;
153 | size_t scratch_cap;
154 | size_t scratch_len;
155 |
156 | /* Sandbox flags */
157 | uint32_t sandbox_flags;
158 |
159 | /* Random number generator */
160 | JanetRNG rng;
161 |
162 | /* Traversal pointers */
163 | JanetTraversalNode *traversal;
164 | JanetTraversalNode *traversal_top;
165 | JanetTraversalNode *traversal_base;
166 |
167 | /* Thread safe strerror error buffer - for janet_strerror */
168 | #ifndef JANET_WINDOWS
169 | char strerror_buf[256];
170 | #endif
171 |
172 | /* Event loop and scheduler globals */
173 | #ifdef JANET_EV
174 | size_t tq_count;
175 | size_t tq_capacity;
176 | JanetQueue spawn;
177 | JanetTimeout *tq;
178 | JanetRNG ev_rng;
179 | volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */
180 | JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
181 | JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
182 | JanetTable signal_handlers;
183 | #ifdef JANET_WINDOWS
184 | void **iocp;
185 | #elif defined(JANET_EV_EPOLL)
186 | pthread_attr_t new_thread_attr;
187 | JanetHandle selfpipe[2];
188 | int epoll;
189 | int timerfd;
190 | int timer_enabled;
191 | #elif defined(JANET_EV_KQUEUE)
192 | pthread_attr_t new_thread_attr;
193 | JanetHandle selfpipe[2];
194 | int kq;
195 | int timer;
196 | int timer_enabled;
197 | #else
198 | JanetStream **streams;
199 | size_t stream_count;
200 | size_t stream_capacity;
201 | pthread_attr_t new_thread_attr;
202 | JanetHandle selfpipe[2];
203 | struct pollfd *fds;
204 | #endif
205 | #endif
206 |
207 | };
208 |
209 | extern JANET_THREAD_LOCAL JanetVM janet_vm;
210 |
211 | #ifdef JANET_NET
212 | void janet_net_init(void);
213 | void janet_net_deinit(void);
214 | #endif
215 |
216 | #ifdef JANET_EV
217 | void janet_ev_init(void);
218 | void janet_ev_deinit(void);
219 | #endif
220 |
221 | #endif /* JANET_STATE_H_defined */
222 |
--------------------------------------------------------------------------------
/src/core/abstract.c:
--------------------------------------------------------------------------------
1 | /*
2 | * Copyright (c) 2025 Calvin Rose
3 | *
4 | * Permission is hereby granted, free of charge, to any person obtaining a copy
5 | * of this software and associated documentation files (the "Software"), to
6 | * deal in the Software without restriction, including without limitation the
7 | * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 | * sell copies of the Software, and to permit persons to whom the Software is
9 | * furnished to do so, subject to the following conditions:
10 | *
11 | * The above copyright notice and this permission notice shall be included in
12 | * all copies or substantial portions of the Software.
13 | *
14 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 | * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 | * IN THE SOFTWARE.
21 | */
22 |
23 | #ifndef JANET_AMALG
24 | #include "features.h"
25 | #include
26 | #include "util.h"
27 | #include "gc.h"
28 | #include "state.h"
29 | #endif
30 |
31 | #ifdef JANET_EV
32 | #ifdef JANET_WINDOWS
33 | #include
34 | #endif
35 | #endif
36 |
37 | /* Create new userdata */
38 | void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
39 | JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
40 | sizeof(JanetAbstractHead) + size);
41 | header->size = size;
42 | header->type = atype;
43 | return (void *) & (header->data);
44 | }
45 |
46 | void *janet_abstract_end(void *x) {
47 | janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_ABSTRACT);
48 | return x;
49 | }
50 |
51 | void *janet_abstract(const JanetAbstractType *atype, size_t size) {
52 | return janet_abstract_end(janet_abstract_begin(atype, size));
53 | }
54 |
55 | #ifdef JANET_EV
56 |
57 | /*
58 | * Threaded abstracts
59 | */
60 |
61 | void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size) {
62 | JanetAbstractHead *header = janet_malloc(sizeof(JanetAbstractHead) + size);
63 | if (NULL == header) {
64 | JANET_OUT_OF_MEMORY;
65 | }
66 | janet_vm.next_collection += size + sizeof(JanetAbstractHead);
67 | header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
68 | header->gc.data.next = NULL; /* Clear memory for address sanitizers */
69 | header->gc.data.refcount = 1;
70 | header->size = size;
71 | header->type = atype;
72 | void *abstract = (void *) & (header->data);
73 | janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(abstract), janet_wrap_false());
74 | return abstract;
75 | }
76 |
77 | void *janet_abstract_end_threaded(void *x) {
78 | janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_THREADED_ABSTRACT);
79 | return x;
80 | }
81 |
82 | void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
83 | return janet_abstract_end_threaded(janet_abstract_begin_threaded(atype, size));
84 | }
85 |
86 | /* Refcounting primitives and sync primitives */
87 |
88 | #ifdef JANET_WINDOWS
89 |
90 | size_t janet_os_mutex_size(void) {
91 | return sizeof(CRITICAL_SECTION);
92 | }
93 |
94 | size_t janet_os_rwlock_size(void) {
95 | return sizeof(void *);
96 | }
97 |
98 | void janet_os_mutex_init(JanetOSMutex *mutex) {
99 | InitializeCriticalSection((CRITICAL_SECTION *) mutex);
100 | }
101 |
102 | void janet_os_mutex_deinit(JanetOSMutex *mutex) {
103 | DeleteCriticalSection((CRITICAL_SECTION *) mutex);
104 | }
105 |
106 | void janet_os_mutex_lock(JanetOSMutex *mutex) {
107 | EnterCriticalSection((CRITICAL_SECTION *) mutex);
108 | }
109 |
110 | void janet_os_mutex_unlock(JanetOSMutex *mutex) {
111 | /* error handling? May want to keep counter */
112 | LeaveCriticalSection((CRITICAL_SECTION *) mutex);
113 | }
114 |
115 | void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
116 | InitializeSRWLock((PSRWLOCK) rwlock);
117 | }
118 |
119 | void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
120 | /* no op? */
121 | (void) rwlock;
122 | }
123 |
124 | void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
125 | AcquireSRWLockShared((PSRWLOCK) rwlock);
126 | }
127 |
128 | void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
129 | AcquireSRWLockExclusive((PSRWLOCK) rwlock);
130 | }
131 |
132 | void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
133 | ReleaseSRWLockShared((PSRWLOCK) rwlock);
134 | }
135 |
136 | void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
137 | ReleaseSRWLockExclusive((PSRWLOCK) rwlock);
138 | }
139 |
140 | #else
141 |
142 | size_t janet_os_mutex_size(void) {
143 | return sizeof(pthread_mutex_t);
144 | }
145 |
146 | size_t janet_os_rwlock_size(void) {
147 | return sizeof(pthread_rwlock_t);
148 | }
149 |
150 | void janet_os_mutex_init(JanetOSMutex *mutex) {
151 | pthread_mutexattr_t attr;
152 | pthread_mutexattr_init(&attr);
153 | pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
154 | pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
155 | }
156 |
157 | void janet_os_mutex_deinit(JanetOSMutex *mutex) {
158 | pthread_mutex_destroy((pthread_mutex_t *) mutex);
159 | }
160 |
161 | void janet_os_mutex_lock(JanetOSMutex *mutex) {
162 | pthread_mutex_lock((pthread_mutex_t *) mutex);
163 | }
164 |
165 | void janet_os_mutex_unlock(JanetOSMutex *mutex) {
166 | int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
167 | if (ret) janet_panic("cannot release lock");
168 | }
169 |
170 | void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
171 | pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
172 | }
173 |
174 | void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
175 | pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
176 | }
177 |
178 | void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
179 | pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
180 | }
181 |
182 | void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
183 | pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
184 | }
185 |
186 | void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
187 | pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
188 | }
189 |
190 | void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
191 | pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
192 | }
193 |
194 | #endif
195 |
196 | int32_t janet_abstract_incref(void *abst) {
197 | return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
198 | }
199 |
200 | int32_t janet_abstract_decref(void *abst) {
201 | return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
202 | }
203 |
204 | #endif
205 |
--------------------------------------------------------------------------------