short
CompVar(short t, Type *baseType, long storFlags, long regFlags, Var **pvar)
{
Var *var = NULL;
Type *type;
Symbol *sym = NULL;
long extraTypeFlags = 0; /* propogated through override */
short protoVoid = 0;
/*
* step 1, parse the name .. get the name symbol and representitive type
*/
type = baseType;
t = CompTypeDeclarators(t, &type, &sym, storFlags);
if (type->Flags & TF_STKCALL) storFlags &= ~TF_REGCALL;
if (t == TokColon) {
long bits;
Exp *exp = NULL;
if (StructLevel == 0)
zerror(EERROR_ILLEGAL_BITFIELD_OP);
if (type->Id != TID_INT || (type->Size != 4 && type->Size != 2))
zerror(EERROR_ILLEGAL_BITFIELD_OP);
t = GetToken();
t = CompExp(t, &exp, 0);
bits = ExpToConstant(exp);
if (bits > 32 || bits < 0) {
zerror(EERROR_ILLEGAL_BITFIELD_OP);
bits = 32;
}
type = MakeBitfieldType(type->Flags & TF_UNSIGNED, bits);
}
/*
* Create final type that includes storage qualifiers.
*/
if ((storFlags & TF_STORNOTLOCAL) == 0 && State != SOUTSIDE)
{
/* Check to see that this is a pointer to a function */
if (type->Id != TID_PTR ||
type->SubType == NULL ||
type->SubType->Id != TID_PROC)
{
if (storFlags & TF_AUTOILLEGAL)
zerror(EERROR_ILLEGAL_QUALIFIER);
}
storFlags |= TF_AUTO;
}
{
long tflags = (type->Flags | storFlags) & ~TF_NOTINTYPE;
if (type->Flags != tflags)
type = TypeToQualdType(type, tflags);
}
/*
* If typedef we stop here
*/
if (pvar == NULL) {
if (type->Flags != (type->Flags | storFlags))
type = TypeToQualdType(type, type->Flags | storFlags);
if (t != TokSemi && t != TokComma)
zerror(EERROR_ILLEGAL_TYPEDEF);
if (sym)
SemanticAdd(sym, TokTypeId, type);
else
zerror(EERROR_ILLEGAL_TYPEDEF);
return(t);
}
/*
* definitely a variable. Check for overide of previous def
* in this block level, or global block level if not auto.
*
* STATIC VARIABLES inside subroutines are special, they do not bother
* global variables outside subroutines of the same name.
*
* check opt '= exp' and optional code if a procedure
*/
if (sym == NULL)
{
/* Well, we have a syntax error */
zerror(EERROR_SYNTAX_ERROR_DECL);
sym = MakeSymbol("<PHONEYSYM>", 11, LFBase->lf_Index, NULL);
storFlags |= VF_DECLD;
}
if (StructLevel == 0 && (var = BlockRemoveDuplicateVar(storFlags, sym, type))) {
extraTypeFlags = (var->Type->Flags | storFlags) & TF_KEEPPROC;
if (var->Type->Args == 0) /* proto was ... foo(void) */
protoVoid = 1;
if ((type->Flags & TF_KEEPPROC) != (extraTypeFlags & TF_KEEPPROC))
type = TypeToQualdType(type, type->Flags | extraTypeFlags);
}
if (var == NULL) {
if (StructLevel == 0 && State != SOUTSIDE && (storFlags & TF_STORNOTLOCAL) == 0 && type->Id != TID_PROC) {
var = AllocTmpStructure(Var); /* does not survive subroutine */
} else {
var = AllocStructure(Var); /* permanent */
}
if (sym && StructLevel == 0) {
if (type->Id == TID_PROC || (storFlags & TF_EXTERN))
SemanticAddTop(sym, TokVarId, var);
else
SemanticAdd(sym, TokVarId, var);
}
}
var->Type = type;
var->Sym = sym;
var->LexIdx = LFBase->lf_Index;
if (storFlags & TF_REGISTER)
++var->Refs;
if ((type->Id == TID_STRUCT || type->Id == TID_UNION) && (type->Size == 0))
{
Undefined_Tag(type, sym, LFBase->lf_Index);
}
*pvar = var;
if (State == SOUTSIDE && (storFlags & TF_AUTO))
zerror(EERROR_ILLEGAL_QUALIFIER);
var->Flags = type->Flags | storFlags | extraTypeFlags | (var->Flags & VF_DECLD);
var->RegFlags = regFlags;
#ifdef DYNAMIC
if ((var->Flags & (TF_EXTERN|TF_DYNAMIC)) == TF_DYNAMIC) {
var->Type = type = TypeToPtrType(var->Type);
asm_dynamictag(var);
}
#endif
if (type->Id == TID_PROC) {
if (t != TokSemi && t != TokComma) { /* definition */
var->Flags &= ~(VF_DECLD | TF_EXTERN);
/*
* if not a prototyped procedure must munge arguments properly.
* This applies to floats, for example, which are really doubles
* for non-prototyped procedures.
*/
if ((type->Flags & TF_PROTOTYPE) == 0) {
short i;
for (i = 0; i < type->Args; ++i) {
Type **t2 = &type->Vars[i]->Type;
*t2 = ActualArgType(*t2);
}
}
/*
* munge routine prototyped as foo(void) but declared foo()
*/
if (protoVoid && type->Args < 0)
var->Type = type = TypeToProcType(type->SubType, NULL, 0, type->Flags | TF_PROTOTYPE);
if (var->u.Block && !(var->Flags & TF_STATIC))
zerror(EERROR_MULTIPLY_DEFINED_PROC);
t = CompProcedure(t, var);
} else {
if (var->u.Block == NULL) {
if (!(var->Flags & TF_STATIC))
var->Flags |= TF_EXTERN;
} else {
zerror(EERROR_MULTIPLY_DEFINED_PROC);
}
/*
* Generate Register Specification Output Data
*/
if (RegSpecOutputOpt)
GenerateRegSpecOutput(var);
}
} else {
if (t == TokEq) { /* assigned expression */
Exp *exp;
/* Any assignment to a global variable will eliminate the extern */
/* portion of the symbol. This is in accordance to ANSI. */
var->Flags &= ~TF_EXTERN;
if (StructLevel)
zerror(EERROR_ILLEGAL_ASSIGNMENT);
t = GetToken();
if (t == TokLBrace)
{
t = CompBracedAssign(GetToken(), var->Type, &exp, 1, sym);
if (t != TokRBrace)
{
zerror(EERROR_TOO_MANY_INITIALIZERS);
t = match_nesting(t);
}
t = GetToken();
}
else if (t == TokStrConst && var->Type->Id == TID_ARY)
{
t = CompBracedAssign(t, var->Type, &exp, 0, sym);
}
else if ((var->Flags & TF_AUTO) == 0)
{
t = CompBracedAssign(t, var->Type, &exp, 0, sym);
} else
{
/* If we get here, we know that the TF_AUTO bit is on. If */
/* the TF_STATIC flag is also set, this should be diagnosed */
/* This logic used to be in the previous test, but since it */
/* really can never occur, we moved it down here and expect */
/* to take it out after the beta. */
/* Note that the assignment code will be pulled out by the */
/* block code in stmt.c (only simple assignments) */
if (var->Flags & TF_STATIC)
{
dbprintf(("Unexpected Type %ld\n", var->Flags));
Assert(0);
}
t = CompExp(t, &exp, 0);
}
var->u.AssExp = exp;
}
}
return(t);
}
void appft(int niter, double *total_time, logical *verified)
{
int i, j, k, kt, n12, n22, n32, ii, jj, kk, ii2, ik2;
double ap;
dcomplex exp1[NX], exp2[NY], exp3[NZ];
for (i = 1; i <= 15; i++) {
timer_clear(i);
}
timer_start(2);
compute_initial_conditions(NX, NY, NZ, xnt);
CompExp(NX, exp1);
CompExp(NY, exp2);
CompExp(NZ, exp3);
fftXYZ(1, NX, NY, NZ, xnt, (dcomplex *)y, exp1, exp2, exp3);
timer_stop(2);
timer_start(1);
if (timers_enabled) timer_start(13);
n12 = NX / 2;
n22 = NY / 2;
n32 = NZ / 2;
ap = -4.0 * ALPHA * (PI * PI);
for (i = 0; i < NZ; i++) {
ii = i - (i / n32) * NZ;
ii2 = ii * ii;
for (k = 0; k < NY; k++) {
kk = k - (k / n22) * NY;
ik2 = ii2 + kk*kk;
for (j = 0; j < NX; j++) {
jj = j - (j / n12) * NX;
twiddle[i][k][j] = exp(ap*(double)(jj*jj + ik2));
}
}
}
if (timers_enabled) timer_stop(13);
if (timers_enabled) timer_start(12);
compute_initial_conditions(NX, NY, NZ, xnt);
if (timers_enabled) timer_stop(12);
if (timers_enabled) timer_start(15);
fftXYZ(1, NX, NY, NZ, xnt, (dcomplex *)y, exp1, exp2, exp3);
if (timers_enabled) timer_stop(15);
for (kt = 1; kt <= niter; kt++) {
if (timers_enabled) timer_start(11);
evolve(NX, NY, NZ, xnt, y, twiddle);
if (timers_enabled) timer_stop(11);
if (timers_enabled) timer_start(15);
fftXYZ(-1, NX, NY, NZ, xnt, (dcomplex *)xnt, exp1, exp2, exp3);
if (timers_enabled) timer_stop(15);
if (timers_enabled) timer_start(10);
CalculateChecksum(&sums[kt], kt, NX, NY, NZ, xnt);
if (timers_enabled) timer_stop(10);
}
// Verification test.
if (timers_enabled) timer_start(14);
verify(NX, NY, NZ, niter, sums, verified);
if (timers_enabled) timer_stop(14);
timer_stop(1);
*total_time = timer_read(1);
if (!timers_enabled) return;
printf(" FT subroutine timers \n");
printf(" %26s =%9.4f\n", "FT total ", timer_read(1));
printf(" %26s =%9.4f\n", "WarmUp time ", timer_read(2));
printf(" %26s =%9.4f\n", "fftXYZ body ", timer_read(3));
printf(" %26s =%9.4f\n", "Swarztrauber ", timer_read(4));
printf(" %26s =%9.4f\n", "X time ", timer_read(7));
printf(" %26s =%9.4f\n", "Y time ", timer_read(8));
printf(" %26s =%9.4f\n", "Z time ", timer_read(9));
printf(" %26s =%9.4f\n", "CalculateChecksum ", timer_read(10));
printf(" %26s =%9.4f\n", "evolve ", timer_read(11));
printf(" %26s =%9.4f\n", "compute_initial_conditions", timer_read(12));
printf(" %26s =%9.4f\n", "twiddle ", timer_read(13));
printf(" %26s =%9.4f\n", "verify ", timer_read(14));
printf(" %26s =%9.4f\n", "fftXYZ ", timer_read(15));
printf(" %26s =%9.4f\n", "Benchmark time ", *total_time);
}
