Merge pull request #726 from hellerve/veit/longs

Long type to ensure longs are actually 64 bits

core/Long.carp

@@ -27,9 +27,11 @@
 to non-refs.")
   (register copy (λ [&Long] Long))
 
-  (register safe-add (λ [Long Long (Ref Long)] Bool))
-  (register safe-sub (λ [Long Long (Ref Long)] Bool))
-  (register safe-mul (λ [Long Long (Ref Long)] Bool))
+  (not-on-windows ; this seems to generate invalid code on some windows machines
+    (register safe-add (λ [Long Long (Ref Long)] Bool))
+    (register safe-sub (λ [Long Long (Ref Long)] Bool))
+    (register safe-mul (λ [Long Long (Ref Long)] Bool))
+  )
 
   (register abs (λ [Long] Long))
 

core/SafeInt.carp

@@ -1,10 +1,12 @@
 (system-include "carp_safe_int.h")
 
 (defmodule Int
-  (doc safe-add "Performs an addition and checks whether it overflowed.")
-  (register safe-add (λ [Int Int (Ref Int)] Bool))
-  (doc safe-sub "Performs an substraction and checks whether it overflowed.")
-  (register safe-sub (λ [Int Int (Ref Int)] Bool))
-  (doc safe-mul "Performs an multiplication and checks whether it overflowed.")
-  (register safe-mul (λ [Int Int (Ref Int)] Bool))
+  (not-on-windows ; this seems to generate invalid code on some windows machines
+    (doc safe-add "Performs an addition and checks whether it overflowed.")
+    (register safe-add (λ [Int Int (Ref Int)] Bool))
+    (doc safe-sub "Performs an substraction and checks whether it overflowed.")
+    (register safe-sub (λ [Int Int (Ref Int)] Bool))
+    (doc safe-mul "Performs an multiplication and checks whether it overflowed.")
+    (register safe-mul (λ [Int Int (Ref Int)] Bool))
+  )
 )

core/carp_binary.h

