Merge f4de4ff into 4616886

src/finfield.c

@@ -29,6 +29,7 @@
 
 #ifdef HPCGAP
 #include "hpc/aobjects.h"
+#include "hpc/thread.h"
 #endif
 
 Obj SuccFF;
@@ -348,10 +349,12 @@ Obj FuncDEGREE_FFE_DEFAULT (
 */
 Obj TypeFFE(Obj ffe)
 {
-    if (VAL_FFE(ffe) == 0)
-        return ELM_PLIST(TypeFF0, FLD_FFE(ffe));
-    else
-        return ELM_PLIST(TypeFF, FLD_FFE(ffe));
+    Obj types = (VAL_FFE(ffe) == 0) ? TypeFF0 : TypeFF;
+#ifdef HPCGAP
+    return ATOMIC_ELM_PLIST(types, FLD_FFE(ffe));
+#else
+    return ELM_PLIST(types, FLD_FFE(ffe));
+#endif
 }
 
 
@@ -1358,6 +1361,9 @@ Obj FuncLOG_FFE_DEFAULT (
 **  the smallest integer <i> such that '<i> * <z>^0 = <z>'.
 */
 Obj IntFF;
+#ifdef HPCGAP
+Int NumFF;
+#endif
 
 Obj INT_FF (
     FF                  ff )
@@ -1370,7 +1376,12 @@ Obj INT_FF (
     UInt                i;              /* loop variable                   */
 
     /* if the conversion table is not already known, construct it          */
+#ifdef HPCGAP
+    if ( NumFF < ff || (MEMBAR_READ(), ATOMIC_ELM_PLIST(IntFF, ff) == 0)) {
+        HashLock(&IntFF);
+#else
     if ( LEN_PLIST(IntFF) < ff || ELM_PLIST(IntFF,ff) == 0 ) {
+#endif
         q = SIZE_FF( ff );
         p = CHAR_FF( ff );
         conv = NEW_PLIST_IMM( T_PLIST, p-1 );
@@ -1381,11 +1392,23 @@ Obj INT_FF (
             SET_ELM_PLIST( conv, (z-1)/((q-1)/(p-1))+1, INTOBJ_INT(i) );
             z = succ[ z ];
         }
+#ifdef HPCGAP
+        GrowPlist(IntFF, ff);
+        ATOMIC_SET_ELM_PLIST( IntFF, ff, conv );
+        MEMBAR_WRITE();
+        NumFF = LEN_PLIST(IntFF);
+        HashUnlock(&IntFF);
+#else
         AssPlist( IntFF, ff, conv );
+#endif
     }
 
     /* return the conversion table                                           */
+#ifdef HPCGAP
+    return ATOMIC_ELM_PLIST( IntFF, ff);
+#else
     return ELM_PLIST( IntFF, ff );
+#endif
 }
 
 
@@ -1664,6 +1687,13 @@ static Int InitLibrary (
     IntFF = NEW_PLIST( T_PLIST, NUM_SHORT_FINITE_FIELDS );
     SET_LEN_PLIST( IntFF, NUM_SHORT_FINITE_FIELDS );
 
+#ifdef HPCGAP
+    MakeBagPublic(SuccFF);
+    MakeBagPublic(TypeFF);
+    MakeBagPublic(TypeFF0);
+    MakeBagPublic(IntFF);
+#endif
+
     /* init filters and functions                                          */
     InitGVarFiltsFromTable( GVarFilts );
     InitGVarFuncsFromTable( GVarFuncs );

src/finfield.h

@@ -55,6 +55,10 @@
 #include "ffdata.h"
 #include "objects.h"
 
+#ifdef HPCGAP
+#include "hpc/aobjects.h"
+#endif
+
 
 /****************************************************************************
 **
@@ -116,7 +120,11 @@ typedef UInt2       FF;
 **  Note that 'SUCC_FF' is a macro, so do not call  it  with  arguments  that
 **  side effects.
 */
+#ifdef HPCGAP
+#define SUCC_FF(ff)             ((const FFV*)(1+CONST_ADDR_OBJ( ATOMIC_ELM_PLIST( SuccFF, ff ) )))
+#else
 #define SUCC_FF(ff)             ((const FFV*)(1+CONST_ADDR_OBJ( ELM_PLIST( SuccFF, ff ) )))
+#endif
 
 extern  Obj             SuccFF;
 

src/gasman.h

@@ -38,6 +38,11 @@
 
 #include "system.h"
 
+#ifdef HPCGAP
+#include "hpc/region.h"
+#include "hpc/tls.h"
+#endif
+
 
 /****************************************************************************
 **
@@ -299,13 +304,60 @@ static inline UInt SIZE_BAG_CONTENTS(const void *ptr) {
 **  the application  must inform {\Gasman}  that it  has changed  the bag, by
 **  calling 'CHANGED_BAG(old)' in the above example (see "CHANGED_BAG").
 */
+#ifdef HPCGAP
+#define PURE_FUNC __attribute__((pure))
+static inline PURE_FUNC int ReadCheck(Bag bag)
+{
+    Region *region;
+    region = REGION(bag);
+    if (!region)
+        return 1;
+    if (region->owner == GetTLS())
+        return 1;
+    if (region->readers[TLS(threadID)])
+        return 1;
+    return 0;
+}
+
+static inline PURE_FUNC int WriteCheck(Bag bag)
+{
+    Region *region;
+    region = REGION(bag);
+    return !region || region->owner == GetTLS();
+}
+
+extern volatile int GuardDummy;
+extern PURE_FUNC int HandleReadGuardError(Bag);
+extern PURE_FUNC int HandleWriteGuardError(Bag);
+#endif // HPCGAP
+
 static inline Bag *PTR_BAG(Bag bag)
+{
+    GAP_ASSERT(bag != 0);
+#ifdef HPCGAP
+    if (!WriteCheck(bag))
+      GuardDummy = HandleWriteGuardError(bag);
+#endif
+    return *(Bag**)bag;
+}
+
+static inline Bag *UNSAFE_PTR_BAG(Bag bag)
 {
     GAP_ASSERT(bag != 0);
     return *(Bag**)bag;
 }
 
 static inline const Bag *CONST_PTR_BAG(Bag bag)
+{
+    GAP_ASSERT(bag != 0);
+#ifdef HPCGAP
+    if (!ReadCheck(bag))
+      GuardDummy = HandleReadGuardError(bag);
+#endif
+    return *(const Bag**)bag;
+}
+
+static inline const Bag *UNSAFE_CONST_PTR_BAG(Bag bag)
 {
     GAP_ASSERT(bag != 0);
     return *(const Bag**)bag;

src/hpc/thread.c

@@ -1220,6 +1220,9 @@ Region * CurrentRegion(void)
 }
 
 extern GVarDescriptor LastInaccessibleGVar;
+#ifdef DEBUG_GUARDS
+extern GVarDescriptor GUARD_ERROR_STACK;
+#endif
 
 #ifdef VERBOSE_GUARDS
 
@@ -1290,4 +1293,78 @@ void ReadGuardError(Obj o)
 }
 #endif
 
+// These are temporary debugging functions.
+
+Int NumReadErrors = 0;
+Int NumWriteErrors = 0;
+volatile int GuardDummy;
+
+#ifdef DEBUG_GUARDS
+
+#include <execinfo.h>
+
+#define BACKTRACE_DEPTH 128
+
+void SetGuardErrorStack(void)
+{
+    void *  callstack[BACKTRACE_DEPTH];
+    int     depth = backtrace(callstack, BACKTRACE_DEPTH);
+    char ** calls = backtrace_symbols(callstack, depth);
+    Obj     stack = NEW_PLIST_IMM(T_PLIST, depth);
+    SET_LEN_PLIST(stack, depth - 1);
+    for (int i = 1; i < depth; i++) {
+        char * p = calls[i] + 1;
+        char * q = p;
+        while (*p) {
+            if (p[-1] == ' ' && p[0] == ' ')
+                p++;
+            else
+                *q++ = *p++;
+        }
+        *q++ = 0;
+        SET_ELM_PLIST(stack, i, MakeImmString(calls[i]));
+    }
+    free(calls);
+    SetGVar(&GUARD_ERROR_STACK, stack);
+}
+#endif
+
+PURE_FUNC int HandleReadGuardError(Bag bag)
+{
+    NumReadErrors++;
+    // We shift some of the rarer checks here to
+    // avoid overloading ReadCheck().
+    if (REGION(bag)->alt_owner == GetTLS())
+        return 0;
+    if (TLS(DisableGuards))
+        return 0;
+    SetGVar(&LastInaccessibleGVar, bag);
+#ifdef DEBUG_GUARDS
+    SetGuardErrorStack();
+#endif
+    ErrorMayQuit(
+        "Attempt to read object %i of type %s without having read access",
+        (Int)bag, (Int)TNAM_OBJ(bag));
+    return 0;
+}
+
+PURE_FUNC int HandleWriteGuardError(Bag bag)
+{
+    NumWriteErrors++;
+    // We shift some of the rarer checks here to
+    // avoid overloading ReadCheck().
+    if (REGION(bag)->alt_owner == GetTLS())
+        return 0;
+    if (TLS(DisableGuards))
+        return 0;
+    SetGVar(&LastInaccessibleGVar, bag);
+#ifdef DEBUG_GUARDS
+    SetGuardErrorStack();
+#endif
+    ErrorMayQuit(
+        "Attempt to write object %i of type %s without having write access",
+        (Int)bag, (Int)TNAM_OBJ(bag));
+    return 0;
+}
+
 #endif

src/hpc/threadapi.c

@@ -24,6 +24,7 @@
 #include "modules.h"
 #include "objects.h"
 #include "plist.h"
+#include "precord.h"
 #include "read.h"
 #include "records.h"
 #include "set.h"
@@ -953,6 +954,9 @@ static void PrintRegion(Obj);
 
 GVarDescriptor LastInaccessibleGVar;
 GVarDescriptor MAX_INTERRUPTGVar;
+#ifdef DEBUG_GUARDS
+GVarDescriptor GUARD_ERROR_STACK;
+#endif
 
 static UInt RNAM_SIGINT;
 static UInt RNAM_SIGCHLD;
@@ -2008,8 +2012,13 @@ MigrateObjects(int count, Obj * objects, Region * target, int retype)
                 return 0;
         }
     }
-    for (i = 0; i < count; i++)
-        SET_REGION(objects[i], target);
+    for (i = 0; i < count; i++) {
+        Obj obj = objects[i];
+        if (TNUM_OBJ(obj) == T_PREC) {
+            SortPRecRNam(obj, 0);
+        }
+        SET_REGION(obj, target);
+    }
     return 1;
 }
 
