GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

1
#include "defs.h"
2

3
#define tmalloc(D,T,N) {D = (T *) malloc(sizeof(T)*(N)); \
4
  if (D==0) { fprintf(stderr,"Out of space.\n"); return(-1);}}
5
#define tfree(D) {if (D) free( (char *) D); D=0;}
6

7
extern char mult;
8
extern short wd1[],wd2[],wd3[],wd4[],
9
      *cst,*cend,***coeff,fullsc,clsd,lkah,conch,**cco,**def;
10
extern short invg[],mwdl,endr,*fpt,*bpt,nelim,lo,**imcos,dim,
11
       ccos,lastd,cind,nfree,stcr,endcr,fcos,bcos,lcl,np2,*rel,
12
       ng;
13

14
int 
15
scanrel (void)
16
{ short i,j,k,l,m,necr,*s,*t; short compfsc,*p,*q,*r,esc;
17
  fullsc=1; stcr=endcr+2; endcr+=(1+rel[stcr-1]); esc=0;
18
  *wd1=0; *wd2=0; p=wd1+mwdl; q=p+dim;
19
  while (++p<=q) *p=0;
20
  p=wd2+mwdl; q=p+dim;
21
  while (++p<=q) *p=0;
22
  p=wd2+mwdl; s=rel+endcr+1; t=s+ *s; necr=endcr+ *s+1;
23
  while (++s<t) {p[*s]= *(s+1); s++; }
24
  if (mult==0 && ccos>1) action(p,def[ccos]);
25
  fcos=ccos; bcos=ccos; compfsc=1;
26
  for (i=stcr;i<=endcr;i++)
27
  { k=imcos[rel[i]][fcos];
28
    if (k==0) { compfsc=0; break;}
29
    if (concat(wd1,coeff[rel[i]][fcos])== -1) return(-1);
30
    fcos=k;
31
  }
32
  if (compfsc)
33
  { if (fcos!=bcos) esc=coinc(fcos,bcos);
34
    else if (conch) if (concheck()== -1) return(-1);
35
    if (esc== -1) return(-1);
36
    if (esc==0) endcr=necr;
37
    return(0);
38
  }
39
  stcr=i;
40
  for (i=endcr;i>=stcr;i--)
41
  { l=rel[i]; m=invg[l]; k=imcos[m][bcos];
42
    if (k==0)
43
    { if (i==stcr)
44
      { k=imcos[l][fcos];
45
        if (k==0)
46
        { imcos[l][fcos]=bcos; imcos[m][bcos]=fcos;
47
          if (ainvb(wd1,wd2,wd3)== -1) return(-1);
48
          if (*wd3>2) reduce(wd3);
49
          if (comp(wd3,coeff[l]+fcos)== -1) return(-1);
50
          invwd(wd3,wd2);
51
          if (comp(wd2,coeff[m]+bcos)== -1) return(-1);
52
        }
53
        else
54
        { if (concat(wd1,coeff[l][fcos])== -1) return(-1);
55
          if (k!=bcos) esc=coinc(k,bcos);
56
          else if (conch) if (concheck()== -1) return(-1);
57
          if (esc== -1) return(-1);
58
        }
59
        if (esc==0) endcr=necr;
60
        return(0);
61
      }
62
      if (lkah || nfree==0)
63
      { fullsc=0; if (esc==0) endcr=necr; return(0); }
64
      for (j=0;j<ng;j++) imcos[j][nfree]=0;
65
      cind++;
66
      if (mult==0)
67
        { tmalloc(def[nfree],short,def[bcos][0]+2);
68
          def[nfree][0]=def[bcos][0]+1; def[nfree][1]=l;
69
          for (j=1;j<=def[bcos][0];j++) def[nfree][j+1]=def[bcos][j];
70
        }
71
      imcos[m][bcos]=nfree; imcos[l][nfree]=bcos; bcos=nfree;
72
      bpt[nfree]=lastd; fpt[lastd]=nfree; lastd=nfree;
73
      nfree=fpt[nfree]; fpt[lastd]=0;
74
    }
75
    else
76
    { if (concat(wd2,coeff[m][bcos])== -1) return(-1); bcos=k;}
77
  }
78
  if (fcos!=bcos) esc=coinc(fcos,bcos);
79
  else if (conch) if (concheck()== -1) return(-1);
80
  if (esc== -1) return(-1);
81
  if (esc==0) endcr=necr;
82
  return(0);
83
}
84

