This is agcollec.c in view mode; [Download] [Up]
/****************************************************************************
**
*A agcollec.c GAP source Thomas Bischops
*A & Frank Celler
**
*A @(#)$Id: agcollec.c,v 3.42 1994/02/28 08:28:00 fceller Rel $
**
*Y Copyright 1990-1992, Lehrstuhl D fuer Mathematik, RWTH Aachen, Germany
**
** This file contains the functions which deal with the aggroup record and
** oops record operations used in "aggroup.c". It also contains functions to
** manipulate agwords, the soluble and p-group collectors.
**
*H $Log: agcollec.c,v $
*H Revision 3.42 1994/02/28 08:28:00 fceller
*H fixed error message
*H
*H Revision 3.41 1993/10/15 10:17:39 martin
*H fixed my improvements
*H
*H Revision 3.40 1993/09/27 11:59:06 martin
*H Improved the speed of 'AgFpGroup' (dramatically)
*H
*H Revision 3.39 1993/02/11 14:58:48 fceller
*H fixed a bug in 'ReadRelators'
*H
*H Revision 3.38 1992/06/19 08:32:42 fceller
*H changed 'AgListWord' slightly
*H
*H Revision 3.37 1992/04/29 09:28:40 martin
*H changed a few things to silence GCC
*H
*H Revision 3.36 1992/04/07 20:24:44 martin
*H changed the author line
*H
*H Revision 3.35 1992/02/07 13:19:17 fceller
*H Initial GAP 3.1 release.
*H
*H Revision 3.1 1990/07/28 12:00:00 fceller
*H Initial release under RCS.
*/
#include "system.h" /** system dependent functions **/
#include "gasman.h" /** dynamic storage manager **/
#include "eval.h" /** evaluator main dispatcher **/
#include "scanner.h" /** 'Pr' is here **/
#include "idents.h" /** 'FindRecname' is here **/
#include "integer.h" /** arbitrary size integers **/
#include "list.h" /** list package **/
#include "word.h" /** swords live here **/
#include "agcollec.h" /** private definitions of this package **/
#include "aggroup.h" /** definitions of this package **/
/****************************************************************************
**
*V Collectors . . . . . . . . . . . . . . . . description of the collectors
**
** The following is defined in "agcollec.h":
**
** #define SINGLE_COLLECTOR 0
** #define TRIPLE_COLLECTOR 1
** #define QUADR_COLLECTOR 2
** #define LEE_COLLECTOR 3
** #define COMBI2_COLLECTOR 4
** #define COMBI_COLLECTOR 5
*/
TypCollectors Collectors[ COMBI_COLLECTOR + 1 ] =
{
{ "single", InitSingle, AgSingle },
{ "triple", InitTriple, AgTriple },
{ "quadruple", InitQuadr, AgQuadruple },
{ "vaughanlee", InitCombinatorial, AgCombinatorial },
{ "combinatorial", InitCombinatorial, AgCombinatorial2 },
{ "combinatorial", InitCombinatorial, AgCombinatorial }
};
/*--------------------------------------------------------------------------\
| Combinatorial Collector |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
** The following variables are used during the combinatorial collecting
** process in a p - group with p > 2 and p = 2.
**
*V Prime . . . . . . . . . . . . . . . prime of the p-central-series, local
*V g . . . . . . . . . . . . base address of the lhs-exponent-vector, local
*V ug . . . . . . . . . . generators <ug> and <cg> will be commuted, local
*V ue . . . . . . . . . . . . . . . . . . . . . . . exponent of <ug>, local
*V cg . . . . . . . . . . generators <ug> and <cg> will be commuted, local
*V ce . . . . . . . . . . . . . . . . . . . . . . . exponent of <cg>, local
*V StrStk . . . . . . . . . . stack for the combinatorial collector, local
*V ExpStk . . . . . . . . . . stack for the combinatorial collector, local
*V GenStk . . . . . . . . . . stack for the combinatorial collector, local
*V StkDim . . . . . . . . . . . . . . . . . . . . . . . . stack size, local
*V CWeights . . . . . . . .address of the central weights 'CWEIGHTS', local
*V Class . . . . . . . . . . . . . . . . . . p-class of current group, local
*V CSeries . . . . . . . . . address of the central series 'CSERIES', local
*V LastClass . . . . . . . . number of first generators in last class, local
*V Sp . . . . . . . . Stackpointer during combinatorial collecting, local
*V NrGens . . . . . . . . . . . . . . . . number of group generators, local
*V Powers . . . . . . . . . . . . . . . . . address of the 'POWERS', local
*V Commutators . . . . . . . . . . . . . address of the 'COMMUTATORS', local
*/
static TypHandle * Powers, * Commutators;
static TypExp * g;
static TypExp * ExpStk;
static TypExp ue, ce;
static TypSword ug, cg;
static TypSword LastClass, Class;
static TypSword * * StrStk, * GenStk;
static long NrGens;
static long Prime;
static long * CWeights, * CSeries;
static long StkDim, Sp;
/****************************************************************************
**
*D PUSH_STRING( <str>, <exp> ) . . . . . . . . . push a string on the stack
*/
#define PUSH_STRING( s, e ) {*++StrStk=s; *++ExpStk=e; *++GenStk= -1; Sp++;}
/****************************************************************************
**
*D POP_STRING( <str>, <exp> ) . . . . . . . . . pop a string from the stack
*/
#define POP_STRING( s, e ) { s= *StrStk--; e= *ExpStk--; GenStk--; Sp--; }
/****************************************************************************
**
*D PUSH_GEN( <gen>, <exp> ) . . . . . . . . . push a generator on the stack
*/
#define PUSH_GEN( g, e ) { *++GenStk=g; *++ExpStk=e; ++StrStk; Sp++; }
/****************************************************************************
**
*D POP_GEN( <gen>, <exp> ) . . . . . . . . . . . pop a generator from stack
*/
#define POP_GEN( g, e ) { g= *GenStk--; e= *ExpStk--; StrStk--; Sp--; }
/****************************************************************************
**
*F AddString( <str>, <exp> ) . . . . . . add <str> ^ <exp> and reduce, local
**
** This must only be called with string with maximal exponent < <Prime>-1.
**
** This is step 5 in Vaughan-Lee's paper "Collection from the Left".
*/
static void AddString ( str, exp )
TypSword * str;
TypExp exp;
{
TypHandle hd;
TypExp e, * p;
e = exp * Prime;
# if USE_SHIFT_TEST
if ( e / Prime != exp || ((e << 1 ) >> 1) != e )
#else
if ( e / Prime != exp || e >= MAX_AG_EXP )
#endif
Error( "Collector: integer overflow (e:%d, str:%d)", e, Prime );
for ( ; *str != -1; str += 2 )
{
p = &( g[ str[ 0 ] ] );
e = *p + exp * str[1];
# if USE_SHIFT_TEST
if ( ((e << 1) >> 1) != e )
# else
if ( e >= MAX_AG_EXP )
# endif
Error("Collector: integer overflow (e:%d,g:%d)",e,g[str[0]]);
if ( e >= Prime )
{
*p = e % Prime;
if ( str[0] < LastClass )
{
hd = Powers[ str[0] ];
if ( ! ISID_AW( hd ) )
AddString( PTR_AW( hd ), e / Prime );
}
}
else
*p = e;
}
}
/****************************************************************************
**
*F AddGen() . . . . . . . . . . . . . . . add <ug> ^ <ue> and reduce, local
**
** This is step 4 in Vaughan-Lee's paper "Collection from the Left".
*/
static void AddGen ()
{
TypHandle hd;
TypExp * p, e;
p = g + ug;
e = *p + ue;
# if USE_SHIFT_TEST
if ( ((e << 1) >> 1) != e )
# else
if ( e >= MAX_AG_EXP )
# endif
Error( "Collector: integer overflow (e:%d)", e, 0L );
if ( e >= Prime )
{
*p = e % Prime;
hd = Powers[ ug ];
if ( ! ISID_AW( hd ) )
AddString( PTR_AW( hd ), e / Prime );
}
else
*p = e;
}
/****************************************************************************
**
*F TripleWeight() . . . collect <ug> ^ <ue> when 3 * <uw> > <Class>, local
**
** This is step 6 in Vaughan-Lee's paper "Collection from the Left".
*/
static boolean TripleWeight ()
{
TypHandle hd;
TypExp e, * p;
cg = CSeries[ Class - CWeights[ ug ] ];
for ( p = g + cg; cg > ug; cg--, p-- )
{
ce = *p;
if ( ce != 0 )
{
hd = Commutators[ IND( cg, ug ) ];
if ( ! ISID_AW( hd ) )
{
e = ce * ue;
if ( e / ce != ue )
Error( "Collector: integer overflow (ce:%d, ue:%d)",
ce, ue );
AddString( PTR_AW( hd ), e );
}
}
}
e = *p + ue;
# if USE_SHIFT_TEST
if ( ((e << 1) >> 1) != e )
# else
if ( e >= MAX_AG_EXP )
# endif
Error( "Collector: integer overflow (g:%d, ue:%d)", g[ug], ue );
*p = e % Prime;
if ( e >= Prime )
{
hd = Powers[ ug ];
if ( ! ISID_AW( hd ) )
{
cg = CSeries[ Class - CWeights[ ug ] ];
for ( p = g + cg; cg > ug; cg--, p-- )
{
ce = *p;
if ( ce != 0 )
{
*p = 0;
PUSH_GEN( cg, ce );
if ( Sp > StkDim )
return FALSE;
}
}
AddString( PTR_AW( hd ), e / Prime );
}
}
return TRUE;
}
/****************************************************************************
**
*F VLCombiCollect() . . . . . . . . . . . . combinatorial collector, local
**
** This is a modified step 2.
*/
static int VLCombiCollect ()
{
TypSword i, f, l = 0, uw;
TypHandle hd;
TypExp * p;
if ( ue > 1 )
{
PUSH_GEN( ug, ue - 1 );
if ( Sp > StkDim )
return 0;
ue = 1;
}
uw = CWeights[ ug ];
f = CSeries[ Class - uw ];
l = MAX( CSeries[ ( Class - uw ) / 2 ], ug );
if ( f < l )
Error("VLCombiCollect: f < l should not happen", 0L, 0L );
for ( cg = f, p = g + f; cg > ug; cg--, p-- )
{
ce = *p;
if ( ce != 0 )
{
hd = Commutators[ IND( cg, ug ) ];
if ( ! ISID_AW( hd ) )
{
if ( cg <= l )
break;
AddString( PTR_AW( hd ), ce );
}
}
}
if ( cg == ug )
{
if ( *p < Prime - 1 || ISID_AW( Powers[ ug ] ) )
return 2;
}
for ( i = f, p = g + f; i > cg; i--, p-- )
{
ce = *p;
if ( ce != 0 )
{
PUSH_GEN( i, ce );
if ( Sp > StkDim )
return 0;
*p = 0;
}
}
return 1;
}
/****************************************************************************
**
*F CombiCollect() . . . . . . . . . . . . . combinatorial collector, local
**
** This is step 2 in Vaughan-Lee's paper "Collection from the Left".
**
** The bound for <ue> can be decreased, if an integer overflow occures.
*/
static boolean CombiCollect ()
{
TypSword j, f, l = 0, uw, * str;
TypHandle hd;
TypExp * p, * q, i, x, y, z, t;
long oldSp = 0;
# if USE_SHIFT_TEST == 0
long max = MAX_AG_EXP;
# endif
# if COMBI_BOUND > 0
if ( ue > COMBI_BOUND )
{
PUSH_GEN( ug, ue - COMBI_BOUND );
if ( Sp > StkDim )
return FALSE;
ue = COMBI_BOUND;
}
# endif
uw = CWeights[ ug ];
f = CSeries[ Class - uw ];
for ( i = 1; i <= ue; i++ )
{
l = MAX( CSeries[ ( Class - uw ) / 2 + ( i - 1 ) * uw ], ug ) + 1;
if ( f < l )
break;
oldSp = Sp + 1;
for ( cg = f, p = g + f; cg >= l; cg--, p-- )
{
ce = *p;
if ( ce != 0 )
{
PUSH_GEN( cg, ce );
if ( Sp > StkDim )
return FALSE;
*p = 0;
hd = Commutators[ IND( cg, ug ) ];
if ( ISID_AW( hd ) )
continue;
/** Compute <ce> * ( <ue> - <i> + 1 ) / <i> ****************/
x = ce;
y = ue - i + 1;
z = 1;
if ( x % i == 0 )
x = x / i;
else if ( y % i == 0 )
y = y / i;
else
z = i;
t = x * y;
if ( t / x != y )
Error( "Collector: integer overflow (x:%d, y:%d)",x,y );
t = t / z;
x = t * Prime;
# if USE_SHIFT_TEST
if ( x / Prime != t || ((x << 1) >> 1) != x )
# else
if ( x / Prime != t || x >= MAX_AG_EXP )
# endif
Error( "Collector: integer overflow (s:%d, t:%d)",
Prime, t );
/** add <hd> * <t> *****************************************/
for ( str = PTR_AW( hd ); str[ 0 ] != -1; str += 2 )
{
q = &( g[ str[0] ] );
x = str[1] * t;
*q += x;
# if USE_SHIFT_TEST
if ( (((*q) << 1) >> 1) != *q )
# else
if ( *q >= max )
# endif
{
if ( str[0] > f )
{
hd = Powers[ str[0] ];
if ( ! ISID_AW( hd ) )
AddString( PTR_AW(hd), *q/Prime );
*q = *q % Prime;
}
else
Error( "Collector: integer overflow (x:%d)",
x, 0L );
}
}
}
}
if ( oldSp > Sp )
break;
}
if ( oldSp <= Sp && f >= l )
{
l = MAX( CSeries[ ( Class - uw ) / 2 + ue * uw ], ug ) + 1;
for ( p = g + l; l <= f; l++, p++ )
{
ce = *p;
if ( ce != 0 )
{
PUSH_GEN( l, ce );
if ( Sp > StkDim )
return FALSE;
*p = 0;
}
}
}
for ( j = f + 1, p = g + ( f + 1 ); j < NrGens; j++, p++ )
if ( *p >= Prime )
{
hd = Powers[ j ];
if ( ! ISID_AW( hd ) )
AddString( PTR_AW( hd ), *p / Prime );
*p = *p % Prime;
}
return TRUE;
}
/****************************************************************************
**
*F OrdinaryCollect() . . . . . . . . . . . . . . ordinary collection, local
**
** This is step 5 in Vaughan-Lee's paper "Collection from the Left"
*/
static boolean OrdinaryCollect ()
{
TypHandle hd;
TypSword j;
TypExp * p;
cg = CSeries[ Class - CWeights[ ug ] ];
for ( p = g + cg; cg > ug; cg--, p-- )
{
ce = *p;
if ( ce != 0 )
{
*p = 0;
hd = Commutators[ IND( cg, ug ) ];
if ( ISID_AW( hd ) )
{
PUSH_GEN( cg, ce );
if ( Sp > StkDim )
return FALSE;
}
else
{
if ( ue > 1 )
{
PUSH_GEN( ug, ue - 1 );
if ( Sp > StkDim )
return FALSE;
ue = 1;
}
if ( Sp + 2 * ce > StkDim )
return FALSE;
for ( j = 1; j <= ce; j++ )
{
PUSH_STRING( PTR_AW( hd ), 1 );
PUSH_GEN( cg, 1 );
}
}
}
}
return TRUE;
}
/****************************************************************************
**
*F AgCombinatorial( <g>, <h> ) . . . . . . . . . . . combinatorial-collector
**
** This routine follows an algorithm for collecting from the left based on
** routines devised by Vaughan-Lee.
**
** An exponent-vector with base address <g> is multiplied on the right with
** a normed word <h>.
*/
boolean AgCombinatorial ( ptG, hdH )
TypExp * ptG;
TypHandle hdH;
{
TypHandle hdGrp, * hdStk;
TypSword halfClass, * str;
long collNr, i;
if ( ISID_AW( hdH ) )
return TRUE;
/** Initialize the globale variables ***********************************/
hdGrp = * PTR( hdH );
collNr = COLLECTOR( hdGrp );
Prime = INDICES( hdGrp )[ 0 ];
Powers = POWERS( hdGrp );
Commutators = COMMUTATORS( hdGrp );
NrGens = NUMBER_OF_GENS( hdGrp );
CWeights = CWEIGHTS( hdGrp );
CSeries = CSERIES( hdGrp );
hdStk = STACKS( hdGrp );
StrStk = ( (TypSword**) PTR( hdStk[ 0 ] ) ) - 1;
GenStk = ( (TypSword*) PTR( hdStk[ 1 ] ) ) - 1;
ExpStk = ( (TypExp*) PTR( hdStk[ 2 ] ) ) - 1;
StkDim = SIZE( hdStk[ 0 ] ) / sizeof( TypSword* ) - 2;
Class = CSeries[ 0 ];
halfClass = ( Class == 1 ) ? -1 : CSeries[ Class / 2 ];
LastClass = ( Class == 1 ) ? 0 : CSeries[ Class - 1 ] + 1;
g = ptG;
/** Set up the collection stacks. **************************************/
PUSH_STRING( PTR_AW( hdH ), 1 );
Sp = 0;
/** Collect until we reach the bottom of our stack *********************/
while ( Sp >= 0 )
{
if ( *GenStk >= 0 )
{
POP_GEN( ug, ue );
if ( ug > halfClass )
{
AddGen();
continue;
}
}
else
{
POP_STRING( str, ue );
if ( str[ 0 ] > halfClass )
{
AddString( str, ue );
continue;
}
if ( str[ 2 ] != -1 )
PUSH_STRING( str + 2, ue );
ug = str[ 0 ];
ue = str[ 1 ];
}
/** If 3 * <uw>, then all commutators commute **********************/
if ( 3 * CWeights[ ug ] > Class )
{
if ( ! TripleWeight() )
return FALSE;
continue;
}
/** Collect combinatorially ****************************************/
if ( collNr == LEE_COLLECTOR )
{
i = VLCombiCollect();
if ( i == 0 )
return FALSE;
if ( i == 1 )
if ( ! OrdinaryCollect() )
return FALSE;
}
else
{
if ( ! CombiCollect() )
return FALSE;
if ( ! OrdinaryCollect() )
return FALSE;
}
/** Add <ug> ^ <ue> to the collected part in <g> *******************/
AddGen();
}
return TRUE;
}
/*--------------------------------------------------------------------------\
| Combinatorial Collector with prime 2 |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*D PUSH_STRING_2( <str> ) . . . . . . . . . . . push a string on the stack
*/
#define PUSH_STRING_2( s ) { *++StrStk = s; *++GenStk = -1; Sp++; }
/****************************************************************************
**
*D POP_STRING_2( <str> ) . . . . . . . . . . . . pop a string from the stack
*/
#define POP_STRING_2( s ) { s = *StrStk--; GenStk--; Sp--; }
/****************************************************************************
**
*D PUSH_GEN_2( <gen> ) . . . . . . . . . . . . push a generator on the stack
*/
#define PUSH_GEN_2( g ) { *++GenStk = g; ++StrStk; Sp++; }
/****************************************************************************
**
*D POP_GEN_2( <gen> ) . . . . . . . . . . . . . pop a generator from stack
*/
#define POP_GEN_2( g ) { g = *GenStk--; StrStk--; Sp--; }
/****************************************************************************
**
*F AddString2( <str> ) . . . . . . . . . . . . . add <str> and reduce, local
**
** This is step 5 in Vaughan-Lee's paper "Collection from the Left".
*/
static void AddString2 ( str )
TypSword * str;
{
TypHandle hd;
for ( ; *str != -1; str +=2 )
{
if ( g[ str[0] ] > 0 )
{
g[ str[0] ] = 0;
if ( str[0] < LastClass )
{
hd = Powers[ str[0] ];
if ( ! ISID_AW( hd ) )
AddString2( PTR_AW( hd ) );
}
}
else
g[ str[0] ] = 1;
}
}
/****************************************************************************
**
*F AddGen2() . . . . . . . . . . . . . . . . . . adds <ug> and reduce, local
**
** This is step 4 in Vaughan-Lee's paper "Collection from the Left".
*/
static void AddGen2 ()
{
TypHandle hd;
if ( g[ ug ] > 0 )
{
g[ ug ] = 0;
hd = Powers[ ug ];
if ( ! ISID_AW( hd ) )
AddString2( PTR_AW( hd ) );
}
else
g[ ug ] = 1;
}
/****************************************************************************
**
*F CombiCollect2() . . . . . . . . collects <ug> adding commutators directly
**
** Move <ug> past entries in the collected part, adding commutators directly
** to the collected part. If <cg> > <CSeries>[(<Class>-<CWeights>(<ug>))/2]
** then [ <cg>, <ug> ] commutes with all generators $k$ >= <cg>.
*/
static boolean CombiCollect2 ()
{
TypExp * p, i;
TypSword l, uw;
TypHandle hd;
uw = CWeights[ ug ];
l = MAX( CSeries[ ( Class - uw ) / 2 ], ug );
cg = CSeries[ Class - uw ];
for ( p = g + cg; cg > l; cg--, p-- )
{
if ( *p > 0 )
{
hd = Commutators[ IND( cg, ug ) ];
if ( ! ISID_AW( hd ) )
AddString2( PTR_AW( hd ) );
}
}
if ( ug == cg && ( *p == 0 || ISID_AW( Powers[ cg ] ) ) )
return TRUE;
/** We have to stack up some of the collected part. ********************/
i = CSeries[ Class - CWeights[ ug ] ];
for ( p = g + i; i > cg; i--, p-- )
{
if ( *p != 0 )
{
*p = 0;
PUSH_GEN_2( i );
if ( Sp > StkDim )
return FALSE;
}
}
return TRUE;
}
/****************************************************************************
**
*F OrdinaryCollect2() . . . . . . . . . . . continues scanning to the left
**
** Continue scanning towards the left stacking up commutators and entries in
** collected part until we reach <ug> position.
*/
static boolean OrdinaryCollect2 ()
{
TypHandle hd;
TypExp * p;
for ( p = g + cg; cg > ug; cg--, p-- )
{
if ( *p != 0 )
{
*p = 0;
hd = Commutators[ IND( cg, ug ) ];
if ( ! ISID_AW( hd ) )
{
PUSH_STRING_2( PTR_AW( hd ) );
if ( Sp > StkDim )
return FALSE;
}
PUSH_GEN_2( cg );
if ( Sp > StkDim )
return FALSE;
}
}
return TRUE;
}
/****************************************************************************
**
*F AgCombinatorial2( <g>, <h> ) . . combinatorial-collector for <Prime> = 2
**
** This routine follows an algorithm for collecting from the left based on
** routines devised by Vaughan-Lee.
**
** An exponent-vector with base address <g> is multiplied on the right with
** a normed word <h>.
*/
boolean AgCombinatorial2 ( ptG, hdH )
TypExp * ptG;
TypHandle hdH;
{
TypSword halfClass, * str;
TypHandle * hdStk, hdGrp;
if ( ISID_AW( hdH ) )
return TRUE;
/** Initialize the combinatorial-collector. ****************************/
hdGrp = *PTR( hdH );
Powers = POWERS( hdGrp );
Commutators = COMMUTATORS( hdGrp );
NrGens = NUMBER_OF_GENS( hdGrp );
Prime = INDICES( hdGrp )[ 0 ];
CWeights = CWEIGHTS( hdGrp );
CSeries = CSERIES( hdGrp );
hdStk = STACKS( hdGrp );
StrStk = ( (TypSword**) PTR( hdStk[ 0 ] ) ) - 1;
GenStk = ( (TypSword*) PTR( hdStk[ 1 ] ) ) - 1;
StkDim = SIZE( hdStk[ 0 ] ) / sizeof( TypSword* ) - 2;
Class = CSeries[ 0 ];
halfClass = ( Class == 1 ) ? -1 : CSeries[ Class / 2 ];
LastClass = ( Class == 1 ) ? 0 : CSeries[ Class - 1 ] + 1;
g = ptG;
/** Set up the collection stacks. **************************************/
PUSH_STRING_2( PTR_AW( hdH ) );
Sp = 0;
/** Collect until we reach the boottom of out stack ********************/
while ( Sp >= 0 )
{
if ( *GenStk >= 0 )
{
POP_GEN_2( ug );
if ( ug > halfClass )
{
AddGen2();
continue;
}
}
else
{
POP_STRING_2( str );
if ( str[ 0 ] > halfClass )
{
AddString2( str );
continue;
}
if ( str[ 2 ] != -1 )
PUSH_STRING_2( str + 2 );
ug = str[ 0 ];
}
/** Collect and add commutators directly to the collectd part. *****/
if ( ! CombiCollect2() )
return FALSE;
/** ordinary collection ********************************************/
if ( cg != ug )
if ( ! OrdinaryCollect2() )
return FALSE;
/** Add <ug> to the collected part. ********************************/
AddGen2();
}
return TRUE;
}
/*--------------------------------------------------------------------------\
| soluble group collectors |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F AgSingle( <g>, <h> ) . . . . . . . . . . . . . . . . . single collector
**
** This routine follows an algorithm for collecting from the left based on
** routines devised by L. Solcher.
**
** An exponent-vector with base address <g> is multiplied on the right with
** a normed word <h>.
*/
boolean AgSingle ( ptG, hdH )
TypExp * ptG;
TypHandle hdH;
{
/** powers . . . . . . . . . . . . pointer to 'POWERS' of the aggrp **/
/** indices . . . . . . . . . . . . pointer to 'INDICES' of the aggrp **/
/** conjugates . . . . . . . . pointer to 'CONJUAGTES' of the aggrp **/
/** avec . . . . . . . . . . . . . . pointer to 'AVEC' of the aggrp **/
/** wStk . . . . . . . pointer to the beginning of an inserted word **/
/** oStk . . . . . . . pointer to the inserted generator in the word **/
/** kStk . . . . . . . . . . . . exponent of the generator in <oStk> **/
/** jStk . . . . . . . . . . . . . . exponent of the word in <wStk> **/
/** xr . . . . . . . . . . . . . actual place in the collected part **/
/** ug . . . . . . . . . . . . . . generator, which will be inserted **/
/** nmv . . . . . . . . number of moved <ug>'s in one collecting step **/
TypSword * * wStk, * * oStk, xr, ug;
TypExp * kStk, * jStk, * p, nmv = 0;
TypHandle * hdStk, hdGrp;
TypHandle * conjugates, * powers;
long stkDim, sP;
long * avec;
long * indices;
/** If <hdH> points to the identity there is nothing to collect. ********/
if ( ISID_AW( hdH ) )
return TRUE;
/** Initialize the variables which are used during collection. *********/
hdGrp = *PTR( hdH );
powers = POWERS( hdGrp );
indices = INDICES( hdGrp );
conjugates = CONJUGATES( hdGrp );
avec = AVEC( hdGrp );
/** Initialize the stacks used during collection. **********************/
hdStk = STACKS( hdGrp );
stkDim = SIZE( hdStk[ 0 ] ) / sizeof( TypSword* ) - 1;
wStk = (TypSword**) PTR( hdStk[ 0 ] );
oStk = (TypSword**) PTR( hdStk[ 1 ] );
kStk = (TypExp*) PTR( hdStk[ 2 ] );
jStk = (TypExp*) PTR( hdStk[ 3 ] );
sP = 0;
*wStk = PTR_AW( hdH );
*oStk = PTR_AW( hdH );
*kStk = PTR_AW( hdH )[ 1 ];
*jStk = 1;
/** Collect until we reach the bottom of our stack. ********************/
while ( sP >= 0 )
{
ug = *( *oStk );
if ( ug == -1 )
{
sP--; wStk--; oStk--; kStk--; jStk--;
}
else
{
*kStk -= avec[ ug ] == ug + 1 ? ( nmv = *kStk ) : ( nmv = 1 );
if ( ! *kStk )
{
*oStk += 2;
if ( **oStk == -1 )
{
if ( --(*jStk) > 0 )
{
*oStk = *wStk;
*kStk = *( *wStk + 1 );
}
else
{
sP--; wStk--; oStk--; kStk--; jStk--;
}
}
else
*kStk = *( *oStk + 1 );
}
for ( xr = avec[ ug ] - 1, p = ptG + xr; xr > ug; xr--, p-- )
{
if ( *p )
{
sP++; wStk++; oStk++; kStk++; jStk++;
if ( sP > stkDim )
return FALSE;
*wStk = *oStk = PTR_AW( conjugates[ IND(xr,ug) ] );
*kStk = *( *oStk + 1 );
*jStk = *p;
*p = 0;
}
}
*p += nmv;
if ( *p < indices[ ug ] )
continue;
*p -= indices[ ug ];
if ( ! ISID_AW( powers[ ug ] ) )
{
sP++; wStk++; oStk++; kStk++; jStk++;
if ( sP > stkDim )
return FALSE;
*wStk = *oStk = PTR_AW( powers[ ug ] );
*kStk = *( *oStk + 1 );
*jStk = 1;
}
}
}
return TRUE;
}
/****************************************************************************
**
*F AgTriple( <g>, <h> ) . . . . . . . . . . . . . . . . . triple collector
**
** This routine follows an algorithm for collecting from the left based on a
** power-conjugate-presentation with triples $g_j ^ g_i^r$.
**
** An exponent-vector with base address <g> is multiplied on the right with
** a normed word <hd>.
*/
boolean AgTriple ( ptG, hdH )
TypExp *ptG;
TypHandle hdH;
{
/** powers . . . . . . . . . . . . pointer to 'POWERS' of the aggrp **/
/** indices . . . . . . . . . . . . pointer to 'INDICES' of the aggrp **/
/** triple . . . . . . . . . . . . pointer to 'TRIPLES' of the aggrp **/
/** avec . . . . . . . . . . . . . . pointer to 'AVEC' of the aggrp **/
/** oStk . . . . . . . pointer to the inserted generator in the word **/
/** xr . . . . . . . . . . . . . actual place in the collected part **/
/** ug . . . . . . . . . . . . . . generator, which will be inserted **/
/** nmv . . . . . . . . number of moved <ug>'s in one collecting step **/
/** wStk . . . . . . . . . . . . . inserted generator if <oStk> = 0 **/
/** eStk . . . . . . . . . . . . . . . . exponent of this generator **/
/** maxExp . . . . . . . . . . . . . . maximimal exponent of tuples **/
TypHandle * powers, * triple;
TypSword * * oStk, * wStk, * eStk, xr, ug, maxExp;
TypExp exp, nmv = 0, ind, * p;
TypHandle * hdStk, hdGrp, * hdTmp;
long stkDim, sP;
long * avec;
long * indices;
/** If <hdH> points to the idenity there is nothing to collect. ********/
if ( ISID_AW( hdH ) )
return FALSE;
/** Initialize the variables used during the collecting process. *******/
hdGrp = *PTR( hdH );
powers = POWERS( hdGrp );
indices = INDICES( hdGrp );
triple = TRIPLES( hdGrp );
avec = AVEC( hdGrp );
maxExp = TUPLE_BOUND( hdGrp );
/** Initialize the stacks used during collection. **********************/
hdStk = STACKS( hdGrp );
stkDim = SIZE( hdStk[ 0 ] ) / sizeof( TypSword* ) - 1;
oStk = (TypSword**) PTR( hdStk[ 0 ] );
wStk = (TypSword*) PTR( hdStk[ 1 ] );
eStk = (TypSword*) PTR( hdStk[ 2 ] );
sP = 0;
*oStk = PTR_AW( hdH );
/** Collect until we reach the bottom of our stack. ********************/
while ( sP >= 0 )
{
if ( *oStk != 0 )
{
ug = **oStk;
if ( ug != -1 )
{
nmv = *( *oStk + 1 );
*oStk += 2;
}
else
{
sP--; oStk--; wStk--; eStk--;
}
}
else
{
ug = *wStk;
nmv = *eStk;
sP--; oStk--; wStk--; eStk--;
}
if ( ug != -1 )
{
while ( nmv > maxExp )
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = 0;
*wStk = ug;
*eStk = maxExp;
nmv -= maxExp;
}
for ( xr = avec[ ug ] - 1, p = ptG + xr; xr > ug; xr--, p-- )
{
exp = *p;
if ( exp )
{
ind = IND( xr, ug );
if ( triple[ ind ] )
{
hdTmp = PTR( triple[ ind ] ) + 1;
wStk += exp;
eStk += exp;
for ( ; exp > 0 ; exp-- )
{
sP++; oStk++;
if ( sP > stkDim )
return FALSE;
*oStk = PTR_AW( hdTmp[ nmv - 1 ] );
}
}
else
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = 0;
*wStk = xr;
*eStk = exp;
}
*p = 0;
}
}
*p += nmv;
if ( *p < indices[ ug ] )
continue;
*p -= indices[ ug ];
if ( ! ISID_AW( powers[ ug ] ) )
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = PTR_AW( powers[ ug ] );
}
}
}
return TRUE;
}
/****************************************************************************
**
*F AgQuadruple( <g>, <h> ) . . . . . . . . . . . . . . . quadruple collector
**
** This routine follows an algorithm for collecting from the left based on a
** power-conjugate-presentation with quadruple $g_j^s ^ g_i^r$.
**
** An exponent-vector with base address <g> is multiplied on the right with
** a normed word <h>.
*/
int AgQuadruple ( ptG, hdH )
TypExp * ptG;
TypHandle hdH;
{
/** powers . . . . . . . . . . . . pointer to 'POWERS' of the aggrp **/
/** indices . . . . . . . . . . . . pointer to 'INDICES' of the aggrp **/
/** quadruple . . . . . . . . . pointer to 'CONJUAGTES' of the aggrp **/
/** avec . . . . . . . . . . . . . . pointer to 'AVEC' of the aggrp **/
/** oStk . . . . . . . pointer to the inserted generator in the word **/
/** xr . . . . . . . . . . . . . actual place in the collected part **/
/** ug . . . . . . . . . . . . . . generator, which will be inserted **/
/** nmv . . . . . . . . number of moved <ug>'s in one collecting step **/
/** wStk . . . . . . . . . . . . . inserted generator if <oStk> = 0 **/
/** eStk . . . . . . . . . . . . . . . . exponent of this generator **/
/** maxExp . . . . . . . . . . . . . . maximimal exponent of tuples **/
TypHandle * powers, * quadruple;
TypSword * * oStk, * wStk, * eStk, xr, ug, maxExp;
TypExp exp, nmv = 0, ind, * p;
TypHandle * hdStk, hdGrp, * hdTmp;
long stkDim, sP;
long * avec;
long * indices;
/** If <hdH> points to the idenity there is nothing to collect. *********/
if ( ISID_AW( hdH ) )
return TRUE;
/** Initialize the variables used during the collecting process. *******/
hdGrp = *PTR( hdH );
powers = POWERS( hdGrp );
indices = INDICES( hdGrp );
quadruple = QUADRUPLES( hdGrp );
avec = AVEC( hdGrp );
maxExp = TUPLE_BOUND( hdGrp );
/** Initialize the stacks used during collection. **********************/
hdStk = STACKS( hdGrp );
stkDim = SIZE( hdStk[ 0 ] ) / sizeof( TypSword* ) - 1;
oStk = (TypSword**) PTR( hdStk[ 0 ] );
wStk = (TypSword*) PTR( hdStk[ 1 ] );
eStk = (TypSword*) PTR( hdStk[ 2 ] );
sP = 0;
*oStk = PTR_AW( hdH );
/** Collect until we reach the bottom of our stack. ********************/
while ( sP >= 0 )
{
if ( *oStk != 0 )
{
ug = *( *oStk );
if ( ug != -1 )
{
nmv = *( *oStk + 1 );
*oStk += 2;
}
else
{
sP--; oStk--; wStk--; eStk--;
}
}
else
{
ug = *wStk;
nmv = *eStk;
sP--; oStk--; wStk--; eStk--;
}
if ( ug != -1 )
{
while ( nmv > maxExp )
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = 0;
*wStk = ug;
*eStk = maxExp;
nmv -= maxExp;
}
for ( xr = avec[ ug ] - 1, p = ptG + xr; xr > ug; xr--, p-- )
{
exp = *p;
if ( exp )
{
ind = IND( xr, ug );
if ( quadruple[ ind ] )
{
hdTmp = PTR( quadruple[ ind ] ) + 1;
while ( exp > maxExp )
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
ind = (nmv-1) * MIN( (indices[xr]-1), maxExp )
+ maxExp - 1;
*oStk = PTR_AW( hdTmp[ ind ]);
exp -= maxExp;
}
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
ind = (nmv-1) * MIN( (indices[xr]-1 ), maxExp )
+ exp - 1;
*oStk = PTR_AW( hdTmp[ ind ]);
}
else
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = 0;
*wStk = xr;
*eStk = exp;
}
*p = 0;
}
}
*p += nmv;
if ( *p < indices[ ug ] )
continue;
*p -= indices[ ug ];
if ( ! ISID_AW( powers[ ug ] ) )
{
sP++; oStk++; wStk++; eStk++;
if ( sP > stkDim )
return FALSE;
*oStk = PTR_AW( powers[ ug ] );
}
}
}
return TRUE;
}
/*--------------------------------------------------------------------------\
| Dispatcher for collection routines |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F ExpandStack( <hdGrp> ) . . . . . . . . . . expands the collection-stack
**
** 'ExpandStack' expand the stacks for the collection-process which are
** stored in the internal group record in 'STACKS'.
*/
void ExpandStack ( hdGrp )
TypHandle hdGrp;
{
TypHandle hdStk;
long i, plus;
/** Expand the stacks size by <plus>. **********************************/
plus = NUMBER_OF_GENS( hdGrp ) * ( INDICES( hdGrp )[ 0 ] + 2 );
/** The stacks are either of type T_STRING, T_INTPOS or T_INTNEG. ******/
for ( i = LEN_LIST( HD_STACKS( hdGrp ) ); i > 0; i-- )
{
hdStk = PTR( HD_STACKS( hdGrp ) )[ i ];
switch ( TYPE( hdStk ) )
{
case T_STRING:
Resize( hdStk, SIZE( hdStk ) + plus * sizeof( TypSword* ) );
break;
case T_INTNEG:
Resize( hdStk, SIZE( hdStk ) + plus * SIZE_SWORD );
break;
case T_INTPOS:
Resize( hdStk, SIZE( hdStk ) + plus * SIZE_EXP );
break;
default:
ClearCollectExponents( hdGrp );
Error( "ExpandStacks: cannot expand (type=%d, group = %d)",
(long) TYPE( hdStk ),
(long) hdGrp );
break;
}
}
}
/****************************************************************************
**
*F Collect( <exp>, <bup>, <wrd> ) . . . . . . . . . collects <exp> * <wrd>
**
** Let <exp> be an exponent-vector and <bup> either NULL or the agword
** given by <exp>. Let <wrd> be an agword.
**
** 'Collect' computes the product of <exp> and <wrd>. This routine looks
** which collector is initialized and starts the collecting process. If the
** stack wasn't big enough, 'Collect' expands the stacks and tries it again.
** In that case <exp> must be restored either using the backup word <bup>
** or an internal copy, if <bup> is NULL. The result is stored as exponent
** vector in the array <exp>.
**
** Note that 'Colllect' must never call itself recursivly, because one stack
** is used to save the exponent vector of <exp>.
*/
void Collect ( hdExp, hdBup, hdWrd )
TypHandle hdExp, hdWrd, hdBup;
{
TypHandle hdSave = 0;
TypSword * ptBup;
TypExp * ptNew, * ptOld, * ptExp;
boolean success;
long i;
boolean (* collector) P(( TypExp*, TypHandle ));
# if AG_PROFILE
long t1 = 0;
long t2 = 0;
extern long CPN;
extern boolean CPP;
extern TypHandle HdCPL, HdCPC;
# endif
# if AG_PROFILE
if ( CPP )
PTR(HdCPC)[CPN] = INT_TO_HD(HD_TO_INT(PTR(HdCPC)[CPN])+1);
# endif
/** If the agword <hdWrd> is trivial, there is nothing to collect. *****/
if ( ISID_AW( hdWrd ) )
return;
/** Start profiling, this should not time new bags. *******************/
# if AG_PROFILE
if ( CPP )
t1 = SyTime();
# endif
if ( hdExp == 0 )
{
SetCollectExponents( hdBup );
hdExp = HD_COLLECT_EXPONENTS( * PTR( hdBup ) );
}
/** If the collect-stack wasn't big enough, the stacks are expanded **/
/** using 'ExpandStack'. To repeat the collection in this case, **/
/** the exponent-vector <hdExp> must be saved as it is destoryed **/
/** during the collection process. If a backup agword <hdBup> was **/
/** already given nothing has to be done. **/
if ( hdBup == 0 )
{
hdSave = HD_SAVE_EXPONENTS( * PTR( hdWrd ) );
ptNew = (TypExp*) PTR( hdSave );
ptOld = (TypExp*) PTR( hdExp );
for ( i = SIZE( hdExp ) / SIZE_EXP; i > 0; --i )
*( ptNew++ ) = *( ptOld++ );
}
/** Find the collector, which should be used. **************************/
i = COLLECTOR( * PTR( hdWrd ) );
if ( i > COMBI_COLLECTOR )
{
ClearCollectExponents( *PTR( hdWrd ) );
Error( "AgWord collector: unknown collector", 0L, 0L );
}
collector = Collectors[ i ].collect;
/** Collect and expand the stack until collection is successfull. ******/
# if AG_PROFILE
if ( CPP )
t1 = SyTime() - t1;
# endif
do
{
# if AG_PROFILE
if ( CPP )
t2 = SyTime();
# endif
ptExp = (TypExp*) PTR( hdExp );
success = collector( ptExp, hdWrd );
/** If the stack was not big enough, expand it and try again. ******/
if ( ! success )
{
ExpandStack( *PTR( hdWrd ) );
if ( hdBup == 0 )
{
ptNew = (TypExp*) PTR( hdExp );
ptOld = (TypExp*) PTR( hdSave );
for ( i = SIZE( hdSave ) / SIZE_EXP; i > 0; --i )
*( ptNew++ ) = *( ptOld++ );
}
else
{
ptNew = (TypExp*) PTR( hdExp );
for ( i = SIZE( hdExp ) / SIZE_EXP; i > 0; --i )
*( ptNew++ ) = 0;
ptNew = (TypExp*) PTR( hdExp );
for ( ptBup = PTR_AW( hdBup ); *ptBup != -1; ptBup += 2 )
ptNew[ (long)( *ptBup ) ] = *( ptBup + 1 );
}
}
}
while ( ! success );
# if AG_PROFILE
if ( CPP )
{
t2 = SyTime() - t2;
PTR( HdCPL )[ CPN ] = INT_TO_HD( HD_TO_INT( ELM_LIST( HdCPL,
CPN ) ) + t1 + t2 );
}
# endif
}
/****************************************************************************
**
*F AgSolution( <a>, <b> ) . . . . . . . . . . . . solution of <a> * x = <b>
**
** 'AgSolution' returns the agword <a>^-1 * <b>, which is a solution of the
** equation <a> * x = <b>.
*/
TypHandle AgSolution ( hdA, hdB )
TypHandle hdA;
TypHandle hdB;
{
TypHandle hdX, hdW, hdG, hdGrp;
TypExp e, ea, eb;
TypSword dx, db;
TypSword * pt;
long i, len;
hdGrp = * PTR( hdA );
/** copy <a> into the collector array and get the composition length ***/
SetCollectExponents( hdA );
hdW = HD_COLLECT_EXPONENTS( hdGrp );
len = NUMBER_OF_GENS( hdGrp );
/** <g> will be an one generator word, while <x> is the result. ********/
hdX = NewBag( T_AGWORD, (1 + 2 * len) * SIZE_SWORD + SIZE_HD );
*PTR( hdX ) = hdGrp;
hdG = NewBag( T_AGWORD, SIZE_HD + 3 * SIZE_SWORD );
*PTR( hdG ) = hdGrp;
PTR_AW( hdG )[ 2 ] = -1;
/** Loop over all exponents starting with the first ********************/
dx = db = 0;
for ( i = 0; i < len; i++ )
{
/** Get the <i>.th exponent of <a> and <b>. ************************/
ea = ( (TypExp*) PTR( hdW ) )[ i ];
pt = PTR_AW( hdB ) + db;
if ( pt[0] == i )
{
eb = pt[1];
db += 2;
}
else
eb = 0;
/** Collect difference into <hdW>. *********************************/
e = eb - ea;
if ( e != 0 )
{
if ( e < 0 )
e += INDICES( hdGrp )[ i ];
PTR_AW( hdG )[0] = PTR_AW( hdX )[ dx++ ] = i;
PTR_AW( hdG )[1] = PTR_AW( hdX )[ dx++ ] = e;
Collect( hdW, 0, hdG );
}
}
PTR_AW( hdX )[ dx ] = -1;
Resize( hdX, SIZE_HD + ( dx + 1 ) * SIZE_SWORD );
ClearCollectExponents( * PTR( hdA ) );
return hdX;
}
/****************************************************************************
**
*F AgSolution2( <a>, <b>, <c>, <d> ) . . . solution of <a>*<b> * x = <c>*<d>
**
** 'AgSolution' returns <a>^-1*<b>^-1*<c>*<d>, which is a solution of the
** equation <a>*<b> * x = <c>*<d>.
*/
TypHandle AgSolution2 ( hdA, hdB, hdC, hdD )
TypHandle hdA;
TypHandle hdB;
TypHandle hdC;
TypHandle hdD;
{
TypHandle hdX, hdW, hdV, hdG, hdGrp, hdCD;
TypExp e, ea, eb, ec, * ptV, * ptW, * ptEnd;
TypSword dx, dc;
TypSword * pt;
long i, len, p;
hdGrp = * PTR( hdA );
len = NUMBER_OF_GENS( hdGrp );
/** Convert <a> and <c> into exponent vector form and reduce them. *****/
SetCollectExponents( hdC );
hdW = HD_COLLECT_EXPONENTS( hdGrp );
hdV = HD_COLLECT_EXPONENTS_2( hdGrp );
ptV = (TypExp*) PTR( hdV );
ptEnd = (TypExp*)( (char*) ptV + SIZE( hdV ) );
while ( ptV < ptEnd )
*ptV++ = 0;
ptV = (TypExp*) PTR( hdV );
pt = PTR_AW( hdA );
for ( ; pt[0] != -1; pt += 2 )
ptV[ pt[0] ] = pt[1];
ptW = (TypExp*) PTR( hdW );
ptEnd = ptW + len;
while ( ptW < ptEnd && *ptW == *ptV )
{
*ptW++ = 0;
*ptV++ = 0;
}
/** Collect <c>*<d>, <a> is in <v>, copy <b> into <w>. *****************/
Collect( hdW, 0, hdD );
hdCD = AgWordAgExp( HD_COLLECT_EXPONENTS( hdGrp ), hdGrp );
SetCollectExponents( hdB );
hdW = HD_COLLECT_EXPONENTS( hdGrp );
/** <g> will be an one generator word, while <x> is the result. ********/
hdX = NewBag( T_AGWORD, (1 + 2 * len) * SIZE_SWORD + SIZE_HD );
*PTR( hdX ) = hdGrp;
hdG = NewBag( T_AGWORD, SIZE_HD + 3 * SIZE_SWORD );
*PTR( hdG ) = hdGrp;
PTR_AW( hdG )[ 2 ] = -1;
/** Loop over all exponents starting with the first ********************/
dx = dc = 0;
for ( i = 0; i < len; i++ )
{
/** Get the <i>.th exponent of <a>, <b> and <c>*<d>. ***************/
ea = ( (TypExp*) PTR( hdV ) )[ i ];
eb = ( (TypExp*) PTR( hdW ) )[ i ];
pt = PTR_AW( hdCD ) + dc;
if ( pt[0] == i )
{
ec = pt[1];
dc += 2;
}
else
ec = 0;
/** Collect difference into <hdW>, result then into <hdV>. *********/
e = ec - ( ea + eb );
p = INDICES( hdGrp )[ i ];
while ( e < 0 ) e += p;
while ( e >= p ) e -= p;
if ( e != 0 )
{
PTR_AW( hdG )[0] = PTR_AW( hdX )[ dx++ ] = i;
PTR_AW( hdG )[1] = PTR_AW( hdX )[ dx++ ] = e;
Collect( hdW, 0, hdG );
}
e = ( (TypExp*) PTR( hdW ) )[ i ];
if ( e != 0 )
{
PTR_AW( hdG )[0] = i;
PTR_AW( hdG )[1] = e;
Collect( hdV, 0, hdG );
}
}
PTR_AW( hdX )[ dx ] = -1;
Resize( hdX, SIZE_HD + ( dx + 1 ) * SIZE_SWORD );
ClearCollectExponents( * PTR( hdA ) );
return hdX;
}
/*--------------------------------------------------------------------------\
| Initializing routines for the different collectors. |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F InitSingle( <hdCall> ) . . . . . . . initializes the "single"-collector
**
** 'FunSetCollector( <hdAgWord>, "single" )'
*/
void InitSingle ( hdCall, nr )
TypHandle hdCall;
long nr;
{
TypHandle hdAgGroup, hdList, hdAgWord, hdGenJ, hdRnName;
long nrGens, i, j;
/** Evaluate and check the arguments. **********************************/
if ( SIZE( hdCall ) > 3 * SIZE_HD )
Error( "usage: SetCollectorAgWord( <agword>, \"single\" )", 0L, 0L );
hdAgWord = EVAL( PTR( hdCall )[ 1 ] );
hdAgGroup = *PTR( hdAgWord );
if ( COLLECTOR( hdAgGroup ) == SINGLE_COLLECTOR )
return;
/** Clear the old collector, set the used record names. ****************/
SaveAndClearCollector( hdAgGroup );
hdRnName = FindRecname( "stacks" );
PTR( hdAgGroup )[ NR_STACKS - 1 ] = hdRnName;
hdRnName = FindRecname( "conjugates" );
PTR( hdAgGroup )[ NR_CONJUGATES - 1 ] = hdRnName;
nrGens = NUMBER_OF_GENS( hdAgGroup );
SetAvecAgGroup( hdAgGroup, 0, NUMBER_OF_GENS(hdAgGroup)-1 );
/** Set the 'SINGLE_COLLECTOR' for the "single"-collector. *********/
HD_COLLECTOR( hdAgGroup ) = INT_TO_HD( SINGLE_COLLECTOR );
/** Allocate the four stacks for collecting. **************************/
SetStacksAgGroup( hdAgGroup );
/** Compute the conjugates $g_j ^ g_i$ for $1 <= i < j <= nrGens$. So **/
/** we need a list with $1 + ... + nrGens - 1$ entries. **/
hdList = NewBag( T_LIST, ( nrGens * ( nrGens - 1 ) / 2 + 1 ) * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( nrGens * ( nrGens - 1 ) / 2 );
HD_CONJUGATES( hdAgGroup ) = hdList;
/** It is necessary to compute the conjugates beginning with last **/
/** one, as we need those conjugates during the collection process. **/
for ( i = nrGens - 2; i >= 0; i-- )
for ( j = nrGens - 1; j > i; j-- )
{
/** Compute the conjugate $g_j ^ g_i$ only if $j$ is less **/
/** 'AVEC[ i ]' as otherwise they commute. **/
if ( j < AVEC( hdAgGroup )[ i ] )
{
hdGenJ = GENERATORS( hdAgGroup )[ j ];
/** Get the commutator $[ g_j, g_i ]$. *********************/
hdAgWord = COMMUTATORS( hdAgGroup )[ IND( j, i ) ];
if ( ISID_AW( hdAgWord ) )
/** The commutator is trivial, so $g_j ^ g_i = g_j$. ***/
hdAgWord = hdGenJ;
else
/** The commutator is not trivial, but we can get the **/
/** conjugated word $g_j ^ g_i$ collection the word **/
/** $g_j * [ g_j, g_i ]$. **/
hdAgWord = ProdAg( hdGenJ, hdAgWord );
}
else
hdAgWord = GENERATORS( hdAgGroup )[ j ];
/** Store the conjugate in the group record. *******************/
CONJUGATES( hdAgGroup )[ IND( j, i ) ] = hdAgWord;
}
}
/****************************************************************************
**
*F InitTriple( <hdAgGroup>, <maxExp> ) . initializes the "triple"-collector
**
** 'SetCollectorAgWord( <agword>, "triple" )'
** 'SetCollectorAgWord( <agword>, "triple", <tupleBound> )'
*/
void InitTriple ( hdCall, nr )
TypHandle hdCall;
long nr;
{
TypHandle hdAgGroup, hdAgWord, hdInt, hdRnName;
TypHandle hdGenI, hdGenJ, hdList, hdComm, hdTrip, hdTmp;
TypHandle hdOld, hdAvec;
long nrGens, expI, maxExp;
long i, j, k;
/** Evaluate and check the arguments. **********************************/
if ( SIZE( hdCall ) > 4 * SIZE_HD )
Error( "usage: SetCollectorAgWord( <agword>, \"triple\" )", 0L, 0L );
hdAgWord = EVAL( PTR( hdCall )[ 1 ] );
hdAgGroup = *PTR( hdAgWord );
if ( SIZE( hdCall ) == 4 * SIZE_HD )
{
hdInt = EVAL( PTR( hdCall )[ 3 ] );
if ( TYPE( hdInt ) != T_INT )
Error(
"usage: SetCollectorAgWord( <agword>, \"triple\", <bound> )",
0L, 0L );
maxExp = HD_TO_INT( hdInt );
if ( maxExp < 1 )
Error( "SetCollectorAgWord: needs a positive <bound>. ", 0L, 0L );
}
else
maxExp = 5;
/** If neither collector nor bound must be change, return. *************/
if ( COLLECTOR( hdAgGroup ) == TRIPLE_COLLECTOR &&
maxExp == TUPLE_BOUND( hdAgGroup ) )
{
return;
}
/** At first we need the array avec. ***********************************/
hdOld = SaveAndClearCollector( hdAgGroup );
SetAvecAgGroup( hdAgGroup, 0, NUMBER_OF_GENS(hdAgGroup)-1 );
hdAvec = HD_AVEC( hdAgGroup );
RestoreCollector( hdAgGroup, hdOld );
nrGens = NUMBER_OF_GENS( hdAgGroup );
/** Compute the conjugates $g_j ^ g_i^r$ for $1 <= i < j <= nrGens$ **/
/** and store these in a list of list as **/
/** $[ ... [g_j ^ g_i, g_j ^ g_i^2, ...] ...]$ **/
hdList = NewBag( T_LIST, ( nrGens * ( nrGens - 1 ) / 2 + 1 ) * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( nrGens * ( nrGens - 1 ) / 2 );
/** Compute the conjugates $g_j ^ g_i$ using the momentary collector. **/
for ( i = nrGens - 2; i >= 0; i-- )
for ( j = nrGens - 1; j > i; j-- )
/** Compute the conjugate $g_j ^ g_i$ only if $j$ is less **/
/** 'AVEC[ i ]' as otherwise they commute. **/
if ( j < ( (long*)PTR( hdAvec ) )[ i ] )
{
hdComm = COMMUTATORS( hdAgGroup )[ IND( j, i ) ];
if ( ! ISID_AW( hdComm ) )
{
/** The commutator is not trivial, so we need to **/
/** compute the conjugates $g_j^g_i$ upto the minimun **/
/** <maxExp> and the index - 1 of $g_i$. **/
expI = MIN( INDICES( hdAgGroup )[ i ] - 1, maxExp );
hdTrip = NewBag( T_LIST, ( expI + 1 ) * SIZE_HD );
PTR( hdTrip )[ 0 ] = INT_TO_HD( expI );
PTR( hdList )[ IND( j, i ) + 1 ] = hdTrip;
/** Initialize the list with conjugate $g_j^g_i$ **/
/** using the old collector. The other conjugates are **/
/** then computed using the triple collector. **/
hdGenJ = GENERATORS( hdAgGroup )[ j ];
hdTmp = ProdAg( hdGenJ, hdComm );
PTR( hdTrip )[ 1 ] = hdTmp;
}
}
/** Clear the old collector, set the used record names. ****************/
SaveAndClearCollector( hdAgGroup );
hdRnName = FindRecname( "stacks" );
PTR( hdAgGroup )[ NR_STACKS - 1 ] = hdRnName;
hdRnName = FindRecname( "triples" );
PTR( hdAgGroup )[ NR_TRIPLES - 1 ] = hdRnName;
hdRnName = FindRecname( "tupleBound" );
PTR( hdAgGroup )[ NR_TUPLE_BOUND - 1 ] = hdRnName;
SetAvecAgGroup( hdAgGroup, 0, NUMBER_OF_GENS(hdAgGroup)-1 );
/** Set the number 'TRIPLE_COLLECTOR' for the triple-collector in the**/
/** internal group-bag and allocate the three stacks for collecting **/
/** with the triple collector. Set the maximal exponent for tuples. **/
/** Bind the list of already computed conjugates to 'CONJUGATES'. **/
HD_COLLECTOR( hdAgGroup ) = INT_TO_HD( TRIPLE_COLLECTOR );
HD_TUPLE_BOUND( hdAgGroup ) = INT_TO_HD( maxExp );
HD_TRIPLES( hdAgGroup ) = hdList;
SetStacksAgGroup( hdAgGroup );
/** Now compute $g_j ^ g_i^r$ for $r >1$ using the triple collector. ***/
for ( i = nrGens - 2; i >= 0; i-- )
for ( j = nrGens - 1; j > i; j-- )
/** Compute the conjugate $g_j ^ g_i$ only if $j$ is less **/
/** 'AVEC[ i ]' as otherwise they commute. **/
if ( j < AVEC( hdAgGroup )[ i ] )
{
hdComm = COMMUTATORS( hdAgGroup )[ IND( j, i ) ];
if ( ! ISID_AW( hdComm ) )
{
/** The commutator $[g_j, g_i]$ is not trivial. ********/
expI = MIN( INDICES( hdAgGroup )[ i ] - 1, maxExp );
hdTrip = TRIPLES( hdAgGroup )[ IND( j, i ) ];
/** Now compute $x := g_i^-1 * x * g_i$. Starting **/
/** with $x = g_j ^ g_i$. **/
hdGenI = GENERATORS( hdAgGroup )[ i ];
hdTmp = PTR( hdTrip )[ 1 ];
for ( k = 1; k < expI; k++ )
{
hdTmp = AgSolution( hdGenI, hdTmp );
hdTmp = ProdAg( hdTmp, hdGenI );
PTR( hdTrip )[ k + 1 ] = hdTmp;
}
}
}
}
/****************************************************************************
**
*F InitQuadr( <hdCall> ) . . . . . . . . . initializes "quadruple"-collector
**
** 'SetCollectorAgWord( <agword>, "quadruple" )'
** 'SetCollectorAgWord( <agword>, "quadruple", <tupleBound> )'
*/
void InitQuadr ( hdCall, nr )
TypHandle hdCall;
long nr;
{
TypHandle hdAgGroup, hdAgWord, hdRnName, hdInt;
TypHandle hdTmp, hdQuadr, hdList, hdComm, hdOld, hdAvec;
TypHandle hdGenI, hdGenJ;
long i, j, k, l;
long expI, expJ, ind, nrGens, maxExp;
/** Evaluate and check the arguments. **********************************/
if ( SIZE( hdCall ) > 4 * SIZE_HD )
Error(
"usage: SetCollectorAgWord( <agword>, \"quadruple\" )", 0L, 0L );
hdAgWord = EVAL( PTR( hdCall )[ 1 ] );
hdAgGroup = *PTR( hdAgWord );
if ( SIZE( hdCall ) == 4 * SIZE_HD )
{
hdInt = EVAL( PTR( hdCall )[ 3 ] );
if ( TYPE( hdInt ) != T_INT )
Error(
"usage: SetCollectorAgWord( <agword>, \"quadruple\", <bound> )",
0L, 0L );
maxExp = HD_TO_INT( hdInt );
if ( maxExp < 1 )
Error( "SetCollectorAgWord: needs a positive <bound>. ", 0L, 0L );
}
else
maxExp = 5;
/** If neither collector nor bound must be change, return. *************/
if ( COLLECTOR( hdAgGroup ) == QUADR_COLLECTOR &&
maxExp == TUPLE_BOUND( hdAgGroup ) )
{
return;
}
/** At first we need the array avec. ***********************************/
hdOld = SaveAndClearCollector( hdAgGroup );
SetAvecAgGroup( hdAgGroup, 0, NUMBER_OF_GENS(hdAgGroup)-1 );
hdAvec = HD_AVEC( hdAgGroup );
RestoreCollector( hdAgGroup, hdOld );
nrGens = NUMBER_OF_GENS( hdAgGroup );
/** Compute the conjugates $g_j^s ^ g_i^r$ for $1 <= 1 < j <= nrGens$ **/
/** and store these in a list as **/
/** $[ ..., [ g_j^g_i, g_j^2^g_i, ..., g_j^g_i^2, ...], ...]$ **/
hdList = NewBag( T_LIST, ( nrGens * ( nrGens - 1 ) / 2 + 1 ) * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( nrGens * ( nrGens - 1 ) / 2 );
for ( i = nrGens - 2; i >= 0; i-- )
for ( j = nrGens - 1; j > i; j-- )
/** Compute the conjugate $g_j ^ g_i$ only if $j$ is less **/
/** 'AVEC[ i ]' as otherwise they commute. **/
if ( j < ( (long*)PTR( hdAvec ) )[ i ] )
{
hdComm = COMMUTATORS( hdAgGroup )[ IND( j, i ) ];
if ( ! ISID_AW( hdComm ) )
{
/** Compute the conjugates $g_j^r ^ g_i^s$ upto the **/
/** mininum of <maxExp> and the index-1 of the gens. **/
expI = MIN( INDICES( hdAgGroup )[ i ] - 1, maxExp );
expJ = MIN( INDICES( hdAgGroup )[ j ] - 1, maxExp );
/** Allocate a list, that will hold the conjugates. ****/
hdQuadr = NewBag( T_LIST, ( expI*expJ+1 ) * SIZE_HD );
PTR( hdQuadr )[ 0 ] = INT_TO_HD( expI * expJ );
PTR( hdList )[ IND( j, i ) + 1 ] = hdQuadr;
/** Initialize the list with the conj. $g_j^r ^ g_i$ **/
/** for $r = 1, ..., expJ$. These words are computed **/
/** with old collector. The other conjugates are then **/
/** collected using the quadruple collector. **/
hdGenJ = GENERATORS( hdAgGroup )[ j ];
/** Start with $g_j * [ g_j, g_i ] = g_j ^ g_i$. *******/
hdAgWord = ProdAg( hdGenJ, hdComm );
PTR( hdQuadr )[ 1 ] = hdAgWord;
/** Compute $(g_j ^ g_i)^l = g_j^l ^ g_i$. *************/
hdTmp = hdAgWord;
for ( k = 1; k < expJ; k++ )
{
hdTmp = ProdAg( hdTmp , hdAgWord );
PTR( hdQuadr )[ k + 1 ] = hdTmp;
}
}
}
/** Clear the old collector, set the used record names. ****************/
SaveAndClearCollector( hdAgGroup );
hdRnName = FindRecname( "stacks" );
PTR( hdAgGroup )[ NR_STACKS - 1 ] = hdRnName;
hdRnName = FindRecname( "quadruples" );
PTR( hdAgGroup )[ NR_QUADRUPLES - 1 ] = hdRnName;
hdRnName = FindRecname( "tupleBound" );
PTR( hdAgGroup )[ NR_TUPLE_BOUND - 1 ] = hdRnName;
SetAvecAgGroup( hdAgGroup, 0, NUMBER_OF_GENS(hdAgGroup)-1 );
/** Set the number 'QUADR_COLLECTOR' for the quadruple collector in **/
/** internal group-bag and allocate the three stacks for collecting **/
/** with the quadruple collector. Set the maximal exponent for **/
/** tuples. Bind the list of already computed conjugates to **/
/** 'CONJUGATES'. **/
HD_COLLECTOR( hdAgGroup ) = INT_TO_HD( QUADR_COLLECTOR );
HD_TUPLE_BOUND( hdAgGroup ) = INT_TO_HD( maxExp );
HD_QUADRUPLES( hdAgGroup ) = hdList;
SetStacksAgGroup( hdAgGroup );
/** Now compute the remaining quadruples $g^j^r ^ g_i^s$ using the **/
/** quadruple-collector. **/
for ( i = nrGens - 2; i >= 0; i-- )
for ( j = nrGens - 1; j > i; j-- )
/** Compute the conjugate $g_j ^ g_i$ only if $j$ is less **/
/** 'AVEC[ i ]' as otherwise they commute. **/
if ( j < AVEC( hdAgGroup )[ i ] )
{
hdComm = COMMUTATORS( hdAgGroup )[ IND( j, i ) ];
if ( ! ISID_AW( hdComm ) )
{
/** Commutator is not trivial. *************************/
expI = MIN( INDICES( hdAgGroup )[ i ] - 1, maxExp );
expJ = MIN( INDICES( hdAgGroup )[ j ] - 1, maxExp );
hdQuadr = QUADRUPLES( hdAgGroup )[ IND( j, i ) ];
/** Construct the generate $g_i$, which will be used **/
/** to conjugated the already computed list: **/
/** $[ g_j ^ g_i, g_j^2 ^ g_i, g_j^3 ^ g_i, ... ] **/
hdGenI = GENERATORS( hdAgGroup )[ i ];
/** <ind> will be used as index to the list <hdQuadr> **/
/** <expJ> many conjugates are already computed. **/
ind = expJ;
hdAgWord = PTR( hdQuadr )[ 1 ];
for ( k = 1; k < expI; k++ )
{
hdTmp = AgSolution( hdGenI, hdAgWord );
hdAgWord = ProdAg( hdTmp, hdGenI );
PTR( hdQuadr )[ ind++ + 1 ] = hdAgWord;
hdTmp = hdAgWord;
for ( l = 1; l < expJ; l++ )
{
hdTmp = ProdAg( hdTmp, hdAgWord );
PTR( hdQuadr )[ ind++ + 1 ] = hdTmp;
}
}
}
}
}
/****************************************************************************
**
*F InitCombinatorial( <hdCall> ) . . . . . . . initializes p-group collector
**
** 'SetCollectorAgWord( <agword>, "combinatorial" )'
**
** Add the entries 'CWEIGHTS' and 'CSERIES' to the group bag <hdAgGrp>. The
** entry 'CWEIGHTS' is of T_AGLIST, an array of integer $c_i$ such that the
** $i$.th generator has weight $c_i$ with respect to the central series. The
** entry 'CSERIES' describes this central series in the following way.
** CSERIES[ 0 ] is the p-class of the group,
** CSERIES[ i ] is the number of the last generator in class i.
** 'CSERIES' is an array of longs.
**
** The entry 'COLLECTOR'is set to 'COMBI_COLLECTOR', while 'STACKS' is set
** in 'SetStacksAgGroup'.
**
** No error is raised but the collector of the group is left unchanged, if
** the combinatorial collector could no be initialized. In that case only
** a warning is printed.
*/
void InitCombinatorial ( hdCall, nr )
TypHandle hdCall;
long nr;
{
TypHandle hdWrd, hdGrp, hdOld;
char *usage1 = "SetCollectorAgWord( <g>, \"combinatorial\" )";
char *usage2 = "SetCollectorAgWord( <g>, \"vaughanlee\" )";
/** Evaluate and check the arguments. **********************************/
if ( nr == LEE_COLLECTOR )
{
if ( SIZE( hdCall ) != 3 * SIZE_HD )
Error( "usage: %s", (long) usage2, 0L );
hdWrd = EVAL( PTR( hdCall )[ 1 ] );
hdGrp = *PTR( hdWrd );
if ( COLLECTOR( hdGrp ) == LEE_COLLECTOR )
return;
}
else
{
if ( SIZE( hdCall ) != 3 * SIZE_HD )
Error( "usage: %s", (long) usage1, 0L );
hdWrd = EVAL( PTR( hdCall )[ 1 ] );
hdGrp = *PTR( hdWrd );
if ( COLLECTOR( hdGrp ) == COMBI_COLLECTOR
|| COLLECTOR( hdGrp ) == COMBI2_COLLECTOR )
{
return;
}
}
/** Save the old collector, if the combinatorial one could not init. **/
hdOld = SaveAndClearCollector( hdGrp );
/** Try to find a central series. **************************************/
if ( ! SetCWeightsAgGroup( hdGrp, HdVoid ) )
{
Pr( "SetCollectorAgWord: leaves collector unchanged.\n", 0L, 0L );
RestoreCollector( hdGrp, hdOld );
return;
}
/** Set combinatorial collector. **************************************/
if ( nr == LEE_COLLECTOR )
HD_COLLECTOR( hdGrp ) = INT_TO_HD( LEE_COLLECTOR );
else
{
if ( INDICES( hdGrp )[ 0 ] == 2 )
HD_COLLECTOR( hdGrp ) = INT_TO_HD( COMBI2_COLLECTOR );
else
HD_COLLECTOR( hdGrp ) = INT_TO_HD( COMBI_COLLECTOR );
}
/** Allocate the stacks for collecting with combinatorial-collector **/
SetStacksAgGroup( hdGrp );
}
/*--------------------------------------------------------------------------\
| read and evaluate relations |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F EvalRhs( <hdAgGroup>, <gen1>, <gen2> ) . . collects a rhs of a relation
**
** 'EvalRhs' evaluates a right-hand-side of a relation. If <gen1> = <gen2>
** this relation is the power-relation of gen1, otherwise this relation is
** the commutator [ <gen1>, <gen2> ]. The evaluate word is stored in the
** internal group record <hdAgGroup>.
*/
void EvalRhs ( hdAgGroup, gen1, gen2 )
TypHandle hdAgGroup;
long gen1, gen2;
{
TypHandle hdRel, hdEvalRel, hdGen;
long i, lenRel, genNr;
/** Power or Commutator relation. **************************************/
if ( gen1 == gen2 )
hdRel = POWERS( hdAgGroup )[ gen1 ];
else
hdRel = COMMUTATORS( hdAgGroup )[ IND( gen1, gen2 ) ];
/** If the relator isn't trivial, eval it. Do NOT use 'ISID_AW', as **/
/** <hdRel> is a T_AGLIST not a T_AGWORD! **/
hdEvalRel = HD_IDENTITY( hdAgGroup );
if ( hdRel != 0 )
{
/** Run through the generators of the <hdRel> and collect them. ****/
lenRel = SIZE( hdRel ) / SIZE_SWORD;
for ( i = 0; i < lenRel; i += 2 )
{
if ( ( (TypSword*) PTR( hdRel ) )[ i + 1 ] == 0 )
continue;
if ( ( (TypSword*) PTR( hdRel ) )[ i ] <= gen2 )
{
if ( gen1 == gen2 )
Error(
"AgFpGroup: %s^%d contains an illegal generator",
(long) NAME_AW( hdAgGroup, gen1 ),
(long) ((TypSword*)PTR(hdRel)[i+1]) );
else
Error(
"AgFpGroup: [%s,%s] contains an illegal generator",
(long) NAME_AW( hdAgGroup, gen1 ),
(long) NAME_AW( hdAgGroup, gen2 ) );
}
else
{
genNr = ( (TypSword*) PTR( hdRel ) )[ i ];
hdGen = GENERATORS( hdAgGroup )[ genNr ];
hdEvalRel = ProdAg( hdEvalRel, PowAgI( hdGen,
INT_TO_HD( ( (TypSword*) PTR( hdRel ) )[ i + 1 ] ) ) );
}
}
}
if ( ISID_AW( hdEvalRel ) )
hdEvalRel = HD_IDENTITY( hdAgGroup );
if ( gen1 == gen2 )
POWERS( hdAgGroup )[ gen1 ] = hdEvalRel;
else
COMMUTATORS( hdAgGroup )[ IND( gen1, gen2 ) ] = hdEvalRel;
}
/****************************************************************************
**
*F EvalGenRels( <hdAgGroup>, <genNr> ) . . evaluates the relations of a gen
**
** 'EvalRelation' evaluates the right-hand-sides of the power-relation and
** all commutators [ g_j, g_<genNr> ] with j > <genNr>. For use in the
** Soicher-Collector it updates the array 'AVEC' and stores the conjugates
** g_j ^ g_<genNr> in the internal group record <hdAgGroup>.
*/
void EvalGenRels ( hdAgGroup, genNr )
TypHandle hdAgGroup;
long genNr;
{
TypHandle hdGenJ, hdTmp, hdComm;
long nrGens;
long i, j;
nrGens = NUMBER_OF_GENS ( hdAgGroup );
/** Check the power of <genNr> in the ag-presentation, at least the **/
/** index must be known. **/
if ( INDICES( hdAgGroup )[ genNr ] == 0 )
Error( "AgGroupFpGroup: the index of generator %s is unknown",
(long) NAME_AW( hdAgGroup, genNr ), 0L );
/** Now collect the rhs of the relations for the generator g_<nrGen>. **/
for ( i = nrGens - 1; i >= genNr; i-- )
EvalRhs( hdAgGroup, i, genNr );
/** Update or initialize the array 'AVEC'. *****************************/
SetAvecAgGroup( hdAgGroup, genNr, genNr );
/** Compute the 'CONJUGATES' for this generator. ***********************/
for ( j = nrGens - 1; j > genNr; j-- )
{
/** Compute conjugates only if <j> is less then 'AVEC'[ <genNr> ] **/
if ( j < AVEC( hdAgGroup )[ genNr ] )
{
hdComm = COMMUTATORS( hdAgGroup )[ IND( j, genNr ) ];
if ( ISID_AW( hdComm ) )
{
hdTmp = GENERATORS( hdAgGroup )[ j ];
}
else
{
/** g_j * [ g_j, g_<genNr> ] = g_<j> ^ g_<genNr> ***********/
hdGenJ = GENERATORS( hdAgGroup )[ j ];
hdTmp = ProdAg( hdGenJ, hdComm );
}
}
else
{
hdTmp = GENERATORS( hdAgGroup )[ j ];
}
CONJUGATES( hdAgGroup )[ IND( j, genNr ) ] = hdTmp;
}
}
/****************************************************************************
**
*F CopyRelation( <hdRel>, <hdGrp>, <nrRel> ) . . . . . . . copies a relation
**
** 'CopyRelation' copies the relation given by <hdRel> into the group record
** <hdAgGroup>. This relation must either be a power-relation g_i ^ e_i / w,
** a commutator-relation [g_i,g_j] / w or a conjugate-relation g_i^g_j / w.
** The power-relations or conjugate-relation are always be transformed into
** a commutator-relation [g_i, g_j] / w with i > j.
** The right hand side w of the relation is stored in the internal group
** record <hdGrp> at 'POWERS' or 'COMMUTATORS'
**
** It is possible, that the stored word w is NOT in normal form. It is
** normalized using 'EvalRelation' in 'ReadRelators'.
**
** <nrRel> is used only to give the user a hint which relations in the
** given presentation failed to be a power/commutator/conjugate relation.
*/
void CopyRelation ( hdRel, hdGrp, nrRel )
TypHandle hdRel;
TypHandle hdGrp;
long nrRel;
{
TypHandle hdAgl, hdW;
TypSword * ptAgl, * ptW;
long lnAgl, i, j, ei;
/** If <hdRel> is identity just ignore it and return. ******************/
if ( SIZE( hdRel ) / SIZE_HD == 0 )
return;
/** Convert the relator into a T_AGLIST. *******************************/
hdAgl = AgListWord( hdRel, hdGrp );
if ( hdAgl == HdFalse )
{
Error( "%d. relation is no word in '~.generators'", nrRel, 0L );
return;
}
ptAgl = (TypSword*) PTR( hdAgl );
lnAgl = ( SIZE( hdAgl ) - SIZE_SWORD ) / ( 2 * SIZE_SWORD );
/** Try to decide which of the following cases is present: **/
/** +(a) g_i ^ e_i * w e_i > 0 **/
/** (b) g_i ^ -e_i * w e_i > 0 **/
/** +(c) g_j' * g_i' * g_j * g_i * w i < j **/
/** (d) g_i' * g_j * g_i * w i < j **/
/** (e) g_i' * g_j' * g_i * w i < j **/
/** All these cases are transformed into (a) or (c). One should keep **/
/** in mind that the word w can not contain g_i. **/
/** **/
/** In order to avoid too may if's in the decision, to which case **/
/** the relation belongs, goto's are used. The labels 'lx' is the **/
/** (x). **/
if ( lnAgl < 3 && ptAgl[ 1 ] > 0 )
goto la;
if ( lnAgl < 3 && ptAgl[ 1 ] < 0 )
goto lb;
if ( ptAgl[ 1 ] != -1
|| ptAgl[ 5 ] != 1
|| ( ptAgl[ 3 ] != 1 && ptAgl[ 3 ] != -1 )
|| ptAgl[ 0 ] != ptAgl[ 4 ] )
{
if ( ptAgl[ 1 ] > 0 )
goto la;
if ( ptAgl[ 1 ] < 0 )
goto lb;
}
/** Now we know that the relator is g_j' * g_i(') * g_j * ww. **********/
if ( ptAgl[ 3 ] == 1 )
{
if ( ptAgl[ 2 ] > ptAgl[ 0 ] )
goto ld;
}
if ( ptAgl[ 3 ] == -1 )
{
if ( lnAgl >= 4
&& ptAgl[ 7 ] == 1
&& ptAgl[ 0 ] > ptAgl[ 2 ]
&& ptAgl [ 2 ] == ptAgl[ 6 ] )
{
goto lc;
}
else
{
goto le;
}
}
/** So <hdRel> is no Commutator/Conjugate/Power-relation. **************/
Error( "relation %d is no Commutator/Conjugate/Power", nrRel, 0L );
return;
/** Case (a): g_i ^ e_i * w = 1 -> g_i ^ e_i = w' **********************/
la:
i = ptAgl[ 0 ];
ei = ptAgl[ 1 ];
if ( POWERS( hdGrp )[ i ] != 0 )
goto lerror;
INDICES( hdGrp )[ i ] = ei;
hdW = NewBag( T_AGLIST, ( 2 * ( lnAgl - 1 ) + 1 ) * SIZE_SWORD );
ptW = (TypSword*) PTR( hdW ) + 2 * ( lnAgl - 1 ) - 2;
ptW[ 2 ] = -1;
ptAgl = (TypSword*) PTR( hdAgl ) + 2;
while ( *ptAgl != -1 )
{
ptW[ 0 ] = *ptAgl++;
ptW[ 1 ] = - *ptAgl++;
ptW -= 2;
}
POWERS( hdGrp )[ i ] = hdW;
return;
/** Case (b): g_i ^ -e_i * w = 1 -> g_i ^ e_i = w **********************/
lb:
i = ptAgl[ 0 ];
ei = ptAgl[ 1 ];
if ( POWERS( hdGrp )[ i ] != 0 )
goto lerror;
INDICES( hdGrp )[ i ] = -ei;
hdW = NewBag( T_AGLIST, ( 2 * ( lnAgl - 1 ) + 1 ) * SIZE_SWORD );
ptW = (TypSword*) PTR( hdW );
ptAgl = (TypSword*) PTR( hdAgl ) + 2;
while ( *ptAgl != -1 )
*ptW++ = *ptAgl++;
*ptW = -1;
POWERS( hdGrp )[ i ] = hdW;
return;
/** Case (c): i < j : [g_j, g_i] * w = 1 -> [g_j, g_i] = w' ************/
lc:
j = ptAgl[ 0 ];
i = ptAgl[ 2 ];
if ( COMMUTATORS( hdGrp )[ IND( j, i ) ] != 0 )
goto lerror;
hdW = NewBag( T_AGLIST, ( 2 * ( lnAgl - 4 ) + 1 ) * SIZE_SWORD );
ptW = (TypSword*) PTR( hdW ) + 2 * ( lnAgl - 4 ) - 2;
ptW[ 2 ] = -1;
ptAgl = (TypSword*) PTR( hdAgl ) + 8;
while ( *ptAgl != -1 )
{
ptW[ 0 ] = *ptAgl++;
ptW[ 1 ] = - *ptAgl++;
ptW -= 2;
}
COMMUTATORS( hdGrp )[ IND( j, i ) ] = hdW;
return;
/** Case (d): i < j: g_i'*g_j*g_i * w = 1 -> g_i'*g_j'*g_i = w **/
/** -> [g_i, g_j] = w * g_j -> [g_j, g_i] = g_j' * w' **/
ld:
i = ptAgl[ 0 ];
j = ptAgl[ 2 ];
if ( COMMUTATORS( hdGrp )[ IND( j, i ) ] != 0 )
goto lerror;
hdW = NewBag( T_AGLIST, ( 2 * ( lnAgl - 3 ) + 3 ) * SIZE_SWORD );
ptW = (TypSword*) PTR( hdW ) + 2 * ( lnAgl - 3 );
ptW[ 2 ] = -1;
ptAgl = (TypSword*) PTR( hdAgl ) + 6;
while ( *ptAgl != -1 )
{
ptW[ 0 ] = *ptAgl++;
ptW[ 1 ] = - *ptAgl++;
ptW -= 2;
}
ptW[ 0 ] = j;
ptW[ 1 ] = -1;
COMMUTATORS( hdGrp )[ IND( j, i ) ] = hdW;
return;
/** Case (e): i < j: g_i'*g_j'*g_i * w = 1 -> g_i'*g_j'*g_i = w' **/
/** -> g_i'*g_j*g_i = w -> [g_j, g_i] = g_j' * w **/
le:
i = ptAgl[ 0 ];
j = ptAgl[ 2 ];
if ( COMMUTATORS( hdGrp )[ IND( j, i ) ] != 0 )
goto lerror;
hdW = NewBag( T_AGLIST, ( 2 * ( lnAgl - 3 ) + 3 ) * SIZE_SWORD );
ptW = (TypSword*) PTR( hdW );
ptW[ 0 ] = j;
ptW[ 1 ] = -1;
ptW += 2;
ptAgl = (TypSword*) PTR( hdAgl ) + 6;
while ( *ptAgl != -1 )
*ptW++ = *ptAgl++;
*ptW = -1;
COMMUTATORS( hdGrp )[ IND( j, i ) ] = hdW;
return;
/** If the handle of 'POWERS' or 'COMMUTATORS' was not empty, raise **/
/** an error. **/
lerror:
Error( "relation %d was already defined", nrRel, 0L );
}
/****************************************************************************
**
*F ReadRelators( <R>, <G> ) . . . . . . . . . . reads relator <R> into <G>
**
** 'ReadRelators' reads all relators, which are expected in a list
** '<R>.relators (or '<R>.relations'). It allocates all necessary
** stacks for collecting, with the 'SINGLE_COLLECTOR', transforms the
** relatores into normal form and stores them in the internal
** group-record <G> in '<G>[POWERS]' and '<G>[COMMUTATORS]'.
*/
void ReadRelators ( hdRec, hdG )
TypHandle hdRec, hdG;
{
TypHandle hdRels, hdTmp, hdRn;
TypHandle * ptRec, * ptEnd;
TypSword len;
long i, lnR;
len = NUMBER_OF_GENS( hdG );
/** Find '<R>.relators' or '<R>.relations'. ****************************/
hdRn = FindRecname( "relators" );
ptRec = PTR( hdRec );
ptEnd = (TypHandle*)( (char*) ptRec + SIZE( hdRec ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRn )
ptRec += 2;
if ( ptRec == ptEnd )
{
hdRn = FindRecname( "relations" );
ptRec = PTR( hdRec );
ptEnd = (TypHandle*)( (char*) ptRec + SIZE( hdRec ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRn )
ptRec += 2;
}
if ( ptRec == ptEnd )
Error( "AgGroupFpGroup: no '~.relators'.", 0L, 0L );
hdRels = ptRec[ 1 ];
if ( ! IsList( hdRels ) )
Error( "AgGroupFpGroup: no list '~.relators'.", 0L, 0L );
lnR = LEN_LIST( hdRels );
/** Init 'POWERS', 'COMMUTATORS', 'INDICES'and 'CONJUGATES'. ***********/
hdTmp = NewBag( T_LIST, ( len + 1 ) * SIZE_HD );
PTR( hdTmp )[ 0 ] = INT_TO_HD( len );
HD_POWERS( hdG ) = hdTmp;
hdTmp = NewBag( T_LIST, ( len * ( len - 1 ) / 2 + 1 ) * SIZE_HD );
PTR( hdTmp )[ 0 ] = INT_TO_HD( len * (len - 1 ) / 2 );
HD_COMMUTATORS( hdG ) = hdTmp;
hdTmp = NewBag( T_LIST, ( len * ( len - 1 ) / 2 + 1 ) * SIZE_HD );
PTR( hdTmp )[ 0 ] = INT_TO_HD( len * (len - 1 ) / 2 );
HD_CONJUGATES( hdG ) = hdTmp;
hdTmp = NewBag( T_INTPOS, len * sizeof( long ) );
HD_INDICES( hdG ) = hdTmp;
/** Set 'SINGLE_COLLECTOR' and install the stacks. *********************/
HD_COLLECTOR( hdG ) = INT_TO_HD( SINGLE_COLLECTOR );
SetStacksAgGroup( hdG );
/** Check the relations and copy them into the group bag. **************/
for ( i = lnR; i > 0; i-- )
if ( PTR( hdRels )[ i ] != 0 )
CopyRelation( PTR( hdRels )[ i ], hdG, i+1 );
/** Transform the relations into normal form, that must be done **/
/** bottom up in order to allow collecting with lower generators. **/
for ( i = len - 1; i >= 0; i-- )
EvalGenRels( hdG, i );
}
/*--------------------------------------------------------------------------\
| Functions for object oriented programming |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*V HdRnOp . . . . . . . . . . . . . . . . . . . . . recordname "operations"
*V HdCallOop1 . . . . . . . . . . . . . . . . . function with one argument
*V HdCallOop2 . . . . . . . . . . . . . . . . . function with two argument
*F EvalOop( <obj>, <record_element>, <error_message> ) . . . . . . . . oops
*F EvalOop2( <objL>, <objR>, <record_element>, <error_message> ) . . . oops
*F EvalOopN( <obj>, <record_element>, <hdCall>, <error_message> ) . . oops
**
** If <obj>, <objL> or <objR> contains a record entry "operations" which
** contains a entry <record_element> which is a function, this functions is
** called with the approiate arguments. Otherwise an error <error_message>
** is raised.
*/
extern TypHandle HdRnOp; /** record.c ***************************/
TypHandle HdCallOop1;
TypHandle HdCallOop2;
TypHandle EvalOop ( hdObject, hdRecName, ErrorMsg )
TypHandle hdObject;
TypHandle hdRecName;
char * ErrorMsg;
{
TypHandle * ptRec, * ptEnd;
TypHandle hdOp, hdTmp;
if ( TYPE( hdObject ) == T_REC )
{
/** Maybe <hdObject> is a record which is simulating a datatype. **/
/** At first look if the record has an 'operations' element. **/
ptRec = PTR( hdObject );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdObject ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != HdRnOp )
ptRec += 2;
/** If it was found and is a record, look for <hdRecName>. *********/
if ( ptRec == ptEnd || TYPE( ptRec[ 1 ] ) != T_REC )
goto l1;
hdOp = ptRec[ 1 ];
ptRec = PTR( hdOp );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdOp ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRecName )
ptRec += 2;
/** If it was found and is function, then apply it to <hdObject>. **/
if ( ptRec == ptEnd )
goto l1;
PTR( HdCallOop1 )[ 0 ] = ptRec[ 1 ];
PTR( HdCallOop1 )[ 1 ] = hdObject;
hdTmp = EVAL( HdCallOop1 );
PTR( HdCallOop1 )[ 0 ] = 0;
PTR( HdCallOop1 )[ 1 ] = 0;
return hdTmp;
}
l1:
/** Sorry <hdObject> has no record entry ~.operation.<recname>! ********/
return Error( ErrorMsg, 0L, 0L );
}
TypHandle EvalOop2( hdObjectL, hdObjectR, hdRecName, ErrorMsg )
TypHandle hdObjectL, hdObjectR;
TypHandle hdRecName;
char * ErrorMsg;
{
TypHandle * ptRec, * ptEnd;
TypHandle hdOp, hdTmp;
if ( TYPE( hdObjectL ) == T_REC )
{
/** Maybe <hdObjectL> is a record which is simulating a datatype. **/
/** At first look if the record has an 'operations' element. **/
ptRec = PTR( hdObjectL );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdObjectL ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != HdRnOp )
ptRec += 2;
/** If we have found a record look for <hdRecName>. ****************/
if ( ptRec == ptEnd || TYPE( ptRec[ 1 ] ) != T_REC )
goto l1;
hdOp = ptRec[ 1 ];
ptRec = PTR( hdOp );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdOp ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRecName )
ptRec += 2;
/** If it is function then apply it to the arguments. **/
if ( ptRec == ptEnd )
goto l1;
PTR( HdCallOop2 )[ 0 ] = ptRec[ 1 ];
PTR( HdCallOop2 )[ 1 ] = hdObjectL;
PTR( HdCallOop2 )[ 2 ] = hdObjectR;
hdTmp = EVAL( HdCallOop2 );
PTR( HdCallOop2 )[ 0 ] = 0;
PTR( HdCallOop2 )[ 1 ] = 0;
PTR( HdCallOop2 )[ 2 ] = 0;
return hdTmp;
}
l1:
/** <hdObjectL> is no useable record, maybe <hdObjectR>. ***************/
if ( TYPE( hdObjectR ) == T_REC )
{
/** Maybe <hdObjectR> is a record which is simulating a datatype. **/
/** At first look if the record has an 'operations' element. **/
ptRec = PTR( hdObjectR );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdObjectR ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != HdRnOp )
ptRec += 2;
/** If we have found a record look for <hdRecName>. ****************/
if ( ptRec == ptEnd || TYPE( ptRec[ 1 ] ) != T_REC )
goto l2;
hdOp = ptRec[ 1 ];
ptRec = PTR( hdOp );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdOp ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRecName )
ptRec += 2;
/** If it is function then apply it to the arguments. **************/
if ( ptRec == ptEnd )
goto l2;
PTR( HdCallOop2 )[ 0 ] = ptRec[ 1 ];
PTR( HdCallOop2 )[ 1 ] = hdObjectL;
PTR( HdCallOop2 )[ 2 ] = hdObjectR;
hdTmp = EVAL( HdCallOop2 );
PTR( HdCallOop2 )[ 0 ] = 0;
PTR( HdCallOop2 )[ 1 ] = 0;
PTR( HdCallOop2 )[ 2 ] = 0;
return hdTmp;
}
l2:
/** Sorry <hdObject> has no record entry ~.operation.<recname>! ********/
return Error( ErrorMsg, 0L, 0L );
}
TypHandle EvalOopN ( hdObject, hdRecName, hdCall, ErrorMsg )
TypHandle hdObject;
TypHandle hdRecName;
TypHandle hdCall;
char * ErrorMsg;
{
TypHandle * ptRec, * ptEnd, * ptCall, * ptTmp;
TypHandle hdOp, hdTmp;
if ( TYPE( hdObject ) == T_REC )
{
/** Maybe <hdObject> is a record which is simulating a datatype. **/
/** At first look if the record has an 'operations' element. **/
ptRec = PTR( hdObject );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdObject ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != HdRnOp )
ptRec += 2;
/** If it was found and is a record, look for <hdRecName>. *********/
if ( ptRec == ptEnd || TYPE( ptRec[ 1 ] ) != T_REC )
goto l1;
hdOp = ptRec[ 1 ];
ptRec = PTR( hdOp );
ptEnd = (TypHandle*) ( (char*) ptRec + SIZE( hdOp ) );
while ( ptRec < ptEnd && ptRec[ 0 ] != hdRecName )
ptRec += 2;
/** If it was found and is function, then apply it to <hdObject>. **/
if ( ptRec == ptEnd )
goto l1;
hdTmp = NewBag( T_FUNCCALL, SIZE( hdCall ) );
ptTmp = PTR( hdTmp );
ptCall = PTR( hdCall );
ptEnd = (TypHandle*)( (char*) ptCall + SIZE( hdCall ) );
while ( ptCall < ptEnd )
* ptTmp++ = * ptCall++;
PTR( hdTmp )[ 0 ] = ptRec[ 1 ];
return EVAL( hdTmp );
}
l1:
/** Sorry <hdObject> has no record entry ~.operation.<recname>! ********/
return Error( ErrorMsg, 0L, 0L );
}
/*--------------------------------------------------------------------------\
| agword/agexp manipulations |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F AgWordAgExp( <hdExp> , <hdAgGroup> ) . . . converts T_AGEXP to T_AGWORD
**
** 'AgWordAgExp' expects an exponent-vector of type T_AGEXP and converts it
** to an agword of type T_AGWORD simply by copying the nontrivial exponents.
**
** !!! WARNING !!! WARNING !! WARNING !! WARNING !!! WARNING !!! WARNING !!!
** This also clears <hdExp>.
*/
TypHandle AgWordAgExp ( hdExp, hdGrp )
TypHandle hdExp;
TypHandle hdGrp;
{
TypHandle hdWrd;
TypSword * ptWrd;
TypExp * ptExp, * ptEnd;
long lnWrd, idx = 0;
/** Count the number of different, nontrivial generators. **************/
lnWrd = 0;
ptExp = (TypExp*) PTR( hdExp );
ptEnd = (TypExp*) ( (char*) ptExp + SIZE( hdExp ) );
while ( ptExp < ptEnd && *ptExp == 0 )
ptExp++;
if ( ptExp < ptEnd )
idx = ptExp - (TypExp*) PTR( hdExp );
while ( ptExp < ptEnd )
if ( *ptExp++ )
lnWrd++;
if ( lnWrd == 0 )
return HD_IDENTITY( hdGrp );
/** Allocate and initialize an agword with <nrGens> generators. ********/
hdWrd = NewBag( T_AGWORD, SIZE_HD + (2 * lnWrd + 1) * SIZE_SWORD );
ptWrd = PTR_AW( hdWrd );
*( PTR( hdWrd ) ) = hdGrp;
/** Copy nontrivial entries from the exponent-vector to the agword. **/
ptExp = (TypExp*) PTR( hdExp ) + idx;
while ( lnWrd > 0 )
{
if ( *ptExp )
{
*( ptWrd++ ) = idx;
*( ptWrd++ ) = *ptExp;
*ptExp = 0;
lnWrd--;
}
idx++;
ptExp++;
}
*ptWrd = -1;
return hdWrd;
}
/****************************************************************************
**
*F SetCollectExponents( <wrd> ) . . . . . . . converts T_AGWORD to T_AGEXP
**
** 'SetCollectExponent' expects an agword and converts it into an exponent
** vector by copying it. The vector is stored in 'HD_COLLECT_EXPONENTS' in
** the group record of <wrd>.
**
** !!! WARNING !!! WARNING !! WARNING !! WARNING !!! WARNING !!! WARNING !!!
** 'SetCollectExponents' does NOT clear the exponent vector. This must be
** explicity by using 'ClearCollectExponents'.
*/
void SetCollectExponents ( hdWrd )
TypHandle hdWrd;
{
long nrGens;
TypSword * ptWrd;
TypExp * ptExp;
TypHandle hdGrp;
hdGrp = * PTR( hdWrd );
nrGens = NUMBER_OF_GENS( hdGrp );
/** The following is nice but too slow in groups with many gens **/
/** which appear during an NQ. **/
/** **/
/** TypExp * ptEnd; **/
/** ptExp = COLLECT_EXPONENTS( hdGrp ); **/
/** ptEnd = (TypExp*)( (char*) ptExp + nrGens * SIZE_EXP ); **/
/** for ( ; ptExp < ptEnd; ptExp++ ) **/
/** * ptExp = 0; **/
ptExp = COLLECT_EXPONENTS( hdGrp );
for ( ptWrd = PTR_AW( hdWrd ); *ptWrd != -1; ptWrd += 2 )
ptExp[ (long)( *ptWrd ) ] = *( ptWrd + 1 );
}
/****************************************************************************
**
*F ClearCollectExponents( <hdAgGroup> ) . . . clear the collector exponent
**
** 'ClearCollectExponents' clears the exponent vector store in group bag
** <hdAgGroup> at position 'HD_COLLECT_EXPONENTS'.
*/
void ClearCollectExponents ( hdAgGroup )
TypHandle hdAgGroup;
{
TypExp * ptExp, * ptEnd;
ptExp = COLLECT_EXPONENTS( hdAgGroup );
ptEnd = (TypExp*)( (char*)ptExp + NUMBER_OF_GENS(hdAgGroup)*SIZE_EXP );
for ( ; ptExp < ptEnd; ptExp++ )
* ptExp = 0;
}
/****************************************************************************
**
*F HeadAgWord( <hdAgWord>, <nrNew> ) . . . . . . . . computes a factor-word
**
** 'HeadFacWord' reduces an agword <hdAgWord> to <nrNew> gens. The handle
** of the reduced word, which gives references to the group, will point to
** the aggroup of <hdAgWord>.
*/
TypHandle HeadAgWord( hdAgWord, nrNew )
TypHandle hdAgWord;
long nrNew;
{
long nrGens;
TypSword * ptAgWord, * ptNew;
TypHandle hdNew;
/** count the number of generators less then <nrNew>. ******************/
ptAgWord = PTR_AW( hdAgWord );
nrGens = 0;
while ( * ptAgWord != -1 && * ptAgWord < nrNew )
{
nrGens++;
ptAgWord += 2;
}
/** Allocate a new agword, with enough entries. Copy the aggroup. ******/
hdNew = NewBag( T_AGWORD, SIZE_HD + ( 2 * nrGens + 1 ) * SIZE_SWORD );
*PTR( hdNew ) = *PTR( hdAgWord );
/** Copy all generators less than <nrNew>. *****************************/
ptNew = PTR_AW( hdNew );
ptAgWord = PTR_AW( hdAgWord );
for ( ; nrGens > 0; nrGens-- )
{
*( ptNew++ ) = *( ptAgWord++ );
*( ptNew++ ) = *( ptAgWord++ );
}
*ptNew = -1;
return hdNew;
}
/****************************************************************************
**
*F FindAgenNr( <hdAgen>, <hdAgGroup> ) . . . . . finds number of a generator
**
** 'FindAgenNr' returns position in the list 'WORDS' of the abstract
** generator <hdAgen>. It returns a positive number if <hdAgen> is in this
** list, a negative number if <hdAgen> is the inverse of an generator in
** this list. The position are counted beginning with 1!.
**
** 0 is return, if the generator could not be found.
*/
long FindAgenNr( hdAgen, hdAgGroup )
TypHandle hdAgen, hdAgGroup;
{
long k, nrGens;
TypHandle * ptGens;
nrGens = NUMBER_OF_GENS( hdAgGroup );
ptGens = WORDS( hdAgGroup ) + ( nrGens - 1 );
for ( k = nrGens - 1; k >= 0; k--, ptGens-- )
{
/** A generators ***************************************************/
if ( hdAgen == *ptGens )
return k + 1;
/** or its inverse? ************************************************/
if ( hdAgen == PTR( *ptGens )[ 0 ] )
return - ( k + 1 );
}
/** Generator not found, return 0 **************************************/
return 0;
}
/****************************************************************************
**
*F AgListWord( <hdWrd>, <hdGrp> ) . . . . . . . converts T_WORD to T_AGLIST
*/
TypHandle AgListWord ( hdWrd, hdGrp )
TypHandle hdWrd; /* an (sorted) word in <hdGrp>.words */
TypHandle hdGrp; /* an ag group */
{
TypHandle hdAgl; /* handle of the aglist, result */
TypSword * ptAgl; /* pointer into the aglist */
TypHandle * ptWrd; /* pointer into the word */
TypHandle * ptWrdEnd; /* pointer to the end of the word */
TypHandle * ptWrd1; /* temporary pointer */
TypHandle * ptLst; /* pointer in the generators list */
TypHandle * ptLstBeg; /* pointer to the start of list */
TypHandle * ptLstEnd; /* pointer to the end of the list */
TypHandle hdGen; /* handle of one generator */
TypHandle hdInv; /* handle of the inverse */
/*N a very stupid way to deal with swords */
if ( TYPE(hdWrd) == T_SWORD )
hdWrd = WordSword( hdWrd );
else if ( TYPE(hdWrd) != T_WORD )
return HdFalse;
/* allocate an aglist for the result */
hdAgl = NewBag( T_AGLIST, (2 * SIZE(hdWrd)/SIZE_HD + 1) * SIZE_SWORD );
ptAgl = (TypSword*)PTR( hdAgl );
/* grab the pointers into the word */
ptWrd = PTR( hdWrd );
ptWrdEnd = PTR( hdWrd ) + SIZE( hdWrd ) / SIZE_HD;
/* grab the pointers to the generators list */
hdGen = HD_WORDS( hdGrp );
ptLstBeg = PTR( hdGen ) + 1;
ptLstEnd = PTR( hdGen ) + 1 + LEN_LIST( hdGen );
ptLst = ptLstEnd - 1;
/* run over the word */
for ( ptWrd = PTR(hdWrd); ptWrd < ptWrdEnd; ptWrd = ptWrd1 ) {
/* get the generator and the inverse */
hdGen = *ptWrd;
hdInv = *PTR(hdGen);
/* identify the generator */
while ( ptLstBeg <= ptLst && *ptLst != hdGen && *ptLst != hdInv )
ptLst--;
/* if we didn't find it we start at the end again */
if ( ptLst < ptLstBeg ) {
ptLst = ptLstEnd - 1;
while ( ptLstBeg <= ptLst && *ptLst != hdGen && *ptLst != hdInv )
ptLst--;
if ( ptLst < ptLstBeg )
return HdFalse;
}
/* find the exponent (as run lenght) */
ptWrd1 = ptWrd+1;
while ( ptWrd1 < ptWrdEnd && *ptWrd1 == hdGen )
ptWrd1++;
/* stuff the pair into the aglist */
*ptAgl++ = ptLst - ptLstBeg;
*ptAgl++ = (*ptLst == hdGen) ? (ptWrd1 - ptWrd) : (ptWrd - ptWrd1);
}
/* append the terminating -1 and return the aglist */
*ptAgl++ = -1;
Resize( hdAgl, (ptAgl - (TypSword*)PTR(hdAgl)) * SIZE_SWORD );
return hdAgl;
}
/*--------------------------------------------------------------------------\
| aggroup manipulations |
\--------------------------------------------------------------------------*/
/****************************************************************************
**
*F BlankAgGroup() . . . . . . . . . . . . . . . . . return a blank aggroup
**
** 'BlankAgGroup' allocates space for the aggroup record and sets all
** collector independent names.
*/
TypHandle BlankAgGroup ()
{
TypHandle hdAgGroup, hdRnName;
long i;
hdAgGroup = NewBag( T_REC, SIZE_HD * ( NR_COLLECTOR_LAST + 1 ) );
/** For safety clear all entries ***************************************/
hdRnName = FindRecname( "unused" );
for ( i = ( NR_COLLECTOR_LAST - 1 ) / 2; i >= 0; i-- )
{
PTR( hdAgGroup )[ 2 * i ] = hdRnName;
PTR( hdAgGroup )[ 2 * i + 1 ] = INT_TO_HD( 0 );
}
/** Now enter all collector independent names **************************/
hdRnName = FindRecname( "generators" );
PTR( hdAgGroup )[ NR_GENERATORS - 1 ] = hdRnName;
hdRnName = FindRecname( "identity" );
PTR( hdAgGroup )[ NR_IDENTITY - 1 ] = hdRnName;
hdRnName = FindRecname( "words" );
PTR( hdAgGroup )[ NR_WORDS - 1 ] = hdRnName;
hdRnName = FindRecname( "powers" );
PTR( hdAgGroup )[ NR_POWERS - 1 ] = hdRnName;
hdRnName = FindRecname( "indices" );
PTR( hdAgGroup )[ NR_INDICES - 1 ] = hdRnName;
hdRnName = FindRecname( "commutators" );
PTR( hdAgGroup )[ NR_COMMUTATORS - 1 ] = hdRnName;
hdRnName = FindRecname( "collector" );
PTR( hdAgGroup )[ NR_COLLECTOR - 1 ] = hdRnName;
hdRnName = FindRecname( "numberGenerators" );
PTR( hdAgGroup )[ NR_NUMBER_OF_GENS - 1 ] = hdRnName;
hdRnName = FindRecname( "saveExponents" );
PTR( hdAgGroup )[ NR_SAVE_EXPONENTS - 1 ] = hdRnName;
hdRnName = FindRecname( "collectExponents" );
PTR( hdAgGroup )[ NR_COLLECT_EXPONENTS - 1 ] = hdRnName;
/** Return the blank aggroup record ************************************/
return hdAgGroup;
}
/****************************************************************************
**
*F SetGeneratorsAgGroup( <hdAgGroup> ) . . . . sets generators and identity
**
** 'SetGeneratorsAgGroup' sets the entries 'GENERATORS' to a list of
** T_AGWORDs describing the group generators and 'IDENTITY' to the group
** identity.
*/
void SetGeneratorsAgGroup( hdAgGroup )
TypHandle hdAgGroup;
{
long nrGens, i;
TypHandle hdList, hdAgWord;
nrGens = NUMBER_OF_GENS( hdAgGroup );
hdList = NewBag( T_LIST, ( nrGens + 1 ) * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( nrGens );
/** 'GENERATORS' *******************************************************/
for ( i = nrGens; i >= 1; i-- )
{
hdAgWord = NewBag( T_AGWORD, SIZE_HD + 3 * SIZE_SWORD );
*PTR( hdAgWord ) = hdAgGroup;
PTR_AW( hdAgWord )[ 0 ] = i - 1;
PTR_AW( hdAgWord )[ 1 ] = 1;
PTR_AW( hdAgWord )[ 2 ] = -1;
PTR( hdList )[ i ] = hdAgWord;
}
HD_GENERATORS( hdAgGroup ) = hdList;
/** 'IDENTITY' *********************************************************/
hdAgWord = NewBag( T_AGWORD, SIZE_HD + SIZE_SWORD );
*PTR( hdAgWord ) = hdAgGroup;
PTR_AW( hdAgWord )[ 0 ] = -1;
HD_IDENTITY( hdAgGroup ) = hdAgWord;
}
/****************************************************************************
**
*V HdRnAvec . . . . . . . . . . . . . . . . . . . . . . record name "avec"
*F SetAvecAgGroup( <hdAgGroup>, <genNr> ) . . . . sets the avec upto <genNr>
**
** Compute the vector 'AVEC' described above. This vector is only used in
** single, triple and quadruple collector. The 'AVEC' is computed for the
** generators greater or equal <genNr>. If 'AVEC' is unused (eg first call
** of this function), the record name is set to 'AVEC' and a new vector is
** allocated.
*/
TypHandle HdRnAvec;
void SetAvecAgGroup ( hdAgGroup, low, high )
TypHandle hdAgGroup;
long low;
long high;
{
TypHandle hdAvec; /* handle of the avec list */
long * ptAvec; /* pointer to the avec list */
long nrGens; /* number of generators */
TypHandle * ptComms; /* pointer to the commutators */
TypHandle hdId; /* handle of the identity */
long i, k, l; /* loop variables */
/* get the number of generators, the identity and the commutators */
nrGens = NUMBER_OF_GENS( hdAgGroup );
hdId = HD_IDENTITY( hdAgGroup );
/* get the avec list, create it if neccessary */
if ( PTR(hdAgGroup)[NR_AVEC-1] != HdRnAvec ) {
PTR(hdAgGroup)[NR_AVEC-1] = HdRnAvec;
hdAvec = NewBag( T_INTPOS, nrGens * sizeof(long) );
HD_AVEC( hdAgGroup ) = hdAvec;
}
hdAvec = HD_AVEC( hdAgGroup );
ptAvec = (long*) PTR(hdAvec);
/* get the commutators */
ptComms = COMMUTATORS( hdAgGroup );
/* avec[i] is the min. l>i s.t g_{i}..g_{n} commute with g_{l}..g_{n} */
for ( i = high; low <= i; i-- ) {
/* let k>i+1 be min. s.t. g_{i+1}..g_{n} commute with g_{k}..g_{n} */
k = (i == nrGens-1 ? nrGens+1 : ptAvec[i+1]);
/* every generator commutes with itself of course */
/* now k>i is min. s.t. g_{i+1}..g_{n} commute with g_{k}..g_{n} */
if ( k == i+2 ) k = i+1;
/* find the min. l>=k such that g_{i} commutes with g_{l}..g_{n} */
l = nrGens;
while ( k <= l-1 && ptComms[ IND( l-1, i ) ] == hdId )
l--;
/* enter this in avec[i] */
ptAvec[i] = l;
}
}
/****************************************************************************
**
*F SetCWeightsAgGroup( <hdGrp>, <hdLst> ) . . . . sets the central weights
**
** 'SetCWeightsAgGroup' adds the entries 'CWEIGHTS' and 'CSERIES' to the
** collector depend part of the group bag <hdAgGrp>. If no central series
** is found, 'FALSE' is returned. In that case the collector entries are
** not changed.
**
** The entry 'CWEIGHTS' is an array of longs $c_i$ such that the $i$.th
** generator has weight $c_i$ with respect to the central series. The entry
** 'CSERIES' describes this central series in the following way.
**
** CSERIES[ 0 ] is the p-class of the group,
** CSERIES[ i ] is the number of the last generator in class i.
**
** 'CSERIES' is an array of longs.
**
** If <hdLst> is not void, it must be a list of integers describing the
** central weights of the generators.
*/
boolean SetCWeightsAgGroup ( hdGrp, hdLst )
TypHandle hdGrp;
TypHandle hdLst;
{
TypHandle hdWeights, hdSeries, hdId, hdRnName, hd;
TypHandle * comms, * powers;
TypHandle * ptComms;
long * ptWeightI, * ptWeightJ, * ptWeightK;
long * ptSeries, * ptWeights, * ptIndices;
long nrGens, i, j, k, prime, max;
char * str;
/** Give a hint why/who failed. We only print a warning, no error. *****/
str = "#W SetCollectorAgWord: %s\n";
/** 'CWEIGHTS' is a array of long stored in T_INTPOS. ******************/
nrGens = NUMBER_OF_GENS( hdGrp );
hdWeights = NewBag( T_INTPOS, nrGens * sizeof( long ) );
/** Compute the weights of the generators. Assume that we have a NQ- **/
/** presentation (eg, all but the first generators are defined). **/
ptWeights = (long*) PTR( hdWeights );
powers = POWERS( hdGrp );
comms = COMMUTATORS( hdGrp );
/** If no weights are given start with weight one for all generators. **/
if ( hdLst == HdVoid )
for ( i = nrGens - 1; i >= 0; i-- )
ptWeights[ i ] = 1;
else
{
if ( LEN_LIST( hdLst ) != nrGens )
{
Pr( str, (long) "too few/many weights", 0L );
return FALSE;
}
for ( i = nrGens - 1; i >= 0; i-- )
{
if ( TYPE( PTR( hdLst )[ i + 1 ] ) != T_INT )
{
Pr( str, (long) "weights must integers", 0L );
return FALSE;
}
ptWeights[ i ] = HD_TO_INT( PTR( hdLst )[ i + 1 ] );
}
}
/** Compute the weights, if neccessary, and/or check that the weights **/
/** drop without gap. **/
if ( hdLst == HdVoid )
{
ptWeightI = ptWeights + 1;
for ( i = 1; i < nrGens; i++, ptWeightI++ )
{
ptWeightJ = ptWeights;
for ( j = 0; j < i; j++, ptWeightJ++ )
{
ptWeightK = ptWeights;
ptComms = & comms[ IND( j, 0 ) ];
for ( k = 0; k < j; k++, ptWeightK++, ptComms++ )
{
hd = * ptComms;
if ( SIZE( hd ) == SIZE_HD + 3 * SIZE_SWORD
&& PTR_AW( hd )[ 0 ] == i )
{
* ptWeightI = MAX( * ptWeightI,
(* ptWeightK) + (* ptWeightJ) );
}
}
hd = powers[ j ];
if ( SIZE( hd ) == SIZE_HD + 3 * SIZE_SWORD
&& PTR_AW( hd )[ 0 ] == i )
{
* ptWeightI = MAX( * ptWeightI, ( * ptWeightJ ) + 1 );
}
} /* for j */
} /* for i */
/** Compute the maximal weight *************************************/
max = 1;
for ( i = nrGens - 1; i >= 0; i-- )
max = MAX( max, ptWeights[ i ] );
/** Try to fix weights for presentations derived by NQ *************/
if ( hdLst == HdVoid )
{
i = 1;
while ( i < nrGens && ptWeights[ i - 1 ] <= ptWeights[ i ] )
i++;
for ( ; i < nrGens; i++ )
ptWeights[ i ] = max;
}
} /* hdLst == HdVoid */
/** Check weights ******************************************************/
for ( i = 1; i < nrGens; i++ )
{
if ( ptWeights[ i ] != ptWeights[ i-1 ]
&& ptWeights[ i ] != ( ptWeights[ i-1 ] + 1 ) )
{
Pr( str, (long) "incorrect central weights", 0L );
return FALSE;
}
}
/** Compute the array 'CSERIES' and check the exponents. They all **/
/** must have the same prime index. **/
hdSeries = NewBag( T_INTPOS, ( nrGens + 1 ) * sizeof( long ) );
ptSeries = (long*) PTR( hdSeries );
ptWeights = (long*) PTR( hdWeights );
powers = POWERS( hdGrp );
comms = COMMUTATORS( hdGrp );
ptIndices = INDICES( hdGrp );
prime = ptIndices[ 0 ];
for ( i = nrGens - 1; i > 0; i-- )
if ( prime != ptIndices[ i ] )
{
Pr( str, (long) "different indices", 0L );
return FALSE;
}
/** Make sure, we have a prime. This is usual a small number, so a **/
/** stupid prime test can be used. **/
for ( i = 2; i < prime; i++ )
if ( prime % i == 0 )
{
Pr( str, (long) "no p-group", 0L );
return FALSE;
}
/** Get the prime-class. ***********************************************/
ptSeries[ 0 ] = 1;
for ( i = 0; i < nrGens; i++ )
{
if ( ptWeights[ i ] > ptSeries[ 0 ] )
{
ptSeries[ ptSeries[ 0 ] ] = i - 1;
ptSeries[ 0 ]++;
}
else if ( ptWeights[ i ] < ptSeries[ 0 ] )
{
Pr( str, (long) "incorrect central weights", 0L );
return FALSE;
}
}
ptSeries[ ptSeries[ 0 ] ] = i - 1;
/* Check the presentation and weights. ********************************/
hdId = HD_IDENTITY( hdGrp );
for ( i = 0; i < nrGens; i++ )
{
/** First check if the central weights in a commutator are added. **/
for ( j = 0; j < i; j++ )
{
hd = comms[ IND( i, j ) ];
if ( hd != hdId )
if ( ptWeights[ *PTR_AW(hd) ] < ptWeights[i]+ptWeights[j] )
{
Pr( str, (long) "commutator weights do not add.", 0L );
Pr( "#W commutator [ %s, %s ] failed.\n",
(long) NAME_AW( hdGrp, i ),
(long) NAME_AW( hdGrp, j ) );
return FALSE;
}
}
/** Now make sure the central class of a power changes. ************/
hd = powers[ i ];
if ( hd != hdId )
if ( ptWeights[ *PTR_AW( hd )] < ptWeights[ i ] + 1 )
{
Pr( str, (long) "power weight does not change", 0L );
Pr( "#W power %s ^ %d failed.\n",
(long) NAME_AW( hdGrp, i ), prime );
return FALSE;
}
}
/** Store the weights and the p-central series in the group bag. **/
/** The list <hdSeries> could be resized, if the p-class is less **/
/** than the composition length. **/
Resize( hdSeries, ( ptSeries[ 0 ] + 1 ) * sizeof( long ) );
HD_CSERIES( hdGrp ) = hdSeries;
hdRnName = FindRecname( "centralSeries" );
PTR( hdGrp )[ NR_CSERIES - 1 ] = hdRnName;
HD_CWEIGHTS( hdGrp ) = hdWeights;
hdRnName = FindRecname( "centralWeights" );
PTR( hdGrp )[ NR_CWEIGHTS - 1 ] = hdRnName;
/** Everything seems OK ************************************************/
return TRUE;
}
/****************************************************************************
**
*F SetStacksAgGroup( <hdAgGroup> ) . . . . . . . . . initializes the stacks
**
** 'SetStacksAgGroup' initializes the 'STACKS' for the collection-process.
** They are stored at the 'STACKS' entry of the group record as list T_LIST.
** There are three different kind of stacks.
** T_STRING: stack of type 'TypSword*'
** T_INTPOS: stack of type 'TypExp'
** T_INTNEG: stack of type 'TypSword'
*/
void SetStacksAgGroup( hdAgGroup )
TypHandle hdAgGroup;
{
TypHandle hdList = 0, hdTmp;
long stackSize;
/** The initial stack size is a multiple of <stackSize> which is **/
/** chosen as number of group generators times 10. **/
stackSize = NUMBER_OF_GENS( hdAgGroup ) * 10;
/** Now initialize the different stacks. **/
switch ( (int) COLLECTOR( hdAgGroup ) )
{
case SINGLE_COLLECTOR:
/** Allocate four stacks for the single collector. *************/
hdList = NewBag( T_LIST, 5 * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( 4 );
hdTmp = NewBag( T_STRING, stackSize * sizeof(TypSword*) );
PTR( hdList )[ 1 ] = hdTmp;
hdTmp = NewBag( T_STRING, stackSize * sizeof(TypSword*) );
PTR( hdList )[ 2 ] = hdTmp;
hdTmp = NewBag( T_INTPOS, stackSize * SIZE_EXP );
PTR( hdList )[ 3 ] = hdTmp;
hdTmp = NewBag( T_INTPOS, stackSize * SIZE_EXP );
PTR( hdList )[ 4 ] = hdTmp;
break;
case QUADR_COLLECTOR:
case TRIPLE_COLLECTOR:
/** Allocate three stacks for the triple collector *************/
hdList = NewBag( T_LIST, 4 * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( 3 );
hdTmp = NewBag( T_STRING, stackSize * sizeof(TypSword*) );
PTR( hdList )[ 1 ] = hdTmp;
hdTmp = NewBag( T_INTNEG, stackSize * SIZE_SWORD );
PTR( hdList )[ 2 ] = hdTmp;
hdTmp = NewBag( T_INTNEG, stackSize * SIZE_SWORD );
PTR( hdList )[ 3 ] = hdTmp;
break;
case LEE_COLLECTOR:
case COMBI_COLLECTOR:
case COMBI2_COLLECTOR:
/** Allocate the stacks for combinatorial collector. **********/
if ( INDICES( hdAgGroup )[ 0 ] > 2 )
{
/** Collecting in p-group, with p > 2. *********************/
hdList = NewBag( T_LIST, 4 * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( 3 );
hdTmp = NewBag( T_STRING, stackSize * sizeof(TypSword*) );
PTR( hdList )[ 1 ] = hdTmp;
hdTmp = NewBag( T_INTNEG, stackSize * SIZE_SWORD );
PTR( hdList )[ 2 ] = hdTmp;
hdTmp = NewBag( T_INTPOS, stackSize * SIZE_EXP );
PTR( hdList )[ 3 ] = hdTmp;
}
else
{
/** Collecting in 2-group. *********************************/
hdList = NewBag( T_LIST, 3 * SIZE_HD );
PTR( hdList )[ 0 ] = INT_TO_HD( 2 );
hdTmp = NewBag( T_STRING, stackSize * sizeof( TypSword* ) );
PTR( hdList )[ 1 ] = hdTmp;
hdTmp = NewBag( T_INTNEG, stackSize * SIZE_SWORD );
PTR( hdList )[ 2 ] = hdTmp;
};
break;
default:
/** Someone has called the function with a wrong collector, **/
/** assume that it is an error in 'SetCollectorAgWord'. **/
Error(
"SetCollectorAgWord: cannot initialize stacks for collector %d",
(long) COLLECTOR( hdAgGroup ), 0L );
}
/** Bind stacks and name to group record. ******************************/
HD_STACKS( hdAgGroup ) = hdList;
hdTmp = FindRecname( "stacks" );
PTR( hdAgGroup )[ NR_STACKS - 1 ] = hdTmp;
}
/****************************************************************************
**
*F SaveAndClearCollector( <hdAgGroup> ) . . . . . . clears collector entry
*/
TypHandle SaveAndClearCollector( hdAgGroup )
TypHandle hdAgGroup;
{
TypHandle hdSave, hdZero, hdRnName;
long nrEntries, i;
/** At first save the entries. *****************************************/
nrEntries = ( NR_COLLECTOR_LAST - NR_COLLECTOR_FIRST + 2 ) / 2;
hdSave = NewBag( T_LIST, ( 2 * nrEntries + 2 ) * SIZE_HD );
PTR( hdSave )[ 0 ] = INT_TO_HD( 2 * nrEntries + 1 );
PTR( hdSave )[ 1 ] = HD_COLLECTOR( hdAgGroup );
for ( i = nrEntries * 2; i >= 1; i-- )
PTR( hdSave )[ i+1 ] = PTR( hdAgGroup )[ NR_COLLECTOR_FIRST-2+i ];
/** Clear all entries. *************************************************/
hdRnName = FindRecname( "unused" );
hdZero = INT_TO_HD( 0 );
for ( i = nrEntries - 1; i >= 0; i-- )
{
PTR( hdAgGroup )[ NR_COLLECTOR_FIRST - 1 + 2 * i ] = hdRnName;
PTR( hdAgGroup )[ NR_COLLECTOR_FIRST + 2 * i ] = hdZero;
}
/** Return the saved entries *******************************************/
return hdSave;
}
/****************************************************************************
**
*F RestoreCollector( <hdAgGroup>, <hdSave> ) . . restores a saved collector
*/
void RestoreCollector( hdAgGroup, hdSave )
TypHandle hdAgGroup;
TypHandle hdSave;
{
long nrEntries, i;
nrEntries = ( NR_COLLECTOR_LAST - NR_COLLECTOR_FIRST + 2 ) / 2;
HD_COLLECTOR( hdAgGroup ) = PTR( hdSave )[ 1 ] ;
for ( i = nrEntries * 2; i >= 1; i-- )
PTR( hdAgGroup )[ NR_COLLECTOR_FIRST-2+i ] = PTR( hdSave )[ i+1 ];
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.