Squashed commit of the following:

commit fbb0711ae1
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 12:07:55 2023 -0500

    Distinguish between subprocess when testing.

commit 676b233566
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:59:17 2023 -0500

    Hack for qemu based testing (also should work with valgrind)

commit d7431c7cdb
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:54:04 2023 -0500

    Revert "Test removing 32bit ptr marshalling."

    This reverts commit 566b45ea44.

commit 566b45ea44
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:52:22 2023 -0500

    Test removing 32bit ptr marshalling.

commit ff2f71d2bc
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:42:10 2023 -0500

    Conditionally compile marshal_ptr code.

commit bd420aeb0e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:38:34 2023 -0500

    Add range checking to bit-shift code to prevent undefined behavior.

commit b738319f8d
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:17:30 2023 -0500

    Remove range check on 32 bit arch since it will always pass.

commit 7248626235
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:56:45 2023 -0500

    Quiet some build warnings.

commit 141c1de946
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:50:13 2023 -0500

    Add marshal utilities for pointers.

commit c2d77d6720
Merge: 677b8a6f ff90b81e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:40:35 2023 -0500

    Merge branch 'master' into armtest

commit 677b8a6f32
Author: Ico Doornekamp <ico@zevv.nl>
Date:   Mon Jun 12 21:01:26 2023 +0200

    Added ARM32 test

.github/workflows/test.yml

@@ -74,3 +74,18 @@ jobs:
         run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
       - name: Test the project
         run: make test UNAME=MINGW RUN=wine
+
+  test-arm-linux:
+    name: Build and test ARM32 cross compilation
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup qemu and cross compiler
+        run: |
+          sudo apt-get update
+          sudo apt-get install gcc-arm-linux-gnueabi qemu-user
+      - name: Compile the project
+        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc 
+      - name: Test the project
+        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test

src/core/ev.c

@@ -401,7 +401,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
     }
     janet_marshal_abstract(ctx, p);
     janet_marshal_int(ctx, (int32_t) s->flags);
-    janet_marshal_int64(ctx, (intptr_t) s->methods);
+    janet_marshal_ptr(ctx, s->methods);
 #ifdef JANET_WINDOWS
     /* TODO - ref counting to avoid situation where a handle is closed or GCed
      * while in transit, and it's value gets reused. DuplicateHandle does not work
@@ -438,7 +438,7 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
     p->_mask = 0;
     p->state = NULL;
     p->flags = (uint32_t) janet_unmarshal_int(ctx);
-    p->methods = (void *) janet_unmarshal_int64(ctx);
+    p->methods =  janet_unmarshal_ptr(ctx);
 #ifdef JANET_WINDOWS
     p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
 #else

src/core/marsh.c

@@ -362,6 +362,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
     pushint(st, value);
 }
 
+/* Only use in unsafe - don't marshal pointers otherwise */
+void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
+#ifdef JANET_32
+    janet_marshal_int(ctx, (intptr_t) ptr);
+#else
+    janet_marshal_int64(ctx, (intptr_t) ptr);
+#endif
+}
+
 void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
     MarshalState *st = (MarshalState *)(ctx->m_state);
     pushbyte(st, value);
@@ -1165,6 +1174,15 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
     return read64(st, &(ctx->data));
 }
 
+void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
+    UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
+#ifdef JANET_32
+    return (void *) ((intptr_t) readint(st, &(ctx->data)));
+#else
+    return (void *) ((intptr_t) read64(st, &(ctx->data)));
+#endif
+}
+
 uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
     UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
     MARSH_EOS(st, ctx->data);

src/core/specials.c

@@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
 
     if (has_drop && can_destructure_lhs && rhs_is_indexed) {
         /* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
-        JanetView view_lhs, view_rhs;
+        JanetView view_lhs = {0};
+        JanetView view_rhs = {0};
         janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
         janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
         int found_amp = 0;

src/core/value.c

@@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) {
             const JanetAbstractType *type = janet_abstract_type(abst);
             if (type->length != NULL) {
                 size_t len = type->length(abst, janet_abstract_size(abst));
-                if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
+                /* If len is always less then double, we can never overflow */
-                    return janet_wrap_number((double) len);
+#ifdef JANET_32
+                return janet_wrap_number(len);
+#else
+                if (len < (size_t) JANET_INTMAX_INT64) {
+                    return janet_wrap_number(len);
                 } else {
                     janet_panicf("integer length %u too large", len);
                 }
+#endif
             }
             Janet argv[1] = { x };
             return janet_mcall("length", 1, argv);

src/core/vm.c

@@ -138,7 +138,7 @@
             vm_pcnext();\
         }\
     }
-#define _vm_bitop_immediate(op, type1)\
+#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         if (!janet_checktype(op1, JANET_NUMBER)) {\
@@ -147,13 +147,15 @@
             stack[A] = janet_mcall(#op, 2, _argv);\
             vm_checkgc_pcnext();\
         } else {\
-            type1 x1 = (type1) janet_unwrap_number(op1);\
+            double y1 = janet_unwrap_number(op1);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            type1 x1 = (type1) y1;\
             stack[A] = janet_wrap_number((type1) (x1 op CS));\
             vm_pcnext();\
         }\
     }
-#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
+#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
-#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
+#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
 #define _vm_binop(op, wrap)\
     {\
         Janet op1 = stack[B];\
@@ -170,13 +172,17 @@
         }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