@@ -2655,6 +2664,9 @@ static Int InitKernel(StructInitInfo * module)
 
     DeclareGVar(&LastInaccessibleGVar, "LastInaccessible");
     DeclareGVar(&MAX_INTERRUPTGVar, "MAX_INTERRUPT");
+#ifdef DEBUG_GUARDS
+    DeclareGVar(&GUARD_ERROR_STACK, "GUARD_ERROR_STACK");
+#endif
 
     // install mark functions
     InitMarkFuncBags(T_THREAD, MarkNoSubBags);

src/objfgelm.cc

@@ -120,7 +120,7 @@ extern Obj NewWord(Obj type, UInt npairs)
     ADDR_OBJ(word)[1] = INTOBJ_INT(npairs);
     SetTypeDatObj(word, type);
 #ifdef HPCGAP
-    MakeBagReadOnly(word);
+    MakeBagPublic(word);
 #endif
     return word;
 }

src/precord.c

@@ -44,6 +44,7 @@
 #ifdef HPCGAP
 #include "hpc/aobjects.h"
 #include "hpc/traverse.h"
+#include "hpc/guards.h"
 #endif
 
 /****************************************************************************
@@ -259,7 +260,14 @@ UInt FindPRec( Obj rec, UInt rnam, UInt *pos, int cleanup )
     high = LEN_PREC(rec);
     if (high > 0 && (Int) (GET_RNAM_PREC(rec,high)) > 0) {
         /* DIRTY! Not everything sorted! */
+#ifdef HPCGAP
+        // FIXME: Need to sort records before making them
+        // readonly or sharing them. This can be done in
+        // the traversal routines (in principle).
+        if (cleanup && CheckExclusiveWriteAccess(rec)) {
+#else
         if (cleanup) {
+#endif
             SortPRecRNam(rec,0);
             /* Note that this does not change the length and it cannot
              * trigger a garbage collection if cleanup is 1!