Add GET_FROM_SORTED_CACHE helper; use it to unify hpcgap/lib/ffe.gi, hpcgap/lib/pcgsperm.gi, hpcgap/lib/zmodnz.gi

lib/cache.gd

@@ -84,3 +84,9 @@
 ##
 
 DeclareGlobalFunction("MemoizePosIntFunction");
+
+#############################################################################
+##
+#F GET_FROM_SORTED_CACHE(<cache>, <key>, <maker>)
+##
+DeclareGlobalFunction("GET_FROM_SORTED_CACHE");

lib/cache.gi

@@ -70,3 +70,62 @@ function(func, extra...)
  return v;
  end;
 end);
+
+if IsHPCGAP then
+
+InstallGlobalFunction(GET_FROM_SORTED_CACHE,
+function(cache, key, maker)
+ local pos, val;
+
+ # Check whether this has been stored already.
+ atomic readonly cache do
+ pos:= POSITION_SORTED_LIST( cache[1], key );
+ if pos <= Length( cache[1] ) and cache[1][pos] = key then
+ return cache[2][ pos ];
+ fi;
+ od;
+
+ # Compute new value.
+ val := maker();
+
+ # Store the value.
+ atomic readwrite cache do
+ pos:= POSITION_SORTED_LIST( cache[1], key );
+ if pos <= Length( cache[1] ) and cache[1][pos] = key then
+ # oops, another thread computed the value in the meantime;
+ # so use that instead
+ val:= cache[2][ pos ];
+ else
+ Add( cache[1], key, pos );
+ Add( cache[2], val, pos );
+ fi;
+ od;
+
+ # Return the value.
+ return val;
+end);
+
+else
+
+InstallGlobalFunction(GET_FROM_SORTED_CACHE,
+function(cache, key, maker)
+ local pos, val;
+
+ # Check whether this has been stored already.
+ pos:= POSITION_SORTED_LIST( cache[1], key );
+ if pos <= Length( cache[1] ) and cache[1][pos] = key then
+ return cache[2][ pos ];
+ fi;
+
+ # Compute new value.
+ val := maker();
+
+ # Store the value.
+ Add( cache[1], key, pos );
+ Add( cache[2], val, pos );
+
+ # Return the value.
+ return val;
+end);
+
+fi;

lib/ffe.gd

@@ -335,15 +335,18 @@ fi;
 ## <Var Name="GALOIS_FIELDS"/>
 ##
 ## <Description>
-## global list of finite fields <C>GF( <A>p</A>^<A>d</A> )</C>,
-## the field of size <M>p^d</M> is stored in <C>GALOIS_FIELDS[<A>p</A>][<A>d</A>]</C>, provided 
-## p^d < MAXSIZE_GF_INTERNAL. Larger fields are stored in the FFEFamily of the
-## appropriate characteristic
+## global cache of finite fields <C>GF( <A>p</A>^<A>d</A> )</C> whose order
+## satisfies <M>p^d < MAXSIZE_GF_INTERNAL</M>. Larger fields are stored in
+## the FFEFamily of the appropriate characteristic.
+##
+## <C>GALOIS_FIELDS</C> contains a pair of lists; the first being a sorted
+## list of field sizes, the second a list of fields. The field of size
+## <M>p^d</M> is stored in <C>GALOIS_FIELDS[2][pos]</C>, if and only if
+## <C>GALOIS_FIELDS[1][pos]</C> is equal to <M>p^d</M>.
 ## </Description>
 ## </ManSection>
 ##
-DeclareGlobalVariable( "GALOIS_FIELDS",
- "list of lists, GALOIS_FIELDS[p][n] = GF(p^n) if bound" );
+DeclareGlobalVariable( "GALOIS_FIELDS" );
 
 
 #############################################################################

lib/ffe.gi

@@ -27,10 +27,12 @@
 ##
 #V GALOIS_FIELDS
 ##
-## global list of finite fields `GF( <p>^<d> )',
-## the field of size $p^d$ is stored in `GALOIS_FIELDS[<p>][<d>]'.
+## global cache of finite fields `GF( <p>^<d> )', consisting of a pair of
+## lists of equal size, the first list being a set of field sizes;
+## the field of size $p^d$ is stored in `GALOIS_FIELDS[2][<pos>]' if and
+## and only if `GALOIS_FIELDS[1][<pos>]' is equal to $p^d$
 ##
-InstallFlushableValue( GALOIS_FIELDS, [] );
+InstallFlushableValue( GALOIS_FIELDS, [ [], [] ] );
 if IsHPCGAP then
  ShareSpecialObj( GALOIS_FIELDS );
 fi;