85
int 
86
coinc (int c1, int c2)
87
{ short lc,hc,qh,qt,i,j,y,fhc,bhc,lim,him,ret; short *ocend,esc;
88
  esc=0; ocend=cend; lc=1;
89
  while (lc!=c1 && lc!=c2) lc=fpt[lc];
90
  if (lc==c1) { hc=c2; ret=ainvb(wd2,wd1,wd3); }
91
  else { hc=c1; ret=ainvb(wd1,wd2,wd3);}
92
  if (ret== -1) return(-1);
93
  if (hc<=lo) {fprintf(stderr,"Impossible coincidence.\n"); return(-1); }
94
  if (compb(wd3,cco+hc)== -1) return(-1);
95
  qh=0; qt=0;
96
  fhc=fpt[hc]; bhc=bpt[hc]; fpt[bhc]=fhc;
97
  if (fhc==0) lastd=bhc; else bpt[fhc]=bhc;
98
  if (ccos==hc) { ccos=bhc; endcr=endr; esc=1; clsd=0; }
99
  if (lkah && lcl==hc) lcl=bhc;
100
  while (1)
101
  { fpt[hc]=nfree; nfree=hc; cind--; nelim++;
102
    for (i=0;i<ng;i++)
103
    { him=imcos[i][hc];
104
      if (him!=0)
105
      { expand(wd1,coeff[i][hc]);
106
        j=invg[i]; lim=imcos[i][lc];
107
        if (him==hc)
108
        { him=lc; if (concat(wd1,cco[hc])== -1) return(-1);}
109
        else imcos[j][him]=0;
110
        if (lim==0)
111
        { imcos[i][lc]=him;
112
          if (ainvb(wd3,wd1,wd2)== -1) return(-1);
113
          if (*wd2>2) reduce(wd2);
114
          if (comp(wd2,coeff[i]+lc)== -1) return(-1);
115
        }
116
        else
117
        { expand(wd2,coeff[i][lc]);
118
          if (lim==hc)
119
          { imcos[i][lc]=lc; lim=lc;
120
            if (concat(wd2,cco[hc])== -1) return(-1);
121
            if (*wd2>2) reduce(wd2);
122
            if (comp(wd2,coeff[i]+lc)== -1) return(-1);
123
          }
124
          while (fpt[him]<0)
125
          { if (concat(wd1,cco[him])== -1) return(-1); him= -fpt[him];}
126
          while (fpt[lim]<0)
127
          { if (concat(wd2,cco[lim])== -1) return(-1); lim= -fpt[lim];}
128
          if (him!=lim)
129
          { if (ainvb(wd3,wd1,wd4)== -1) return(-1);
130
            y=1;
131
            while (y!=him && y!=lim) y=fpt[y];
132
            if (y==him)
133
            { him=lim; lim=y; ret=ainvb(wd2,wd4,wd1); }
134
            else ret=ainvb(wd4,wd2,wd1);
135
            if (ret== -1) return(-1);
136
            if (him<=lo)
137
            { fprintf(stderr,"Impossible coincidence(q).\n"); return(-1); }
138
            fhc=fpt[him]; bhc=bpt[him]; fpt[bhc]=fhc;
139
            if (fhc==0) lastd=bhc; else bpt[fhc]=bhc;
140
            if (ccos==him) { ccos=bhc; endcr=endr; esc=1; clsd=0; }
141
            if (lkah && lcl==him) lcl=bhc;
142
            if (*wd1>2) reduce(wd1);
143
            if (compb(wd1,cco+him)== -1) return(-1);
144
            fpt[him]= -lim;
145
            if (qh==0) qh=him; else bpt[qt]=him;
146
            qt=him; bpt[qt]=0;
147
          }
148
        }
149
        y=imcos[i][lc];
150
        if (imcos[j][y]==0)
151
        { imcos[j][y]=lc; expand(wd1,coeff[i][lc]); invwd(wd1,wd2);
152
          if (comp(wd2,coeff[j]+y)== -1) return(-1);
153
        }
154
      }
155
      coeff[i][hc]=0;
156
    }
157
    if (qh==0) break;
158
    hc=qh; qh=bpt[qh]; lc= -fpt[hc]; bpt[hc]=0;
159
    expand(wd3,cco[hc]);
160
  }
161
  cend=ocend;
162
  return(esc);
163
}
164

165