-#define _vm_bitop(op, type1)\
+#define _vm_bitop(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-            type1 x1 = (type1) janet_unwrap_number(op1);\
+            double y1 = janet_unwrap_number(op1);\
-            int32_t x2 = janet_unwrap_integer(op2);\
+            double y2 = janet_unwrap_number(op2);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
+            type1 x1 = (type1) y1;\
+            int32_t x2 = (int32_t) y2;\
             stack[A] = janet_wrap_number((type1) (x1 op x2));\
             vm_pcnext();\
         } else {\
@@ -185,8 +191,8 @@
             vm_checkgc_pcnext();\
         }\
     }
-#define vm_bitop(op) _vm_bitop(op, int32_t)
+#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
-#define vm_bitopu(op) _vm_bitop(op, uint32_t)
+#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
 #define vm_compop(op) \
     {\
         Janet op1 = stack[B];\

src/include/janet.h

@@ -2053,6 +2053,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
 JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
 JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
 JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
+JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
 JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
 JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
 JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
@@ -2062,6 +2063,7 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
 JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
 JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
 JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
+JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
 JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
 JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
 JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);

test/suite-corelib.janet

@@ -30,10 +30,12 @@
 (assert (= 1 (brshift 4 2)) "right shift")
 # unsigned shift
 (assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
-(assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2")
+(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
+(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
 # non-immediate forms
 (assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
-(assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate")
+(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
+(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
 (assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
 # 7e46ead
 (assert (< 1 2 3 4 5 6) "less than integers")

test/suite-ev.janet

@@ -25,38 +25,41 @@
 # 5e1a8c86f
 (def janet (dyn :executable))
 
+# Subprocess should inherit the "RUN" parameter for fancy testing
+(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
+
 (repeat 10
 
-  (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
     (os/proc-wait p)
     (def x (:read (p :out) :all))
     (assert (deep= "hello" (string/trim x))
             "capture stdout from os/spawn pre close."))
 
-  (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
+  (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
     (def x (:read (p :out) 1024))
     (os/proc-wait p)
     (assert (deep= "hello" (string/trim x))
             "capture stdout from os/spawn post close."))
 
-  (let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px
+  (let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
                     {:in :pipe})]
     (:write (p :in) "hello!\n")
     (assert-no-error "pipe stdin to process" (os/proc-wait p))))
 
-(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px
+(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
                   {:in :pipe :out :pipe})]
   (:write (p :in) "hello!\n")
   (def x (:read (p :out) 1024))
   (assert-no-error "pipe stdin to process 2" (os/proc-wait p))
   (assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
 
-(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
+(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
   (os/proc-kill p)
   (def retval (os/proc-wait p))
   (assert (not= retval 24) "Process was *not* terminated by parent"))
 
-(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
+(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
   (os/proc-kill p false :term)
   (def retval (os/proc-wait p))
   (assert (not= retval 24) "Process was *not* terminated by parent"))
@@ -66,7 +69,7 @@
 (defn calc-1
   "Run subprocess, read from stdout, then wait on subprocess."
   [code]
-  (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
+  (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
                     {:out :pipe})]
     (os/proc-wait p)
     (def output (:read (p :out) :all))
@@ -86,7 +89,7 @@
   to 10 bytes instead of :all
   ``
   [code]
-  (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
+  (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
                     {:out :pipe})]
     (def output (:read (p :out) 10))
     (os/proc-wait p)
@@ -104,18 +107,18 @@
 # a1cc5ca04
 (assert-no-error "file writing 1"
   (with [f (file/temp)]
-    (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
+    (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
 
 (assert-no-error "file writing 2"
   (with [f (file/open "unique.txt" :w)]
-    (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
+    (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
     (file/flush f)))
 
 # Issue #593
 # a1cc5ca04
 (assert-no-error "file writing 3"
   (def outfile (file/open "unique.txt" :w))
-  (os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
+  (os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
               {:out outfile})
   (file/flush outfile)
   (file/close outfile)
@@ -256,7 +259,7 @@
 (ev/cancel fiber "boop")
 
 # f0dbc2e
-(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
+(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
 
 # Test some channel
 # e76b8da26

test/suite-os.janet

@@ -21,6 +21,9 @@
 (import ./helper :prefix "" :exit true)
 (start-suite)
 
+(def janet (dyn :executable))
+(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
+
 # OS Date test
 # 719f7ba0c
 (assert (deep= {:year-day 0
@@ -118,14 +121,14 @@
 
 # os/execute with environment variables
 # issue #636 - 7e2c433ab
-(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe
+(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
                          (merge (os/environ) {"HELLO" "WORLD"})))
         "os/execute with env")
 
 # os/execute regressions
 # 427f7c362
 (for i 0 10
-  (assert (= i (os/execute [(dyn :executable) "-e"
+  (assert (= i (os/execute [;run janet "-e"
                             (string/format "(os/exit %d)" i)] :p))
           (string "os/execute " i)))
 
@@ -138,7 +141,7 @@
                                "/dev/null"))
                    (os/open path :w))
                  (with [dn (devnull)]
-                   (os/execute [(dyn :executable)
+                   (os/execute [;run janet
                                 "-e"
                                 "(print :foo) (eprint :bar)"]
                                :px