@@ -186,11 +188,7 @@ InstallGlobalFunction( FFEFamily, function( p )
  if MAXSIZE_GF_INTERNAL < p then
 
  # large characteristic
- if p in FAMS_FFE_LARGE[1] then
-
- F:= FAMS_FFE_LARGE[2][ PositionSorted( FAMS_FFE_LARGE[1], p ) ];
-
- else
+ F:= GET_FROM_SORTED_CACHE( FAMS_FFE_LARGE, p, function()
 
  F:= NewFamily( "FFEFamily", IsFFE, 
  CanEasilySortElements,
@@ -208,11 +206,9 @@ InstallGlobalFunction( FFEFamily, function( p )
  # The whole family is a unique factorisation domain.
  SetIsUFDFamily( F, true );
 
- Add( FAMS_FFE_LARGE[1], p );
- Add( FAMS_FFE_LARGE[2], F );
- SortParallel( FAMS_FFE_LARGE[1], FAMS_FFE_LARGE[2] );
+ return F;
 
- fi;
+ end );
 
  else
 
@@ -228,6 +224,8 @@ InstallGlobalFunction( FFEFamily, function( p )
  fi;
 
  fi;
+
+ MakeWriteOnceAtomic(F); # needed for HPC-GAP, does nothing in plain GAP
  return F;
 end );
 
@@ -320,6 +318,7 @@ end );
 # in Finite field calculations we often ask again and again for the same GF.
 # Therefore cache the last entry.
 GFCACHE:=[0,0];
+MakeThreadLocal("GFCACHE");
 
 InstallGlobalFunction( GaloisField, function ( arg )
  local F, # the field, result
@@ -328,6 +327,7 @@ InstallGlobalFunction( GaloisField, function ( arg )
  d1, # degree of subfield over prime field
  q, # size of field to be constructed
  subfield, # left acting domain of the field under construction
+ new,
  B; # basis of the extension
 
  # if necessary split the arguments
@@ -476,26 +476,24 @@ InstallGlobalFunction( GaloisField, function ( arg )
  if IsInt( subfield ) then
 
  # The standard field is required. Look whether it is already stored.
- if not IsBound( GALOIS_FIELDS[p] ) then
- GALOIS_FIELDS[p]:= [];
- elif IsBound( GALOIS_FIELDS[p][d] ) then
- if Length(arg)=1 then
- GFCACHE:=[arg[1],GALOIS_FIELDS[p][d]];
+
+ new := false;
+ F := GET_FROM_SORTED_CACHE(GALOIS_FIELDS, p^d, function()
+ new := true;
+ # Construct the finite field object.
+ if d = 1 then
+ F:= FieldOverItselfByGenerators( [ Z(p) ] );
+ else
+ F:= FieldByGenerators( FieldOverItselfByGenerators( [ Z(p) ] ),
+ [ Z(p^d) ] );
  fi;
- return GALOIS_FIELDS[p][d];
- fi;
+ return F;
+ end );
 
- # Construct the finite field object.
- if d = 1 then
- F:= FieldOverItselfByGenerators( [ Z(p) ] );
- else
- F:= FieldByGenerators( FieldOverItselfByGenerators( [ Z(p) ] ),
- [ Z(p^d) ] );
+ if Length(arg)=1 and not new then
+ GFCACHE:=[arg[1],F];
  fi;
 
- # Store the standard field.
- GALOIS_FIELDS[p][d]:= F;
-
  else
 
  # Construct the finite field object.

lib/mapping.gd

@@ -206,10 +206,10 @@
 ## This has to have higher precedence than TRANSREGION, because
 ## while doing TransitiveIdentification we hold a lock on TRANSREGION
 ## and want a lock for GENERAL_MAPPING_REGION
-if IsHPCGAP then
+#if IsHPCGAP then
 BindGlobal("GENERAL_MAPPING_REGION",
  NewInternalRegion("FamiliesOfGeneralMappingsAndRanges region"));
-fi;
+#fi;
 
 #############################################################################
 ##

lib/pcgsperm.gi

@@ -1299,7 +1299,7 @@ function( G, d, e, opr )
  fi;
 end );
 
-BIND_GLOBAL( "CYCLICACHE", []);
+BIND_GLOBAL( "CYCLICACHE", [ [], [] ]);
 if IsHPCGAP then
  ShareSpecialObj(CYCLICACHE);
 fi;
@@ -1309,28 +1309,14 @@ local r,i,p,A,f,a;
  r:=RelativeOrders(pcgs);
  if Length(r)<=1 then
  p:=Product(r);
- i:=1;
- while i<=Length(CYCLICACHE) and Size(CYCLICACHE[i])<p do
- i:=i+1;
- od;
- # do we have it?
- if i<=Length(CYCLICACHE) and Size(CYCLICACHE[i])=p then
- return CYCLICACHE[i];
- fi;
-
- # make space
- p:=i;
- for i in [Length(CYCLICACHE),Length(CYCLICACHE)-1..p] do
- CYCLICACHE[i+1]:=CYCLICACHE[i];
- od;
- A := PermpcgsPcGroupPcgs( pcgs, IndicesEANormalSteps(pcgs), flag );
- CYCLICACHE[p]:=A;
- return A;
+ return GET_FROM_SORTED_CACHE(CYCLICACHE, p,
+ {} -> PermpcgsPcGroupPcgs( pcgs, IndicesEANormalSteps(pcgs), flag ));
  fi;
 
  # is the group in the mappings families cache?
  f:=FamiliesOfGeneralMappingsAndRanges(FamilyObj(OneOfPcgs(pcgs)));
  i:=1;
+ atomic readonly GENERAL_MAPPING_REGION do # for HPC-GAP; does nothing in plain GAP
  while i<=Length(f) do
  a:=ElmWPObj(f,i);
  if a<>fail and IsBound(a!.DefiningPcgs) 
@@ -1356,6 +1342,7 @@ local r,i,p,A,f,a;
  fi;
  i:=i+2;
  od;
+ od; # end of atomic
  A := PermpcgsPcGroupPcgs( pcgs, IndicesEANormalSteps(pcgs), flag );
  return A;
 end);

lib/zmodnz.gi

@@ -954,33 +954,20 @@ InstallGlobalFunction( ZmodpZ, function( p )
  return ZmodpZNC( AbsInt( p ) );
 end );
 
-InstallGlobalFunction( ZmodpZNC, function( p )
- local pos, F;
-
- # Check whether this has been stored already.
- pos:= Position( Z_MOD_NZ[1], p );
- if pos = fail then
-
- # Get the family of element objects of our ring.
- F:= FFEFamily( p );
+InstallGlobalFunction( ZmodpZNC, p -> GET_FROM_SORTED_CACHE( Z_MOD_NZ, p, function( )
+ local F;
 
- # Make the domain.
- F:= FieldOverItselfByGenerators( [ ZmodnZObj( F, 1 ) ] );
- SetIsPrimeField( F, true );
- SetIsWholeFamily( F, false );
+ # Get the family of element objects of our ring.
+ F:= FFEFamily( p );
 
- # Store the field.
- Add( Z_MOD_NZ[1], p );
- Add( Z_MOD_NZ[2], F );
- SortParallel( Z_MOD_NZ[1], Z_MOD_NZ[2] );
-
- else
- F:= Z_MOD_NZ[2][ pos ];
- fi;
+ # Make the domain.
+ F:= FieldOverItselfByGenerators( [ ZmodnZObj( F, 1 ) ] );
+ SetIsPrimeField( F, true );
+ SetIsWholeFamily( F, false );
 
  # Return the field.
  return F;
-end );
+end ) );
 
 
 #############################################################################
@@ -1003,45 +990,35 @@ InstallGlobalFunction( ZmodnZ, function( n )
  return ZmodpZNC( n );
  fi;
 
- # Check whether this has been stored already.
- pos:= Position( Z_MOD_NZ[1], n );
- if pos = fail then
+ return GET_FROM_SORTED_CACHE( Z_MOD_NZ, n, function( )
 
-  # Construct the family of element objects of our ring.
-  F:= NewFamily( Concatenation( "Zmod", String( n ) ),
-  IsZmodnZObj,
-  IsZmodnZObjNonprime and CanEasilySortElements
-  and IsNoImmediateMethodsObject,
-  CanEasilySortElements);
+ # Construct the family of element objects of our ring.
+ F:= NewFamily( Concatenation( "Zmod", String( n ) ),
+ IsZmodnZObj,
+ IsZmodnZObjNonprime and CanEasilySortElements
+ and IsNoImmediateMethodsObject,
+ CanEasilySortElements);
 
-  # Install the data.
-  SetCharacteristic(F,n);
+ # Install the data.
+ SetCharacteristic(F,n);
 
- # Store the objects type.
- F!.typeOfZmodnZObj:= NewType( F, IsZmodnZObjNonprime
- and IsModulusRep );
+ # Store the objects type.
+ F!.typeOfZmodnZObj:= NewType( F, IsZmodnZObjNonprime and IsModulusRep );
 
-  # as n is no prime, the family is no UFD
-  SetIsUFDFamily(F,false);
+ # as n is no prime, the family is no UFD
+ SetIsUFDFamily(F,false);
 
- # Make the domain.
- R:= RingWithOneByGenerators( [ ZmodnZObj( F, 1 ) ] );
- SetIsWholeFamily( R, true );
- SetZero(F,Zero(R));
- SetOne(F,One(R));
- SetSize(R,n);
-
- # Store the ring.
- Add( Z_MOD_NZ[1], n );
- Add( Z_MOD_NZ[2], R );
- SortParallel( Z_MOD_NZ[1], Z_MOD_NZ[2] );
-
- else
- R:= Z_MOD_NZ[2][ pos ];
- fi;
+ # Make the domain.
+ R:= RingWithOneByGenerators( [ ZmodnZObj( F, 1 ) ] );
+ SetIsWholeFamily( R, true );
+ SetZero(F,Zero(R));
+ SetOne(F,One(R));
+ SetSize(R,n);
 
  # Return the ring.
  return R;
+
+ end );
 end );