Julia HPC-GAP integration.

lib/info.gi

@@ -327,7 +327,7 @@ end );
 SHOWN_USED_INFO_CLASSES := [];
 
 if IsHPCGAP then
-    ShareInternalObj(INFO_CLASSES);
+    ShareInternalObj(SHOWN_USED_INFO_CLASSES);
 fi;
 
 

lib/oper.g

@@ -1896,8 +1896,6 @@ BIND_GLOBAL( "InstallGlobalFunction", function( arg )
     od;
 end );
 
-if not IsHPCGAP then
-
 BIND_GLOBAL( "FLUSH_ALL_METHOD_CACHES", function()
     local oper,j;
     for oper in OPERATIONS do
@@ -1907,8 +1905,6 @@ BIND_GLOBAL( "FLUSH_ALL_METHOD_CACHES", function()
     od;
 end);
 
-fi;
-
 if BASE_SIZE_METHODS_OPER_ENTRY <> 6 then
     Error("MethodsOperation must be updated for new BASE_SIZE_METHODS_OPER_ENTRY");
 fi;

src/boehm_gc.c

@@ -56,20 +56,6 @@ void MakeBagTypePublic(int type)
     DSInfoBags[type] = DSI_PUBLIC;
 }
 
-Bag MakeBagPublic(Bag bag)
-{
-    MEMBAR_WRITE();
-    SET_REGION(bag, 0);
-    return bag;
-}
-
-Bag MakeBagReadOnly(Bag bag)
-{
-    MEMBAR_WRITE();
-    SET_REGION(bag, ReadOnlyRegion);
-    return bag;
-}
-
 #endif // HPCGAP
 
 
@@ -332,14 +318,6 @@ UInt CollectBags(UInt size, UInt full)
     return 1;
 }
 
-#ifdef HPCGAP
-void RetypeBagIfWritable(Obj obj, UInt new_type)
-{
-    if (CheckWriteAccess(obj))
-        RetypeBag(obj, new_type);
-}
-#endif
-
 void RetypeBag(Bag bag, UInt new_type)
 {
     BagHeader * header = BAG_HEADER(bag);

src/hpc/guards.h

@@ -21,8 +21,10 @@
 
 static ALWAYS_INLINE Bag WriteGuard(Bag bag)
 {
+#ifdef USE_HPC_GUARDS
     if (!WriteCheck(bag))
         HandleWriteGuardError(bag);
+#endif
     return bag;
 }
 
@@ -34,17 +36,22 @@ EXPORT_INLINE Bag ImpliedWriteGuard(Bag bag)
 
 EXPORT_INLINE int CheckWriteAccess(Bag bag)
 {
+#ifdef USE_HPC_GUARDS
     Region * region;
     if (!IS_BAG_REF(bag))
         return 1;
     region = REGION(bag);
     return !(region && region->owner != GetTLS() &&
              region->alt_owner != GetTLS()) ||
            TLS(DisableGuards) >= 2;
+#else
+    return 1;
+#endif
 }
 
 EXPORT_INLINE int CheckExclusiveWriteAccess(Bag bag)
 {
+#ifdef USE_HPC_GUARDS
     Region * region;
     if (!IS_BAG_REF(bag))
         return 1;
@@ -53,12 +60,17 @@ EXPORT_INLINE int CheckExclusiveWriteAccess(Bag bag)
         return 0;
     return region->owner == GetTLS() || region->alt_owner == GetTLS() ||
            TLS(DisableGuards) >= 2;
+#else
+    return 1;
+#endif
 }
 
 static ALWAYS_INLINE Bag ReadGuard(Bag bag)
 {
+#ifdef USE_HPC_GUARDS
     if (!ReadCheck(bag))
         HandleReadGuardError(bag);
+#endif
     return bag;
 }
 
@@ -69,6 +81,7 @@ static ALWAYS_INLINE Bag ImpliedReadGuard(Bag bag)
 
 static ALWAYS_INLINE int CheckReadAccess(Bag bag)
 {
+#ifdef USE_HPC_GUARDS
     Region * region;
     if (!IS_BAG_REF(bag))
         return 1;
@@ -77,6 +90,9 @@ static ALWAYS_INLINE int CheckReadAccess(Bag bag)
              !region->readers[TLS(threadID)] &&
              region->alt_owner != GetTLS()) ||
            TLS(DisableGuards) >= 2;
+#else
+    return 1;
+#endif
 }
 
 #endif    // GAP_HPC_GUARD_H

src/hpc/region.c

@@ -18,7 +18,7 @@
 
 // #include "hpc/misc.h"
 #include "hpc/thread.h"
