poly* Plethysm(entry* lambda,_index l,_index n,poly* p)
{ if (n==0) return poly_one(Lierank(grp)); else if (n==1) return p;
{ _index i,j;
poly* sum= poly_null(Lierank(grp)),**adams=alloc_array(poly*,n+1);
poly* chi_lambda=MN_char(lambda,l);
for (i=1; i<=n; ++i) { adams[i]=Adams(i,p); setshared(adams[i]); }
for (i=0;i<chi_lambda->nrows;i++)
{ entry* mu=chi_lambda->elm[i]; poly* prod=adams[mu[0]],*t;
for (j=1; j<n && mu[j]>0; ++j)
{ t=prod; prod=Tensor(t,adams[mu[j]]); freepol(t); }
sum= Addmul_pol_pol_bin(sum,prod,mult(chi_lambda->coef[i],Classord(mu,n)));
}
freemem(chi_lambda);
setshared(p); /* protect |p|; it coincides with |adams[1]| */
for (i=1; i<=n; ++i)
{ clrshared(adams[i]); freepol(adams[i]); } freearr(adams);
clrshared(p);
{ bigint* fac_n=fac(n); setshared(fac_n); /* used repeatedly */
for (i=0; i<sum->nrows; ++i)
{ bigint** cc= &sum->coef[i]
,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
*cc=divq(c,fac_n); setshared(*cc);
if (c->size!=0) error("Internal error (plethysm).\n"); else freemem(c);
}
clrshared(fac_n); freemem(fac_n);
}
return sum;
}
}
static inline list forward1(list t, int n)
{
static bucket b[CHARS]; /* buckets */
group g, g2; /* groups */
int pos = 0; /* pos in string */
if (n<2) return t;
initmem(groupmem, sizeof(struct grouprec), n/15);
initmem(bucketmem, sizeof(struct bucketrec), n/5);
/* We use a dummy group g as the header of the group data
structure. It does not contain any elements, but only a
pointer to the first unfinished group. */
g = (group) allocmem(groupmem, sizeof(struct grouprec));
g2 = (group) allocmem(groupmem, sizeof(struct grouprec));
g->next = g->nextunf = g2;
g2->head = t;
g2->next = g2->nextunf = NULL;
g2->finis = FALSE;
intobuckets(g, b, pos);
while (g->nextunf) {
pos++;
intogroups(b, pos);
intobuckets(g, b, pos);
}
t = collect(g);
freemem(bucketmem);
freemem(groupmem);
return t;
}
init_vip(char *name)
{
if (name == NULL || name[0] == 0)
return(0);
if ((vdh.alloced = load_exe(name, &vdh.eh)) != NULL)
{
zero_structure(&vdh.vh, sizeof(vdh.vh) );
vdh.vh.vip_magic = DVIP_MAGIC;
(*vdh.eh.entry_point)(&vdh.vh, continu_box);
if (vdh.vh.vip_magic != VIP_MAGIC)
{
continu_line("Bad tablet driver protocol.");
freemem(vdh.alloced);
return(0);
}
if (!(*vdh.vh.init_vip_device)(&vdh.vh, continu_box))
{
char *bufs[3];
bufs[0] = name;
bufs[1] = "Tablet not attatched";
bufs[2] = NULL;
continu_box(bufs);
freemem(vdh.alloced);
return(0);
}
return(1);
}
}
object Factor(bigint* num)
{ num=copybigint(num,NULL);
if (num->size<0) { Printf("- "); num->size=-num->size; }
{ bigint* temp=mkbigint(num->size); _digit p; int i=0;
if (num->size==0) { Printf("0"); goto quit; }
for (p=2; p<=trial_limit; p+= inc[i++])
{ if (i==array_size(inc)) i=3; /* after |37-31| wrap to difference |11-7| */
if (copybigint(num,temp),div1(temp,p)==0)
{ _index n; _digit pn=p; int e=1; copybigint(temp,num);
for (n=1; pn<=MaxDigit/p; ++n) pn*=p; /* highest $p^n$ fitting in |_digit| */
for (; div1(temp,pn)==0; e+=n) copybigint(temp,num);
/* find factors $p^n$ */
if (n>1) /* then there might be some factors |p| left */
for (copybigint(num,temp); div1(temp,p)==0; ++e) copybigint(temp,num);
/* factors |p| */
Printf("%ld",(long)p); if (e>1) Printf("^%ld",(long)e);
if (cmp1(num,1)==0) goto quit; /* last factor was found */
Printf(" * ");
}
}
printbigint(num,0);
if (num->size>2) Printf(" (Last factor need not be a prime)");
quit: Printf("\n");
freemem(num); freemem(temp);
}
return (object) NULL;
}
void terminator()
/* terminator is a system process that cleans up after processes being
destroyed. It receives a message from destroy_() telling it which
PCB is to be terminated. It then frees the process's PTable slot
and the memory space allocated to the process's stacks and
semaphores. */
{
int loopforever = 1; /* while loop will always be true */
PCBptr killed; /* addr of PCB to be terminated */
int i; /* loop index for semaphore array */
while (loopforever)
{
receive(&killed, 4);
killed->state = DELETE;
/* free stack space */
freemem(killed->user, 0x1000);
freemem(killed->kernal, 0x1000);
/* free all owned semaphores */
for (i=0; i < killed->semact; i++)
freesem(killed->owns[i]);
killed->state = UNUSED;
v(PTSEM);
}
} /* end terminator */
void reinit()
{
int i, j;
for (i = 0; i < col_count; i++)
{
col_width[i] = def_col_width;
}
for (i = 0; i < row_count; i++)
{
row_height[i] = def_row_height;
}
for (i = 1; i < col_count; i++)
{
for (j = 1; j < row_count; j++)
{
if (cells[i][j])
freemem(cells[i][j]);
cells[i][j] = NULL;
if (values[i][j])
freemem(values[i][j]);
values[i][j] = NULL;
}
}
}
char *make_cell_name(int x, int y, int xd, int yd)
{
char *col_cap = make_col_cap(x);
char *row_cap = make_row_cap(y);
if (x <= 0 || x > col_count || y <= 0 || y > row_count)
return NULL;
char *res = (char*)allocmem(strlen(col_cap) + strlen(row_cap) + xd ? 1 : 0 + yd ? 1 : 0 + 1);
int i = 0;
if (xd)
{
res[i] = '$';
i++;
}
strcpy(res + i, col_cap);
i += strlen(col_cap);
if (yd)
{
res[i] = '$';
i++;
}
strcpy(res + i, row_cap);
i += strlen(row_cap);
res[i] = '\0';
freemem(col_cap);
freemem(row_cap);
return res;
}
/* of interpreted points to generate. */
static int
s_spline(Poly *poly, Vector dotout, Vector vecout, int closed, int ir,
Poly *filledp)
{
fpoint *newx, *newy;
int ptcount;
LLpoint *p;
int i;
ptcount = poly->pt_count;
if ((newx = begmem(ptcount*sizeof(fpoint) )) == NULL)
return(0);
if ((newy = begmem(ptcount*sizeof(fpoint) )) == NULL)
{
freemem(newx);
return(0);
}
p = poly->clipped_list;
for (i=0; i<ptcount; i++)
{
newx[i] = FVAL(p->x);
newy[i] = FVAL(p->y);
p = p->next;
}
if (alloc_spline_tab(ptcount))
{
do_spline(newx,newy,ptcount,ir,closed,
dotout,vecout, filledp);
free_spline_tab();
}
freemem(newx);
freemem(newy);
return(1);
}
void EermMaxForceMeter(EermMax *m, Symbol *msg, short ac, Atom *av)
{
int i;
float *f;
MMemEntry;
MTraceCall("eermMax\t:ForceMeter..");
MErrorVoid((m != NULL) && (msg != NULL) && (av != NULL), "Missing argument");
f = (float *)getmem(ac * sizeof(float));
MErrorVoid(f != NULL, "didn't get mem");
AtomToFloatVector(ac, av, m->e->protof->Nf, f);
FeatureUpdate(m->e->protof, f, m->e->protof->Nf);
freemem(f, ac * sizeof(float));
f = (float *)getmem(m->e->Nn * sizeof(float));
MErrorVoid(f != NULL, "didn't get mem");
EermForceMeter(m->e, m->e->protof, f, m->e->Nn);
for (i = 0; i < m->e->Nn; i++)
{
post("Node %d : Force = %f", i, f[i]);
}
freemem(f, m->e->Nn * sizeof(float));
// Todo : Could pass this out an aux output instead.
MMemExit;
MTraceCall("eerm\t:ForceMeter finished.");
}
void free_code(Code* code)
{
int i;
Tstat* pstat = code->head;
while (pstat)
{
Tstat* pstat_next = pstat->next;
// Controllo se gli arg erano un puntatore a char.
for (i = 0; i < MAXARGS; i++)
{
Opdescr *pdescr = get_descr(pstat->op);
char tipo = pdescr->format[i];
if (tipo == '\0') break;
if (tipo == 's')
if (pstat->op == T_FPRINT ||
pstat->op == T_PRINT ||
pstat->op == T_FGET ||
pstat->op == T_GET)
freemem(pstat->args[i].sval, sizeof(char*));
}
freemem(pstat, sizeof(Tstat));
pstat = pstat_next;
}
}
poly* SAtensor(boolean alt,_index m,poly* p)
{ _index n,r=Lierank(grp); poly** adams,** q,* result;
if (m==0) return poly_one(r); else if (m==1) return p;
adams=alloc_array(poly*,m+1);
for (n=1; n<=m; ++n) adams[n]=Adams(n,p);
q=alloc_array(poly*,m+1);
q[0]=poly_one(r);
for (n=1; n<=m; ++n)
{
{ _index i; q[n]=Tensor(p,q[n-1]); /* the initial term of the summation */
for (i=2; i<=n; ++i) q[n] =
Add_pol_pol(q[n],Tensor(adams[i],q[n-i]),alt&&i%2==0);
}
{ _index i; bigint* big_n=entry2bigint(n); setshared(big_n);
for (i=0; i<q[n]->nrows; ++i)
{ bigint** cc= &q[n]->coef[i]
,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
*cc=divq(c,big_n); setshared(*cc);
{ if (c->size != 0)
error("Internal error (SAtensor): remainder from %ld.\n" ,(long)n);
freemem(c);
}
}
clrshared(big_n); freemem(big_n);
}
}
result=q[m];
{ for (n=1; n<=m; ++n) freepol(adams[n]); } freearr(adams);
{ for (n=0; n<m; ++n) freepol(q[n]); } freearr(q);
return result;
}
static void del_token_fifo(struct token_fifo *tf)
{
size_t i;
for (i = 0; i < tf->nt; i ++)
if (S_TOKEN(tf->t[i].type)) freemem(tf->t[i].name);
if (tf->nt) freemem(tf->t);
}
void CloseProjDB() {
freemem((void**) &inter);
freemem((void**) &intra);
freemem((void**) &inter_freq_idx);
freemem((void**) &intra_freq_idx);
CloseMemMap(&pDatasetMemMap);
}
void freep(poly* addr)
{ index j;
for (j=0; j<addr->nrows; j++)
{ object c=(object) addr->coef[j];
assert(isshared(c)); clrshared(c); freemem(c);
}
freemem(addr);
}
void EermMaxSimplexNew(EermMax *m, Symbol *msg, short ac, Atom *av)
{
int i;
int s;
Atom *NodeAtom;
int *NodeIndexList;
//MMemEntry;
MTrace1("eermMax:\tSimplexNew with %d nodes..", (ac-1));
MErrorVoid((m != NULL) && (msg != NULL) && (av != NULL), "Missing argument");
MErrorVoid (ac >= 2, "Wrong num args to SimplexNew");
MErrorVoid(av[0].a_type == A_SYM, "Simplex label expected.");
// Make sure that the label is unique:
MErrorVoid(EermMaxSimplexIndex(m, av[0].a_w.w_sym->s_name) == -1,
"Name is not unique!");
// Create the node int list
NodeIndexList = (int *)getmem((ac-1) * sizeof(int));
MErrorVoid(NodeIndexList != NULL, "didn't get mem");
NodeAtom = av + 1;
// Node atoms to node indexes
for (i = 0; i < (ac-1); i++)
{
NodeIndexList[i] = EermMaxNodeAtomToIndex(m, 1, &NodeAtom[i]);
if (NodeIndexList[i] == -1)
{
MError((NodeIndexList[i] != -1),"Node not found.");
freemem(NodeIndexList, (ac-1) * sizeof(int));
MTraceCall("eermMax:\tSimplexNew finished.");
return;
}
}
// Create the Eerm Simplex, returning the index
s = EermSimplexAdd(m->e, (ac-1), NodeIndexList);
freemem(NodeIndexList, (ac-1) * sizeof(int));
if (s != (m->e->Ns - 1))
{
post("Expression should be 1: %d", (s != (m->e->Ns - 1)));
post("Warning: Simplex already exists, with index %d; label unchanged.", s);
//MPostMemChange;
MTraceCall("eermMax:\tSimplexNew finished.");
return;
}
// Add the label.
EermMaxSimplexSetLabel(m, s, av[0].a_w.w_sym->s_name);
//MPostMemChange;
MTraceSimplices(m);
MTraceCall("eermMax:\tSimplexNew finished.");
}
void
del_curve2d(pcurve2d gr)
{
freemem(gr->g);
freemem(gr->n);
freemem(gr->e);
freemem(gr->x);
freemem(gr);
}
static void del_assertion(void *va)
{
struct assert *a = va;
size_t i;
for (i = 0; i < a->nbval; i ++) del_token_fifo(a->val + i);
if (a->nbval) freemem(a->val);
freemem(a);
}
syscall future_free(future* f,queue* q1,queue* q2) {
intmask mask;
mask=disable();
syscall sig=freemem(f,sizeof(f));
syscall sig1=freemem(f->value,sizeof(int));
freemem(q1,sizeof(queue));
freemem(q2,sizeof(queue));
restore(mask);
return sig;
}
static void del_macro(void *m)
{
struct macro *n = m;
size_t i;
for (i = 0; (int)i < n->narg; i ++) freemem(n->arg[i]);
if (n->narg > 0) freemem(n->arg);
if (n->cval.length) freemem(n->cval.t);
freemem(n);
}
bigint* sub_Worder(vector* v)
{ lie_Index i,j,s=Ssrank(grp), n=v->ncomp; matrix* roots=mkmatrix(n,s);
entry** m=roots->elm; group* h; bigint* result;
if (n==0) { freemem(roots); return one; }
for (i=0; i<n; ++i) /* select rows od an identity matrix */
{ entry* mij= *m++,vi=v->compon[i]-1;
for (j=0; j<s; ++j) *(mij++)= (j==vi);
}
h=Carttype(roots); freemem(roots);
result= Worder((object)h); freemem(h); return(result);
}
poly* wt_collect(void)
{ if (pos_acc->nrows>0) sorted=Add_pol_pol(sorted,pos_acc,false);
else freemem(pos_acc);
if (neg_acc->nrows>0) sorted=Add_pol_pol(sorted,neg_acc,true);
else freemem(neg_acc);
{
poly* result=sorted;
sorted=NULL;
return result;
}
}
real
max_rel_inner_error(pcbem3d bem, helmholtz_data * hdata, pcavector x,
boundary_func3d rhs)
{
uint nx, nz, npoints;
real(*xdata)[3];
field *ydata;
uint i, j;
real error, maxerror;
real eta_bw =
REAL_SQRT(ABSSQR(bem->kvec[0]) + ABSSQR(bem->kvec[1]) +
ABSSQR(bem->kvec[2]));
nx = 20;
nz = 20;
npoints = nx * nz;
xdata = (real(*)[3]) allocreal(3 * npoints);
npoints = 0;
for (j = 0; j < nz; ++j) {
for (i = 0; i < nx; ++i) {
xdata[npoints][0] = -1.0 + (2.0 / (nx - 1)) * i;
xdata[npoints][1] = 0.0;
xdata[npoints][2] = -1.0 + (2.0 / (nz - 1)) * j;
if (REAL_SQR(xdata[npoints][0]) + REAL_SQR(xdata[npoints][2]) < 1) {
npoints++;
}
}
}
ydata = allocfield(npoints);
#pragma omp parallel for
for (j = 0; j < npoints; ++j) {
ydata[j] = eval_brakhage_werner_c(bem, x, eta_bw, xdata[j]);
}
j = 0;
maxerror =
ABS(ydata[j] -
rhs(xdata[j], NULL, hdata)) / ABS(rhs(xdata[j], NULL, hdata));
for (j = 1; j < npoints; ++j) {
error =
ABS(ydata[j] -
rhs(xdata[j], NULL, hdata)) / ABS(rhs(xdata[j], NULL, hdata));
maxerror = error > maxerror ? error : maxerror;
}
freemem(ydata);
freemem(xdata);
return maxerror;
}
matrix* Resmat(matrix* roots)
{ lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp), n=roots->nrows;
vector* root_norms=Simproot_norms(grp);
entry* norms=root_norms->compon;
/* needed to compute $\<\lambda,\alpha[i]>$ */
matrix* root_images=Matmult(roots,Cartan()),* result=mkmatrix(r,r);
entry** alpha=roots->elm,** img=root_images->elm,** res=result->elm;
for (i=0; i<r; i++) for (j=0; j<r; j++) res[i][j]= i==j;
/* initialise |res| to identity */
for (j=0; j<n; j++) /* traverse the given roots */
{ entry* v=img[j], norm=(checkroot(alpha[j]),Norm(alpha[j]));
for (k=s-1; v[k]==0; k--) {}
if (k<j)
error("Given set of roots is not independent; apply closure first.\n");
if (v[k]<0)
{ for (i=j; i<n; i++) img[i][k]= -img[i][k];
for (i=k-j; i<s; i++) res[i][k]= -res[i][k];
}
while(--k>=j)
/* clear |v[k+1]| by unimodular column operations with column~|j| */
{
entry u[3][2]; lie_Index l=0;
u[0][1]=u[1][0]=1; u[0][0]=u[1][1]=0;
u[2][1]=v[k]; u[2][0]=v[k+1];
if (v[k]<0) u[2][1]= -v[k], u[0][1]= -1; /* make |u[2][1]| non-negative */
do /* subtract column |l| some times into column |1-l| */
{ entry q=u[2][1-l]/u[2][l]; for (i=0; i<3; i++) u[i][1-l]-=q*u[i][l];
} while (u[2][l=1-l]!=0);
if (l==0) for (i=0; i<2; i++) swap(&u[i][0],&u[i][1]);
{ for (i=j; i<n; i++) /* combine columns |k| and |k+1| */
{ entry img_i_k=img[i][k];
img[i][k] =img_i_k*u[0][0]+img[i][k+1]*u[1][0];
img[i][k+1]=img_i_k*u[0][1]+img[i][k+1]*u[1][1];
}
for (i=k-j; i<s; i++)
{ entry res_i_k=res[i][k];
res[i][k]=res_i_k*u[0][0]+res[i][k+1]*u[1][0];
res[i][k+1]=res_i_k*u[0][1]+res[i][k+1]*u[1][1];
}
}
}
for (i=0; i<s; i++)
{ lie_Index inpr= norms[i]*alpha[j][i]; /* this is $(\omega_i,\alpha[j])$ */
if (inpr%norm!=0) error("Supposed root has non-integer Cartan product.\n");
res[i][j]=inpr/norm; /* this is $\<\omega_i,\alpha[j]>$ */
}
}
freemem(root_norms); freemem(root_images); return result;
}
int trimBed(int argc, char *argv[])
{
int help = 0;
int n;
int i;
char *out = 0;
int trim1 = 0;
int trim2 = 0;
while ((n = getopt(argc, argv, "o:r:l:h")) >= 0)
{
switch(n)
{
case 'o' : out = optarg; break;
case 'l' : trim1 = atoi(optarg); break;
case 'r' : trim2 = atoi(optarg); break;
case 'h' : help = 1; break;
default :
errabort("%c : unknown option!", (char)n);
break;
}
if (help) trimHelp();
}
if (trim1 == 0 && trim2 == 0) errabort("You must set a trim size!");
if (trim1 < 0 || trim2 < 0) errabort("Trim size must be a postive int!");
n = argc - optind;
if (n < 1) errabort("Sucker! Set the bed file(s)!");
regHash_t *rghsh = kh_init(reg);
int ret = 0;
for (i = 0; i < n; ++i)
{
bedHand->read(argv[optind+i], rghsh, 0, 0, &ret);
}
bedHand->merge(rghsh);
if (ret)
{
warnings("the input bed file might not be standard bed format 0-based, please make sure the input files is in same base system"
"you can use '1to0' to trans the base systems first");
}
inf_t *itmp = bedHand->stat(rghsh);
bedHand->trim(rghsh, trim1, trim2);
inf_t *inf = bedHand->stat(rghsh);
if (out) bedHand->save(out, rghsh);
unsigned trim_length = itmp->length - inf->length;
writeout("Trimmed %d bp\n"
"The length of whole regions is %d bp\n"
,trim_length, inf->length);
freemem(itmp);
freemem(inf);
bedHand->destroy(rghsh, destroy_void);
return 1;
}
/*
* This function completely eradicates from memory a given hash table,
* releasing all objects
*/
void killHT(struct HT *ht)
{
int i;
struct hash_item *t, *n;
for (i = 0; i < ht->nb_lists; i ++) for (t = ht->lists[i]; t;) {
n = t->next;
(*(ht->deldata))(t->data);
freemem(t);
t = n;
}
freemem(ht);
}
void
del_tet3dbuilder(ptet3dbuilder tb)
{
uint i;
for (i = 0; i < tb->vertices; i++)
del_edgeentry(tb->elist[i]);
del_tetentry(tb->tlist);
freemem(tb->elist);
freemem(tb->x);
freemem(tb);
}
void
del_cluster(pcluster t)
{
uint i;
if (t->sons > 0) {
for (i = 0; i < t->sons; i++)
del_cluster(t->son[i]);
freemem(t->son);
}
freemem(t->bmax);
freemem(t->bmin);
freemem(t);
}
void freemem(node_t * tree)
{
if((!tree))
{
return;
}
else
{
freemem(tree->left);
freemem(tree->right);
// printf("%s\n",tree->val);
free(tree->val);
free(tree);
}
}
/**
* @brief This function frees the data structures.
*/
void end_machine() {
#if DEBUG
printf("\n%d %d %d\n", ap, op, ip);
#endif
freemem((char*)prog, sizeof(Scode)*code_size);
freemem((char*)astack, sizeof(Adescr*)*asize);
freemem((char*)ostack, sizeof(Odescr*)*osize);
freemem(istack, isize);
free_str_c_table();
printf("\nProgram executed without errors\n");
printf("Allocation: %ld bytes\n", size_allocated);
printf("Deallocation: %ld bytes\n", size_deallocated);
printf("Residue: %ld bytes\n", size_allocated - size_deallocated);
}
/* sets state of future to FREE */
syscall future_free(future *f){
intmask mask;
mask = disable();
if(f->flag != FUTURE_EXCLUSIVE){
freemem((char*)f->get_queue, sizeof(queue));
if(f->flag != FUTURE_SHARED){
freemem((char*)f->set_queue, sizeof(queue));
return OK;
}
}
freemem((char*)f, sizeof(f));
restore(mask);
return OK;
}