[RefC] Unbox small integers. (#3181)

CHANGELOG_NEXT.md

@@ -33,14 +33,6 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO
 * Elaborator scripts were made to be able to access the visibility modifier of a
   definition, via `getVis`.
 
-### Backend changes
-
-#### RefC
-
-* Compiler can emit precise reference counting instructions where a reference
-  is dropped as soon as possible. This allows you to reuse unique variables and
-  optimize memory consumption.
-
 ### Compiler changes
 
 * The compiler now differentiates between "package search path" and "package
@@ -51,8 +43,14 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO
   environment variable adds to the "Package Search Paths." Functionally this is
   not a breaking change.
 
+### Backend changes
+
 #### RefC Backend
 
+* Compiler can emit precise reference counting instructions where a reference
+  is dropped as soon as possible. This allows you to reuse unique variables and
+  optimize memory consumption.
+
 * Fix invalid memory read onf strSubStr.
 
 * Fix memory leaks of IORef. Now that IORef holds values by itself,
@@ -67,6 +65,13 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO
 * Special constructors such as Nil and Nothing were eliminated and assigned to
   NULL.
 
+* Unbox Bits32,Bits16,Bits8,Int32,Int16,Int8. These types are now packed into
+  Value*. Now, RefC backend requires at least 32 bits for pointers.
+  16-bit CPUs are no longer supported. And we expect the address returned by
+  malloc to be aligned with at least 32 bits. Otherwise it cause a runtime error.
+
+* Rename C function to avoid confliction. But only a part.
+
 #### NodeJS Backend
 
 * The NodeJS executable output to `build/exec/` now has its executable bit set.

config.mk

@@ -11,7 +11,7 @@ OLD_WIN ?= 0
 RANLIB ?= ranlib
 AR ?= ar
 
-CFLAGS := -Wall $(CFLAGS)
+CFLAGS += -Wall
 CPPFLAGS := $(CPPFLAGS)
 LDFLAGS := $(LDFLAGS)
 

src/Compiler/ANF.idr

@@ -291,7 +291,7 @@ freeVariables (AApp _ _ closure arg) = fromList [closure, arg]
 freeVariables (ALet _ var value body) =
     union (freeVariables value) (delete (ALocal var) $ freeVariables body)
 freeVariables (ACon _ _ _ _ args) = fromList args
-freeVariables (AOp _ _ _ args) = fromList $ foldl (\acc, elem => elem :: acc) [] args
+freeVariables (AOp _ _ _ args) = fromList $ toList args
 freeVariables (AExtPrim _ _ _ args) = fromList args
 freeVariables (AConCase _ sc alts mDef) =
     let altsAnf =

support/c/idris_file.c

@@ -211,11 +211,13 @@ struct filetime *idris2_fileTime(FILE *f) {
   ft->mtime_sec = buf.st_mtime;
   ft->ctime_sec = buf.st_ctime;
 
-#if defined(__MACH__) || defined(__APPLE__)
+#if defined(_DARWIN_C_SOURCE) ||                                               \
+    (!defined(_POSIX_C_SOURCE) && (defined(__MACH__) || defined(__APPLE__)))
   ft->atime_nsec = buf.st_atimespec.tv_nsec;
   ft->mtime_nsec = buf.st_mtimespec.tv_nsec;
   ft->ctime_nsec = buf.st_ctimespec.tv_nsec;
-#elif (_POSIX_VERSION >= 200809L) || defined(__FreeBSD__)
+#elif (defined(_POSIX_VERSION) && _POSIX_VERSION >= 200809L) ||                \
+    defined(__FreeBSD__)
   ft->atime_nsec = buf.st_atim.tv_nsec;
   ft->mtime_nsec = buf.st_mtim.tv_nsec;
   ft->ctime_nsec = buf.st_ctim.tv_nsec;

support/c/idris_support.c

@@ -11,6 +11,11 @@
 #include <time.h>
 #include <unistd.h>
 
+#if !defined(_SC_NPROCESSORS_ONLN) && defined(_DARWIN_C_SOURCE)
+#include <sys/sysctl.h>
+#include <sys/types.h>
+#endif
+
 int _argc;
 char **_argv;
 
@@ -149,9 +154,25 @@ int idris2_getPID() {
 
 // get the number of processors configured
 long idris2_getNProcessors() {
-#ifdef _WIN32
+#if defined(_WIN32)
   return win32_getNProcessors();
-#else
+#elif defined(_POSIX_VERSION) && _POSIX_VERSION >= 200112L &&                  \
+    defined(_SC_NPROCESSORS_ONLN)
+  // Note: Under MacOS with _POSIX_C_SOURCE, _SC_NPROCESSORS_ONLN never defined.
   return sysconf(_SC_NPROCESSORS_ONLN);
+#elif defined(_DARWIN_C_SOURCE) || defined(_BSD_SOURCE)
+  // Generic way for BSD style system.
+
+#if defined(_DARWIN_C_SOURCE)
+  int xs[] = {CTL_HW, HW_LOGICALCPU};
+#else
+  int xs[] = {CTL_HW, HW_NCPU};
+#endif
+
+  int numcpus = 1;
+  size_t n = sizeof(numcpus);
+  return sysctll(xs, 2, &numcpus, &len, NULL, 0) < 0 ? 1 : numcpus;
+#else
+  return 1
 #endif
 }

support/refc/_datatypes.h

@@ -10,17 +10,12 @@
 #include "buffer.h"
 
 #define NO_TAG 0
-#define BITS8_TAG 1
-#define BITS16_TAG 2
 #define BITS32_TAG 3
 #define BITS64_TAG 4
-#define INT8_TAG 5
-#define INT16_TAG 6
 #define INT32_TAG 7
 #define INT64_TAG 8
 #define INTEGER_TAG 9
 #define DOUBLE_TAG 10
-#define CHAR_TAG 11
 #define STRING_TAG 12
 
 #define CLOSURE_TAG 15
@@ -50,15 +45,58 @@ typedef struct {
   // followed by type-specific payload.
 } Value;
 
-typedef struct {
-  Value_header header;
-  uint8_t ui8;
-} Value_Bits8;
-
-typedef struct {
-  Value_header header;
-  uint16_t ui16;
-} Value_Bits16;
+/*
+We expect at least 4 bytes for `Value_header` alignment, to use bit0 and bit1 of
+pointer as flags.
+
+RefC does not have complete static tracking of type information, so types are
+identified at runtime using Value_Header's tag field. However, Int that are
+pretending to be pointers cannot have that tag, so use that flag to identify
+them first. Of course, this flag is not used if it is clear that Value* is
+actually an Int. But places like newReference/removeReference require this flag.
+ */
+#define idris2_vp_is_unboxed(p) ((uintptr_t)(p)&3)
+
+#define idris2_vp_int_shift                                                    \
+  ((sizeof(uintptr_t) >= 8 && sizeof(Value *) >= 8) ? 32 : 16)
+
+#define idris2_vp_to_Bits64(p) (((Value_Bits64 *)(p))->ui64)
+
+#if !defined(UINTPTR_WIDTH)
+#define idris2_vp_to_Bits32(p)                                                 \
+  ((idris2_vp_int_shift == 16)                                                 \
+       ? (((Value_Bits32 *)(p))->ui32)                                         \
+       : ((uint32_t)((uintptr_t)(p) >> idris2_vp_int_shift)))
+#define idris2_vp_to_Int32(p)                                                  \
+  ((idris2_vp_int_shift == 16)                                                 \
+       ? (((Value_Int32 *)(p))->i32)                                           \
+       : ((int32_t)((uintptr_t)(p) >> idris2_vp_int_shift)))
+
+#elif UINTPTR_WIDTH >= 64
+// NOTE: We stole two bits from pointer. So, even if we have 64-bit CPU,
+//  Int64/Bits654 are not unboxable.
+#define idris2_vp_to_Bits32(p)                                                 \
+  ((uint32_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Int32(p) ((int32_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+
+#elif UINTPTR_WIDTH >= 32
+#define idris2_vp_to_Bits32(p) (((Value_Bits32 *)(p))->ui32)
+#define idris2_vp_to_Int32(p) (((Value_Int32 *)(p))->i32)
+
+#else
+#error "unsupported uintptr_t width"
+#endif
+
+#define idris2_vp_to_Bits16(p)                                                 \
+  ((uint16_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Bits8(p) ((uint8_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Int64(p) (((Value_Int64 *)(p))->i64)
+#define idris2_vp_to_Int16(p) ((int16_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Int8(p) ((int8_t)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Char(p)                                                   \
+  ((unsigned char)((uintptr_t)(p) >> idris2_vp_int_shift))
+#define idris2_vp_to_Double(p) (((Value_Double *)(p))->d)
+#define idris2_vp_to_Bool(p) (idris2_vp_to_Int8(p))
 
 typedef struct {
   Value_header header;
@@ -70,16 +108,6 @@ typedef struct {
   uint64_t ui64;
 } Value_Bits64;
 
-typedef struct {
-  Value_header header;
-  int8_t i8;
-} Value_Int8;
-
-typedef struct {
-  Value_header header;
-  int16_t i16;
-} Value_Int16;
-
 typedef struct {
   Value_header header;
   int32_t i32;
@@ -100,11 +128,6 @@ typedef struct {
   double d;
 } Value_Double;
 
-typedef struct {
-  Value_header header;
-  unsigned char c;
-} Value_Char;
-
 typedef struct {
   Value_header header;
   char *str;