-// #include "hpc/guards.h"
+#include "hpc/guards.h"
 
 
 #include <pthread.h>
@@ -41,6 +41,10 @@ Region * NewRegion(void)
     result = GC_malloc(sizeof(Region) + (MAX_THREADS + 1));
     lock = GC_malloc_atomic(sizeof(*lock));
     GC_register_finalizer(lock, LockFinalizer, NULL, NULL, NULL);
+#elif defined(USE_JULIA_GC)
+    result = AllocateMemoryBlock(sizeof(Region) + (MAX_THREADS + 1));
+    lock = AllocateMemoryBlock(sizeof(*lock));
+    // NYI: finalize locks
 #else
     #error Not yet implemented for this garbage collector
 #endif
@@ -59,3 +63,24 @@ Region * RegionBag(Bag bag)
     MEMBAR_READ();
     return result;
 }
+
+Bag MakeBagPublic(Bag bag)
+{
+    MEMBAR_WRITE();
+    SET_REGION(bag, 0);
+    return bag;
+}
+
+Bag MakeBagReadOnly(Bag bag)
+{
+    MEMBAR_WRITE();
+    SET_REGION(bag, ReadOnlyRegion);
+    return bag;
+}
+
+void RetypeBagIfWritable(Obj obj, UInt new_type)
+{
+    if (CheckWriteAccess(obj))
+        RetypeBag(obj, new_type);
+}
+

src/hpc/thread.c

@@ -36,6 +36,10 @@
 #  define GC_THREADS
 # endif
 # include <gc/gc.h>
+#elif USE_JULIA_GC
+# ifdef HPCGAP
+#  include "julia_gc.h"
+# endif
 #endif
 
 

src/hpc/threadapi.c

@@ -488,6 +488,7 @@ static void ThreadedInterpreter(void * funcargs)
 
 static Obj FuncCreateThread(Obj self, Obj funcargs)
 {
+#ifndef USE_JULIA_GC
     Int  i, n;
     Obj  thread;
     Obj  templist;
@@ -504,6 +505,10 @@ static Obj FuncCreateThread(Obj self, Obj funcargs)
     if (!thread)
         return Fail;
     return thread;
+#else
+    ErrorMayQuit("CreateThread: disabled with Julia GC", 0, 0);
+    return 0; // flow control hint
+#endif
 }
 
 /****************************************************************************
@@ -2371,7 +2376,7 @@ void InitSignals(void)
     timer.it_interval.tv_usec = 10000;
     timer.it_value.tv_sec = 0;
     timer.it_value.tv_usec = 10000;
-    setitimer(ITIMER_VIRTUAL, &timer, NULL);
+    // setitimer(ITIMER_VIRTUAL, &timer, NULL);
 }
 
 static Obj FuncPERIODIC_CHECK(Obj self, Obj count, Obj func)

src/julia_gc.c

@@ -35,6 +35,10 @@
 #include <julia.h>
 #include <julia_gcext.h>
 
+#ifdef HPCGAP
+#include "hpc/thread.h"
+#endif
+
 
 /****************************************************************************
 **
@@ -198,7 +202,6 @@ static size_t          max_pool_obj_size;
 static UInt            YoungRef;
 static int             FullGC;
 
-#if !defined(SCAN_STACK_FOR_MPTRS_ONLY)
 typedef struct {
     void * addr;
     size_t size;
@@ -222,6 +225,9 @@ static inline int CmpMemBlock(MemBlock m1, MemBlock m2)
 
 #include "baltree.h"
 
+static MemBlockTree * gc_roots;
+
+#if !defined(SCAN_STACK_FOR_MPTRS_ONLY)
 static size_t         bigval_startoffset;
 static MemBlockTree * bigvals;
 
@@ -544,6 +550,20 @@ void CHANGED_BAG(Bag bag)
     jl_gc_wb_back(BAG_HEADER(bag));
 }
 
+#ifdef HPCGAP
+static void ScanExtraRoots(MemBlockNode * node)
+{
+    if (node) {
+        ScanExtraRoots(node->left);
+        MemBlock mem = node->item;
+        char *start = mem.addr;
+        char *end = start + mem.size;
+        TryMarkRange(start, end);
+        ScanExtraRoots(node->right);
+    }
+}
+#endif
+
 static void GapRootScanner(int full)
 {
     // Mark our Julia module (this contains references to our custom data
@@ -571,6 +591,10 @@ static void GapRootScanner(int full)
     // The reason is that if Julia is being initialized from GAP, it
     // cannot always reliably find the top of the stack for that task,
     // so we have to fall back to GAP for that.
+#ifdef HPCGAP
+#define IsUsingLibGap() 0
+    ScanExtraRoots(gc_roots->root);
+#endif
     if (!IsUsingLibGap() && JuliaTLS->tid == 0 &&
         JuliaTLS->root_task == task) {
         stackend = (char *)GapStackBottom;
@@ -716,6 +740,7 @@ void InitBags(UInt initial_size, Bag * stack_bottom, UInt stack_align)
     }
     // These callbacks need to be set before initialization so
     // that we can track objects allocated during `jl_init()`.
+    gc_roots = MemBlockTreeMake();
 #if !defined(SCAN_STACK_FOR_MPTRS_ONLY)
     bigvals = MemBlockTreeMake();
     jl_gc_set_cb_notify_external_alloc(alloc_bigval, 1);
@@ -725,6 +750,7 @@ void InitBags(UInt initial_size, Bag * stack_bottom, UInt stack_align)
     max_pool_obj_size = jl_gc_max_internal_obj_size();
     jl_gc_enable_conservative_gc_support();
     jl_init();
+    jl_gc_enable(0);
 
     // Import GAPTypes module to have access to GapObj abstract type.
     // Needs to be done before setting any GC states
@@ -804,6 +830,10 @@ void InitBags(UInt initial_size, Bag * stack_bottom, UInt stack_align)
     GAP_ASSERT(jl_is_datatype(datatype_bag));
     GAP_ASSERT(jl_is_datatype(datatype_largebag));
     StackAlignBags = stack_align;
+#ifdef HPCGAP
+    CreateMainRegion();
+    AddGCRoots();
+#endif
 }
 
 UInt CollectBags(UInt size, UInt full)
@@ -813,6 +843,25 @@ UInt CollectBags(UInt size, UInt full)
     return 1;
 }
 
+/****************************************************************************
+**
+*V  DSInfoBags[<type>]  . . . .  . . . . . . . . . .  region info for bags
+*/
+
+#ifdef HPCGAP
+
+static char DSInfoBags[NUM_TYPES];
+
+#define DSI_TL 0
+#define DSI_PUBLIC 1
+
+void MakeBagTypePublic(int type)
+{
+    DSInfoBags[type] = DSI_PUBLIC;
+}
+
+#endif // HPCGAP
+
 void RetypeBag(Bag bag, UInt new_type)
 {
     BagHeader * header = BAG_HEADER(bag);
@@ -856,6 +905,13 @@ void RetypeBag(Bag bag, UInt new_type)
         Panic("cannot change bag type to one requiring a 'free' callback");
     }
     header->type = new_type;