@@ -10,9 +10,9 @@ uint32_t Binary_to_MINUS_int32(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4) {
 
 uint64_t Binary_to_MINUS_int64(uint8_t b1, uint8_t b2, uint8_t b3, uint8_t b4,
                                uint8_t b5, uint8_t b6, uint8_t b7, uint8_t b8) {
-    return (uint64_t)b1 | (b2 << 8) | (b3 << 16) | (b4 << 24) |
-           ((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) | ((uint64_t)b7 << 48) |
-           ((uint64_t)b8 << 56);
+    return (uint64_t)b1 | ((uint64_t)b2 << 8) | ((uint64_t)b3 << 16) |
+           ((uint64_t)b4 << 24) | ((uint64_t)b5 << 32) | ((uint64_t)b6 << 40) |
+           ((uint64_t)b7 << 48) | ((uint64_t)b8 << 56);
 }
 
 uint8_t Binary_int16_MINUS_to_MINUS_byte(uint16_t *x) {

core/carp_double.h

@@ -38,8 +38,8 @@ double Double_from_MINUS_int(int x) {
     return (double)x;
 }
 
-long Double_to_MINUS_bytes(double x) {
-    long y;
+Long Double_to_MINUS_bytes(double x) {
+    Long y;
     memcpy(&y, &x, sizeof(double));
     return y;
 }
@@ -52,11 +52,11 @@ double Double_from_MINUS_float(float x) {
     return (double)x;
 }
 
-long Double_to_MINUS_long(double x) {
-    return (long)x;
+Long Double_to_MINUS_long(double x) {
+    return (Long)x;
 }
 
-double Double_from_MINUS_long(long x) {
+double Double_from_MINUS_long(Long x) {
     return (double)x;
 }
 

core/carp_io.h

@@ -75,7 +75,7 @@ String IO_get_MINUS_line() {
 
 String IO_read_MINUS_file(const String *filename) {
     String buffer = 0;
-    long length;
+    Long length;
     FILE *f = fopen(*filename, "rb");
 
     if (f) {

core/carp_long.h

@@ -1,87 +1,87 @@
-long Long__PLUS_(long x, long y) {
+Long Long__PLUS_(Long x, Long y) {
     return x + y;
 }
-long Long__MINUS_(long x, long y) {
+Long Long__MINUS_(Long x, Long y) {
     return x - y;
 }
-long Long__MUL_(long x, long y) {
+Long Long__MUL_(Long x, Long y) {
     return x * y;
 }
-long Long__DIV_(long x, long y) {
+Long Long__DIV_(Long x, Long y) {
     return x / y;
 }
 #ifndef _WIN32
-bool Long_safe_MINUS_add(long x, long y, long* res) {
-    return __builtin_saddl_overflow(x, y, res);
+bool Long_safe_MINUS_add(Long x, Long y, Long* res) {
+    return __builtin_add_overflow(x, y, res);
 }
-bool Long_safe_MINUS_sub(long x, long y, long* res) {
-    return __builtin_ssubl_overflow(x, y, res);
+bool Long_safe_MINUS_sub(Long x, Long y, Long* res) {
+    return __builtin_sub_overflow(x, y, res);
 }
-bool Long_safe_MINUS_mul(long x, long y, long* res) {
-    return __builtin_smull_overflow(x, y, res);
+bool Long_safe_MINUS_mul(Long x, Long y, Long* res) {
+    return __builtin_mul_overflow(x, y, res);
 }
 #endif
-bool Long__EQ_(long x, long y) {
+bool Long__EQ_(Long x, Long y) {
     return x == y;
 }
-bool Long__LT_(long x, long y) {
+bool Long__LT_(Long x, Long y) {
     return x < y;
 }
-bool Long__GT_(long x, long y) {
+bool Long__GT_(Long x, Long y) {
     return x > y;
 }
-long Long_neg(long x) {
+Long Long_neg(Long x) {
     return -x;
 }
 
-long Long_inc(long x) {
+Long Long_inc(Long x) {
     return x + 1;
 }
-long Long_dec(long x) {
+Long Long_dec(Long x) {
     return x - 1;
 }
-long Long_abs(long x) {
+Long Long_abs(Long x) {
     return x > 0 ? x : -x;
 }
-long Long_bit_MINUS_shift_MINUS_left(long x, long y) {
+Long Long_bit_MINUS_shift_MINUS_left(Long x, Long y) {
     return x << y;
 }
-long Long_bit_MINUS_shift_MINUS_right(long x, long y) {
+Long Long_bit_MINUS_shift_MINUS_right(Long x, Long y) {
     return x >> y;
 }
-long Long_bit_MINUS_and(long x, long y) {
+Long Long_bit_MINUS_and(Long x, Long y) {
     return x & y;
 }
-long Long_bit_MINUS_or(long x, long y) {
+Long Long_bit_MINUS_or(Long x, Long y) {
     return x | y;
 }
-long Long_bit_MINUS_xor(long x, long y) {
+Long Long_bit_MINUS_xor(Long x, Long y) {
     return x ^ y;
 }
-long Long_bit_MINUS_not(long x) {
+Long Long_bit_MINUS_not(Long x) {
     return ~x;
 }
 
-long Long_copy(const long* x) {
+Long Long_copy(const Long* x) {
     return *x;
 }
 
-long Long_mod(long x, long divider) {
+Long Long_mod(Long x, Long divider) {
     return x % divider;
 }
 
-void Long_seed(long seed) {
+void Long_seed(Long seed) {
     srand(seed);
 }
 
-bool Long_mask(long a, long b) {
+bool Long_mask(Long a, Long b) {
     return a & b;
 }
 
-int Long_to_MINUS_int(long a) {
+int Long_to_MINUS_int(Long a) {
     return (int)a;
 }
 
-long Long_from_MINUS_int(int a) {
-    return (long)a;
+Long Long_from_MINUS_int(int a) {
+    return (Long)a;
 }

core/carp_memory.h

@@ -1,12 +1,12 @@
 #ifdef LOG_MEMORY
 
-long malloc_balance_counter = 0;
+Long malloc_balance_counter = 0;
 bool log_memory_balance = false;
 
 void *logged_malloc(size_t size) {
     void *ptr = malloc(size);
     if (log_memory_balance) {
-        printf("MALLOC: %p (%ld bytes)\n", ptr, size);
+        printf("MALLOC: %p (%zu bytes)\n", ptr, size);
     }
     malloc_balance_counter++;
     return ptr;
@@ -35,7 +35,7 @@ void Debug_log_MINUS_memory_MINUS_balance_BANG_(bool value) {
 #define CARP_FREE(ptr) logged_free(ptr)
 #define CARP_REALLOC(ptr, size) realloc(ptr, size)
 
-long Debug_memory_MINUS_balance() {
+Long Debug_memory_MINUS_balance() {
     return malloc_balance_counter;
 }
 
@@ -63,7 +63,7 @@ void* CARP_REALLOC(void* ptr, size_t size) {
 
 #define CARP_FREE(ptr) free(ptr)
 
-long Debug_memory_MINUS_balance() {
+Long Debug_memory_MINUS_balance() {
     printf(
         "Error - calling 'memory-balance' without compiling with LOG_MEMORY "
         "enabled (--log-memory).\n");

core/carp_safe_int.h

@@ -1,9 +1,11 @@
+#ifndef _WIN32
 bool Int_safe_MINUS_add(int x, int y, int* res) {
-    return __builtin_sadd_overflow(x, y, res);
+    return __builtin_add_overflow(x, y, res);
 }
 bool Int_safe_MINUS_sub(int x, int y, int* res) {
-    return __builtin_ssub_overflow(x, y, res);
+    return __builtin_sub_overflow(x, y, res);
 }
 bool Int_safe_MINUS_mul(int x, int y, int* res) {
-    return __builtin_smul_overflow(x, y, res);
+    return __builtin_mul_overflow(x, y, res);
 }
+#endif

core/carp_stdint.h

@@ -52,10 +52,10 @@ String Uint8_str(Uint8 x) {
     snprintf(buffer, size, "Uint8(%" PRIu8 ")", x);
     return buffer;
 }
-Uint8 Uint8_from_MINUS_long(long x) {
+Uint8 Uint8_from_MINUS_long(Long x) {
     return (Uint8)x;
 }
-long Uint8_to_MINUS_long(Uint8 x) {
+Long Uint8_to_MINUS_long(Uint8 x) {
     return (long)x;
 }
 Uint8 Uint8_copy(Uint8* x) {
@@ -119,10 +119,10 @@ String Uint16_str(Uint16 x) {
     snprintf(buffer, size, "Uint16(%" PRIu16 ")", x);
     return buffer;
 }
-Uint16 Uint16_from_MINUS_long(long x) {
+Uint16 Uint16_from_MINUS_long(Long x) {
     return (Uint16)x;
 }
-long Uint16_to_MINUS_long(Uint16 x) {
+Long Uint16_to_MINUS_long(Uint16 x) {
     return (long)x;
 }
 Uint16 Uint16_copy(Uint16* x) {
@@ -186,10 +186,10 @@ String Uint32_str(Uint32 x) {
     snprintf(buffer, size, "Uint32(%" PRIu32 ")", x);
     return buffer;
 }
-Uint32 Uint32_from_MINUS_long(long x) {
+Uint32 Uint32_from_MINUS_long(Long x) {
     return (Uint32)x;
 }
-long Uint32_to_MINUS_long(Uint32 x) {
+Long Uint32_to_MINUS_long(Uint32 x) {
     return (long)x;
 }
 Uint32 Uint32_copy(Uint32* x) {
@@ -253,10 +253,10 @@ String Uint64_str(Uint64 x) {
     snprintf(buffer, size, "Uint64(%" PRIu64 ")", x);
     return buffer;
 }
-Uint64 Uint64_from_MINUS_long(long x) {
+Uint64 Uint64_from_MINUS_long(Long x) {
     return (Uint64)x;
 }
-long Uint64_to_MINUS_long(Uint64 x) {
+Long Uint64_to_MINUS_long(Uint64 x) {
     return (long)x;
 }
 Uint64 Uint64_copy(Uint64* x) {
@@ -320,10 +320,10 @@ String Int8_str(Int8 x) {
     snprintf(buffer, size, "Int8(%" PRId8 ")", x);
     return buffer;
 }
-Int8 Int8_from_MINUS_long(long x) {
+Int8 Int8_from_MINUS_long(Long x) {
     return (Int8)x;
 }
-long Int8_to_MINUS_long(Int8 x) {
+Long Int8_to_MINUS_long(Int8 x) {
     return (long)x;
 }
 Int8 Int8_copy(Int8* x) {
@@ -387,10 +387,10 @@ String Int16_str(Int16 x) {
     snprintf(buffer, size, "Int16(%" PRId16 ")", x);
     return buffer;
 }
-Int16 Int16_from_MINUS_long(long x) {
+Int16 Int16_from_MINUS_long(Long x) {
     return (Int16)x;
 }
-long Int16_to_MINUS_long(Int16 x) {
+Long Int16_to_MINUS_long(Int16 x) {
     return (long)x;
 }
 Int16 Int16_copy(Int16* x) {
@@ -454,10 +454,10 @@ String Int32_str(Int32 x) {
     snprintf(buffer, size, "Int32(%" PRId32 ")", x);
     return buffer;
 }
-Int32 Int32_from_MINUS_long(long x) {
+Int32 Int32_from_MINUS_long(Long x) {
     return (Int32)x;
 }
-long Int32_to_MINUS_long(Int32 x) {
+Long Int32_to_MINUS_long(Int32 x) {
     return (long)x;
 }
 Int32 Int32_copy(Int32* x) {
@@ -521,11 +521,11 @@ String Int64_str(Int64 x) {
     snprintf(buffer, size, "Int64(%" PRId64 ")", x);
     return buffer;
 }
-Int64 Int64_from_MINUS_long(long x) {
+Int64 Int64_from_MINUS_long(Long x) {
     return (Int64)x;
 }
-long Int64_to_MINUS_long(Int64 x) {
-    return (long)x;
+Long Int64_to_MINUS_long(Int64 x) {
+    return (Long)x;
 }
 Int64 Int64_copy(Int64* x) {
     return *x;

core/carp_string.h

@@ -239,21 +239,21 @@ int Int_from_MINUS_string(const String *s) {
     return atoi(*s);
 }
 
-String Long_str(long x) {
-    int size = snprintf(NULL, 0, "%ldl", x) + 1;
+String Long_str(Long x) {
+    int size = snprintf(NULL, 0, "%" PRIi64, x) + 1;
     String buffer = CARP_MALLOC(size);
-    sprintf(buffer, "%ldl", x);
+    sprintf(buffer, "%" PRIi64, x);
     return buffer;
 }
 
-String Long_format(const String *str, long x) {
+String Long_format(const String *str, Long x) {
     int size = snprintf(NULL, 0, *str, x) + 1;
     String buffer = CARP_MALLOC(size);
     sprintf(buffer, *str, x);
     return buffer;
 }
 
-long Long_from_MINUS_string(const String *s) {
+Long Long_from_MINUS_string(const String *s) {
     return atol(*s);
 }
 

core/core.h

@@ -7,21 +7,17 @@ typedef SSIZE_T ssize_t;
 #ifndef _WIN32
 #include <unistd.h>
 #endif
+#include <inttypes.h>
 
 typedef char *String;
 typedef char *Pattern;
+typedef int64_t Long;
 
 #if defined NDEBUG
 #define CHK_INDEX(i, n)
 #else
 
-#if defined(WIN32) || defined(_WIN32) || \
-    defined(__WIN32) && !defined(__CYGWIN__)
-// The %zd format flag doesn't seem to work on Windows?
-#define CHK_INDEX_FORMAT_STRING ":%u: bad index: %ld < %ld\n"
-#else
 #define CHK_INDEX_FORMAT_STRING ":%u: bad index: %zd < %zd\n"
-#endif
 
 #define CHK_INDEX(i, n)                                                    \
     do {                                                                   \

run_carp_tests.ps1

@@ -32,7 +32,6 @@ exitOnError { stack exec carp "--" ./examples/check_malloc.carp -b }
 
 # Generate docs
 exitOnError { stack exec carp "--" ./docs/core/generate_core_docs.carp }
-exitOnError { stack exec carp "--" ./docs/sdl/generate_sdl_docs.carp }
 
 echo "ALL TESTS DONE."
 

src/StartingEnv.hs

@@ -113,7 +113,7 @@ templatePointerAdd = defineTemplate
   (SymPath ["Pointer"] "add")
   (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "adds a long integer value to a pointer."
-  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate "$p* $NAME ($p *p, Long x)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return p + x;"
                         ,"}"])
@@ -123,7 +123,7 @@ templatePointerSub = defineTemplate
   (SymPath ["Pointer"] "sub")
   (FuncTy [PointerTy (VarTy "p"), LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "subtracts a long integer value from a pointer."
-  (toTemplate "$p* $NAME ($p *p, long x)")
+  (toTemplate "$p* $NAME ($p *p, Long x)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return p - x;"
                         ,"}"])
@@ -133,7 +133,7 @@ templatePointerWidth = defineTemplate
   (SymPath ["Pointer"] "width")
   (FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
   "gets the byte size of a pointer."
-  (toTemplate "long $NAME ($p *p)")
+  (toTemplate "Long $NAME ($p *p)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return sizeof(*p);"
                         ,"}"])
@@ -143,9 +143,9 @@ templatePointerToLong = defineTemplate
   (SymPath ["Pointer"] "to-long")
   (FuncTy [PointerTy (VarTy "p")] LongTy StaticLifetimeTy)
   "converts a pointer to a long integer."
-  (toTemplate "long $NAME ($p *p)")
+  (toTemplate "Long $NAME ($p *p)")
   (toTemplate $ unlines ["$DECL {"
-                        ,"    return (long)p;"
+                        ,"    return (Long)p;"
                         ,"}"])
   (const [])
 
@@ -153,7 +153,7 @@ templatePointerFromLong = defineTemplate
   (SymPath ["Pointer"] "from-long")
   (FuncTy [LongTy] (PointerTy (VarTy "p")) StaticLifetimeTy)
   "converts a long integer to a pointer."
-  (toTemplate "$p* $NAME (long p)")
+  (toTemplate "$p* $NAME (Long p)")
   (toTemplate $ unlines ["$DECL {"
                         ,"    return ($p*)p;"
                         ,"}"])

src/Types.hs

@@ -124,7 +124,7 @@ tyToCManglePtr _ IntTy                   = "int"
 tyToCManglePtr _ BoolTy                  = "bool"
 tyToCManglePtr _ FloatTy                 = "float"
 tyToCManglePtr _ DoubleTy                = "double"
-tyToCManglePtr _ LongTy                  = "long"
+tyToCManglePtr _ LongTy                  = "Long"
 tyToCManglePtr _ ByteTy                  = "uint8_t"
 tyToCManglePtr _ StringTy                = "String"
 tyToCManglePtr _ PatternTy               = "Pattern"

test/safe_arithmetic.carp

@@ -1,3 +1,6 @@
+(windows-only ; safe arithmetic does not currently work on windows
+  (quit))
+
 (load "Test.carp")
 (load "SafeInt.carp")