void setup_word_to_invert(struct pcp_vars *pcp)
{
register int *y = y_address;
int type = INVERSE_OF_WORD;
int disp = pcp->lastg;
int cp = pcp->lused;
int ptr = pcp->lused + 1 + disp;
int str;
register int i;
for (i = 1; i <= pcp->lastg; ++i)
y[cp + i] = 0;
read_word(stdin, disp, type, pcp);
invert_word(ptr, cp, pcp);
str = ptr + y[ptr] + 1;
setup_word_to_print("inverse", cp, str, pcp);
}
void evaluate_list (int *queue, int *queue_length, int *list, int depth, struct pcp_vars *pcp)
{
register int *y = y_address;
register int lastg = pcp->lastg;
register int cp = pcp->lused;
register int cp1 = cp + lastg;
register int cp2 = cp1 + lastg;
register int i, a;
for (i = 1; i <= lastg; ++i)
y[cp + i] = 0;
while (depth > 0) {
a = list[depth];
for (i = 1; i <= lastg; ++i)
y[cp1 + i] = 0;
y[cp1 + a] = 1;
/* compute a^power_of_entry */
power (power_of_entry, cp1, pcp);
vector_to_string (cp1, cp2, pcp);
if (y[cp2 + 1] != 0)
collect (-cp2, cp, pcp);
--depth;
}
#ifdef DEBUG
print_array (y, cp + 1, cp + lastg + 1);
printf ("The result is ");
print_array (y, cp + 1, cp + lastg + 1);
#endif
/* now compute word^exponent */
power (exponent, cp, pcp);
setup_word_to_print ("result of collection", cp, cp + lastg + 1, pcp);
/*
if (pcp->m != 0)
*/
setup_echelon (queue, queue_length, cp, pcp);
}
int echelon(struct pcp_vars *pcp)
{
register int *y = y_address;
register int i;
register int j;
register int k;
register int p1;
register int exp;
register int redgen = 0;
register int count = 0;
register int factor;
register int bound;
register int offset;
register int temp;
register int value;
register int free;
register Logical trivial;
register Logical first;
register int p = pcp->p;
register int pm1 = pcp->pm1;
#include "access.h"
pcp->redgen = 0;
pcp->eliminate_flag = FALSE;
/* check that the relation is homogeneous of class pcp->cc */
if (pcp->cc != 1) {
offset = pcp->lused - 1;
temp = pcp->lastg;
for (i = 2, bound = pcp->ccbeg; i <= bound; i++) {
if (y[offset + i] != y[offset + temp + i]) {
text(6, pcp->cc, 0, 0, 0);
pcp->eliminate_flag = TRUE;
return -1;
}
}
}
/* compute quotient of the relations and store quotient as an exponent
vector in y[pcp->lused + pcp->ccbeg] to y[pcp->lused + pcp->lastg] */
k = 0;
offset = pcp->lused;
for (i = pcp->ccbeg, bound = pcp->lastg; i <= bound; i++) {
y[offset + i] -= y[offset + bound + i];
if ((j = y[offset + i])) {
if (j < 0)
y[offset + i] += p;
k = i;
}
}
if (k <= 0)
return -1;
/* print out the quotient of the relations */
if (pcp->diagn) {
/* a call to compact is not permitted at this point */
if (pcp->lused + 4 * pcp->lastg + 2 < pcp->structure) {
/* first copy relevant entries to new position in y */
free = pcp->lused + 2 * pcp->lastg + 1;
for (i = 1; i < pcp->ccbeg; ++i)
y[free + i] = 0;
for (i = pcp->ccbeg; i <= pcp->lastg; ++i)
y[free + i] = y[pcp->lused + i];
setup_word_to_print(
"quotient relation", free, free + pcp->lastg + 1, pcp);
}
}
first = TRUE;
while (first || --k >= pcp->ccbeg) {
/* does generator k occur in the unechelonised relation? */
if (!first && y[pcp->lused + k] <= 0)
continue;
/* yes */
first = FALSE;
exp = y[pcp->lused + k];
if ((i = y[pcp->structure + k]) <= 0) {
if (i < 0) {
/* generator k was previously redundant, so eliminate it */
p1 = -y[pcp->structure + k];
count = y[p1 + 1];
offset = pcp->lused;
for (i = 1; i <= count; i++) {
value = y[p1 + i + 1];
j = FIELD2(value);
/* integer overflow can occur here; see comments in collect */
y[offset + j] = (y[offset + j] + exp * FIELD1(value)) % p;
}
}
y[pcp->lused + k] = 0;
} else {
/* generator k was previously irredundant; have we already
found a generator to eliminate using this relation? */
if (redgen > 0) {
/* yes, so multiply this term by the appropriate factor
and note that the value of redgen is not trivial */
trivial = FALSE;
/* integer overflow can occur here; see comments in collect */
y[pcp->lused + k] = (y[pcp->lused + k] * factor) % p;
} else {
/* no, we will eliminate k using this relation */
redgen = k;
trivial = TRUE;
/* we want to compute the value of k so we will multiply the
rest of the relation by the appropriate factor;
integer overflow can occur here; see comments in collect */
factor = pm1 * invert_modp(exp, p);
/* we carry out this mod computation to reduce possibility
of integer overflow */
#if defined(CAREFUL)
factor = factor % p;
#endif
y[pcp->lused + k] = 0;
}
}
}
if (redgen <= 0)
return -1;
else
pcp->redgen = redgen;
/* the relation is nontrivial; redgen is either trivial or redundant */
if (trivial) {
/* mark redgen as trivial */
y[pcp->structure + redgen] = 0;
if (pcp->fullop)
text(3, redgen, 0, 0, 0);
complete_echelon(1, redgen, pcp);
} else {
/* redgen has value in exponent form in y[pcp->lused + pcp->ccbeg]
to y[pcp->lused + redgen(-1)] */
count = 0;
offset = pcp->lused;
for (i = pcp->ccbeg; i <= redgen; i++)
if (y[offset + i] > 0) {
count++;
y[offset + count] = PACK2(y[offset + i], i);
}
offset = pcp->lused + count + 1;
for (i = 1; i <= count; i++)
y[offset + 2 - i] = y[offset - i];
/* set up the relation for redgen */
y[pcp->lused + 1] = pcp->structure + redgen;
y[pcp->lused + 2] = count;
y[pcp->structure + redgen] = -(pcp->lused + 1);
pcp->lused += count + 2;
if (pcp->fullop)
text(4, redgen, 0, 0, 0);
complete_echelon(0, redgen, pcp);
}
pcp->eliminate_flag = TRUE;
if (redgen < pcp->first_pseudo)
pcp->newgen--;
if (pcp->newgen != 0 || pcp->multiplicator)
return count;
/* group is completed because all actual generators are redundant,
so it is not necessary to continue calculation of this class */
pcp->complete = 1;
last_class(pcp);
if (pcp->fullop || pcp->diagn)
text(5, pcp->cc, p, pcp->lastg, 0);
return -1;
}