+#ifdef HPCGAP
+    switch (DSInfoBags[new_type]) {
+    case DSI_PUBLIC:
+        SET_REGION(bag, NULL);
+        break;
+    }
+#endif // HPCGAP
 }
 
 Bag NewBag(UInt type, UInt size)
@@ -879,7 +935,11 @@ Bag NewBag(UInt type, UInt size)
         alloc_size++;
 
 #if defined(SCAN_STACK_FOR_MPTRS_ONLY)
+#ifdef HPCGAP
+    bag = jl_gc_alloc_typed(JuliaTLS, 2 * sizeof(void *), datatype_mptr);
+#else
     bag = jl_gc_alloc_typed(JuliaTLS, sizeof(void *), datatype_mptr);
+#endif
     SET_PTR_BAG(bag, 0);
 #endif
 
@@ -890,6 +950,16 @@ Bag NewBag(UInt type, UInt size)
     header->size = size;
 
 
+#ifdef HPCGAP
+    switch (DSInfoBags[type]) {
+    case DSI_TL:
+        SET_REGION(bag, CurrentRegion());
+        break;
+    case DSI_PUBLIC:
+        SET_REGION(bag, NULL);
+        break;
+    }
+#endif
 #if !defined(SCAN_STACK_FOR_MPTRS_ONLY)
     // allocate the new masterpointer
     bag = jl_gc_alloc_typed(JuliaTLS, sizeof(void *), datatype_mptr);
@@ -1022,3 +1092,21 @@ void MarkJuliaWeakRef(void * p)
     if (JMarkTyped(p, jl_weakref_type))
         YoungRef++;
 }
+
+void *AllocateMemoryBlock(UInt size)
+{
+    return calloc(1, size);
+}
+
+
+void GC_add_roots(void *start, void *end)
+{
+    MemBlock mem = { start, (char *) end - (char *) start };
+    MemBlockTreeInsert(gc_roots, mem);
+}
+
+void GC_remove_roots(void *start, void *end)
+{
+    MemBlock mem = { start, (char *) end - (char *) start };
+    MemBlockTreeRemove(gc_roots, mem);
+}