static double
gplan (double J, struct plantbl *plan)
{
double su, cu, sv, cv;
double t, sl;
int j, k, m, k1, ip, np, nt;
CHAR *p;
int *pl;
dargs (J, plan);
/* Point to start of table of arguments. */
p = plan->arg_tbl;
/* Point to tabulated cosine and sine amplitudes. */
pl = plan->lon_tbl;
sl = 0.0;
for (;;)
{
/* Find sine and cosine of argument for this term in the series.
The argument has the form J_1 L_1 + J_2 L_2 + ...
where J_i are integers and L_i are mean elements. */
/* Number of periodic arguments. */
np = *p++;
if (np < 0)
break;
if (np == 0)
{
/* If no periodic arguments, it is a polynomial term.
Evaluate A_n T^n + A_n-1 T^n-1 + ... + A_0. */
nt = *p++;
cu = *pl++;
for (ip = 0; ip < nt; ip++)
cu = cu * T + *pl++;
sl += cu;
continue;
}
k1 = 0;
cv = 0.0;
sv = 0.0;
for (ip = 0; ip < np; ip++)
{
/* What harmonic. */
j = *p++;
/* Which planet. */
m = *p++ - 1;
if (j)
{
k = j;
if (j < 0)
k = -k;
k -= 1;
/* sin(k*angle) for planet m. */
su = ss[m][k];
if (j < 0)
su = -su;
/* cos(k*angle) for planet m. */
cu = cc[m][k];
if (k1 == 0)
{
/* Set sine and cosine of first angle. */
sv = su;
cv = cu;
k1 = 1;
}
else
{
/* Combine angles by trigonometry. */
t = su * cv + cu * sv;
cv = cu * cv - su * sv;
sv = t;
}
}
}
/* Now cv = cos(arg), sv = sin(arg).
Evaluate
cu = (C_n T^n + C_n-1 T^n-1 + ... + C_0) cos(arg)
su = (S_n T^n + S_n-1 T^n-1 + ... + S_0) sin(arg). */
/* Highest power of T. */
nt = *p++;
/* Coefficients C_i, S_i. */
cu = *pl++;
su = *pl++;
for (ip = 0; ip < nt; ip++)
{
cu = cu * T + *pl++;
su = su * T + *pl++;
}
sl += cu * cv + su * sv;
}
return (plan->trunclvl * sl);
}
void type::dcl(Ptable tbl)
/*
go through the type (list) and
(1) evaluate vector dimensions
(2) evaluate field sizes
(3) lookup struct tags, etc.
(4) handle implicit tag declarations
*/
{
Ptype t = this;
// processing_sizeof suppresses errors for refs to names in the arg
// to sizeof. Turn errors back on for exprs within type specs
// (such as array subscripts)
int os = processing_sizeof;
processing_sizeof = 0;
if (this == 0)
error('i',"T::dcl(this==0)");
if (tbl->base != TABLE)
error('i',"T::dcl(%d)",tbl->base);
xx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto xx;
case PTR:
case RPTR:
{
Pptr p = Pptr(t);
if(p->memof == 0 && p->ptname) { // T::*, where T is a template formal
Ptype tp = p->ptname->tp->skiptypedefs();
switch (tp->base) {
case COBJ:
{
p->memof = tp->classtype();
if (p->typ)
{
Ptype t = p->typ->skiptypedefs();
if (t && t->base==FCT)
{
Pfct(t)->memof = p->memof;
}
}
break;
}
case CLASS:
{
p->memof = Pclass(tp);
Ptype t = p->typ->skiptypedefs();
Pfct f = Pfct(t); // safe???
f->memof = p->memof;
break;
}
default:
error("illegalZizedP toM %t::*",tp);
break;
}
}
t = p->typ;
if (t->base == TYPE) {
Ptype tt = Pbase(t)->b_name->tp;
if (tt->base == FCT)
p->typ = tt;
goto done;
}
goto xx;
}
case VEC:
{
Pvec v = Pvec(t);
Pexpr e = v->dim;
if (e) {
Ptype et;
v->dim = e = e->typ(tbl);
if (e->tp->skiptypedefs()->base == COBJ) {
e = check_cond(e,DEREF,tbl);
v->dim = e;
}
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in array dimension");
}
else {
long long i;
Neval = 0;
i = e->eval();
if (Neval == 0) {
if (largest_int<i)
error("array dimension too large");
v->size = int(i);
DEL(v->dim);
v->dim = 0;
}
if (new_type) {
if (Neval)
;
else if (i == 0)
v->dim = zero;
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
else {
if (Neval)
error("%s",Neval);
else if (i == 0) {
error("array dimension == 0");
v->dim=e;
}
else if (i < 0) {
error("negative array dimension");
i = 1;
}
}
}
}
t = v->typ;
llx:
switch (t->base) {
case TYPE:
t = Pbase(t)->b_name->tp;
goto llx;
case FCT:
v->typ = t;
break;
case VEC:
if (Pvec(t)->dim==0 && Pvec(t)->size==0)
error("null dimension (something like [][] seen)");
}
goto xx;
}
case FCT:
{
Pfct f = Pfct(t);
void dargs(Pname, Pfct, Ptable);
if (f->argtype)
dargs(0,f,tbl);
for (Pname n=f->argtype; n; n = n->n_list) {
Ptype t = n->tp;
n->tp->dcl(tbl);
while(t->base==TYPE)
t = Pbase(t)->b_name->tp;
if(t->base==VEC)
n->tp = new ptr(PTR,Pvec(t)->typ);
}
Pname cn = f->returns->is_cl_obj();
if (cn && Pclass(cn->tp)->has_itor())
make_res(f);
else if (f->f_this == 0)
f->f_args = f->argtype;
t = f->returns;
goto xx;
}
case FIELD:
{
Pbase f = Pbase(t);
Pexpr e = Pexpr(f->b_name);
long long i;
Ptype et;
e = e->typ(tbl);
f->b_name = Pname(e);
et = e->tp;
if (et->integral(0) == 'A') {
error("UN in field size");
i = 1;
}
else {
Neval = 0;
i = e->eval();
if (Neval)
error("%s",Neval);
else if (i < 0) {
error("negative field size");
i = 1;
}
else if (f->b_fieldtype->tsizeof()*BI_IN_BYTE < i)
error("field size > sizeof(%t)",f->b_fieldtype);
DEL(e);
}
f->b_bits = int(i);
f->b_name = 0;
break;
}
}
done:
processing_sizeof = os;
return;
}