// This returns #t if successful, or a number (the correct length) if there was a mismatched length. ptr s_fftw_execute (ptr vec, uptr plan) { int i; int len = Svector_length(vec); int N = len / 2; clock_t start, end; plan_t* p = (plan_t*) plan; /*printf("Executing!! len %i incoming len %i\n", p->vec_len, Svector_length(vec)); for (i=0; i<10; i++) printf(" Got element %i %lf\n", i, ((double*)p->vec)[i]); printf(" Got element %i %lf\n", 262000, ((double*)p->vec)[262000]); printf(" Got element %i %lf\n", 524000, ((double*)p->vec)[524000]);*/ // TODO: CHECK THAT LENGTH IS RIGHT! if (N != p->vec_len) { printf("Mismatched lengths! %i %i\n", N, p->vec_len); return(Sfixnum((uptr)p->vec_len)); } //printf("Measuring... "); fflush( 0 ); //start = clock(); //end = clock(); //printf("Done. (time used %i)\n", end - start); fflush( 0 ); //printf("Filling... \n"); fflush( 0 ); for(i=0; i<len; i+=2) { /*printf("Loading: real %lf, imag %lf\n", Sflonum_value(Svector_ref(vec, i)), Sflonum_value(Svector_ref(vec, i+1)));*/ ((double*)p->vec)[i] = Sflonum_value(Svector_ref(vec, i)); ((double*)p->vec)[i+1] = Sflonum_value(Svector_ref(vec, i+1)); } //printf("Done\n"); //printf("Executing... "); fflush( 0 ); //start = clock(); fftw_execute(p->plan); //end = clock(); //printf("Done. (time used %i)\n", end - start); fflush( 0 ); //printf("Clocks per sec... %i\n", CLOCKS_PER_SEC); // Fill the output back into the vector: for(i=0; i<len; i++) { //printf("Unloading: %lf\n", ((double*)out)[i]); Svector_set(vec, i, Sflonum(((double*)p->vec)[i])); } }
static ptr eval(ptr x) { if (Spairp(x)) { switch (Schar_value(Scar(x))) { case '+': return S_add(First(x), Second(x)); case '-': return S_sub(First(x), Second(x)); case '*': return S_mul(First(x), Second(x)); case '/': return S_div(First(x), Second(x)); case 'q': return S_trunc(First(x), Second(x)); case 'r': return S_rem(First(x), Second(x)); case 'g': return S_gcd(First(x), Second(x)); case '=': { ptr x1 = First(x), x2 = Second(x); if (Sfixnump(x1) && Sfixnump(x2)) return Sboolean(x1 == x2); else if (Sbignump(x1) && Sbignump(x2)) return Sboolean(S_big_eq(x1, x2)); else return Sfalse; } case '<': { ptr x1 = First(x), x2 = Second(x); if (Sfixnump(x1)) if (Sfixnump(x2)) return Sboolean(x1 < x2); else return Sboolean(!BIGSIGN(x2)); else if (Sfixnump(x2)) return Sboolean(BIGSIGN(x1)); else return Sboolean(S_big_lt(x1, x2)); } case 'f': return Sflonum(S_floatify(First(x))); case 'c': S_gc(get_thread_context(), UNFIX(First(x)),UNFIX(Second(x))); return Svoid; case 'd': return S_decode_float(Sflonum_value(First(x))); default: S_prin1(x); putchar('\n'); printf("unrecognized operator, returning zero\n"); return FIX(0); } } else return x; }