int
main(int argc, char *argv[])
{
(void) setlocale(LC_ALL, "");
#if !defined(TEXT_DOMAIN) /* Should be defined by cc -D */
#define TEXT_DOMAIN "SYS_TEST" /* Use this only if it weren't */
#endif
(void) textdomain(TEXT_DOMAIN);
setup(argc, argv); /* initialize and read productions */
TBITSET = NWORDS(ntoksz*LKFACTOR);
tbitset = NWORDS(ntokens*LKFACTOR);
mktbls();
cpres(); /* make table of which productions yield a */
/* given nonterminal */
cempty(); /* make a table of which nonterminals can match */
/* the empty string */
cpfir(); /* make a table of firsts of nonterminals */
stagen(); /* generate the states */
output(); /* write the states and the tables */
go2out();
hideprod();
summary();
callopt();
others();
return (0);
}
// Note that this function updates len
static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len)
{
assert(jl_is_datatype(dt));
jl_datatype_t *bt = (jl_datatype_t*)dt;
size_t nb = jl_datatype_size(bt);
if (nb == 0)
return jl_new_struct_uninit(bt);
*len = LLT_ALIGN(*len, bt->alignment);
data = (char*)data + (*len);
*len += nb;
if (bt == jl_uint8_type) return jl_box_uint8(*(uint8_t*)data);
if (bt == jl_int64_type) return jl_box_int64(*(int64_t*)data);
if (bt == jl_bool_type) return (*(int8_t*)data) ? jl_true:jl_false;
if (bt == jl_int32_type) return jl_box_int32(*(int32_t*)data);
if (bt == jl_float64_type) return jl_box_float64(*(double*)data);
jl_value_t *v = (jl_value_t*)newobj((jl_value_t*)bt, NWORDS(nb));
switch (nb) {
case 1: *(int8_t*) jl_data_ptr(v) = *(int8_t*)data; break;
case 2: *(int16_t*) jl_data_ptr(v) = *(int16_t*)data; break;
case 4: *(int32_t*) jl_data_ptr(v) = *(int32_t*)data; break;
case 8: *(int64_t*) jl_data_ptr(v) = *(int64_t*)data; break;
case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
default: memcpy(jl_data_ptr(v), data, nb);
}
return v;
}
jl_struct_type_t *jl_new_uninitialized_struct_type(size_t nfields)
{
return (jl_struct_type_t*)
newobj((jl_type_t*)jl_struct_kind,
NWORDS(sizeof(jl_struct_type_t) - sizeof(void*) +
(nfields-1)*sizeof(jl_fielddesc_t)));
}
jl_typector_t *jl_new_type_ctor(jl_svec_t *params, jl_value_t *body)
{
jl_typector_t *tc = (jl_typector_t*)newobj((jl_value_t*)jl_typector_type,NWORDS(sizeof(jl_typector_t)));
tc->parameters = params;
tc->body = body;
return (jl_typector_t*)tc;
}
jl_datatype_t *jl_new_uninitialized_datatype(size_t nfields)
{
return (jl_datatype_t*)
newobj((jl_value_t*)jl_datatype_type,
NWORDS(sizeof(jl_datatype_t) - sizeof(void*) +
(nfields-1)*sizeof(jl_fielddesc_t)));
}
JL_DLLEXPORT jl_lambda_info_t *jl_new_lambda_info_uninit(void)
{
jl_lambda_info_t *li =
(jl_lambda_info_t*)newobj((jl_value_t*)jl_lambda_info_type,
NWORDS(sizeof(jl_lambda_info_t)));
li->code = NULL;
li->slotnames = li->slotflags = NULL;
li->slottypes = li->ssavaluetypes = NULL;
li->rettype = (jl_value_t*)jl_any_type;
li->sparam_syms = jl_emptysvec;
li->sparam_vals = jl_emptysvec;
li->fptr = NULL;
li->jlcall_api = 0;
li->compile_traced = 0;
li->functionObjectsDecls.functionObject = NULL;
li->functionObjectsDecls.specFunctionObject = NULL;
li->functionID = 0;
li->specFunctionID = 0;
li->specTypes = NULL;
li->unspecialized_ducttape = NULL;
li->inferred = 0;
li->inInference = 0;
li->inCompile = 0;
li->def = NULL;
li->pure = 0;
li->inlineable = 0;
return li;
}
/*
* Straightforward Sieve of Eratosthenes, but skipping 3.
*
* Uses 1 bit per odd number.
*
* Time for Pi(10^10) = 48.5s
*/
static WTYPE* sieve_base23(WTYPE end)
{
WTYPE* mem;
size_t n, s;
size_t last = (end+1)/2;
mem = (WTYPE*) calloc( NWORDS(last), sizeof(WTYPE) );
assert(mem != 0);
SET_ARRAY_BIT(mem, 1/2); /* 1 is composite */
/* Mark all multiples of 3. Could skip if callers know this. */
for (n = 3*3; n <= end; n += 2*3) SET_ARRAY_BIT(mem,n/2);
n = 5;
while ( (n*n) <= end ) {
if (!IS_SET_ARRAY_BIT(mem,n/2)) {
for (s = n*n; s <= end; s += 2*n) {
SET_ARRAY_BIT(mem,s/2);
}
}
n += 2;
if ( ((n*n) <= end) && (!IS_SET_ARRAY_BIT(mem,n/2)) ) {
for (s = n*n; s <= end; s += 2*n) {
SET_ARRAY_BIT(mem,s/2);
}
}
n += 4;
}
return mem;
}
jl_uniontype_t *jl_new_uniontype(jl_svec_t *types)
{
jl_uniontype_t *t = (jl_uniontype_t*)newobj((jl_value_t*)jl_uniontype_type,NWORDS(sizeof(jl_uniontype_t)));
// don't make unions of 1 type; Union(T)==T
assert(jl_svec_len(types) != 1);
t->types = types;
return t;
}
jl_datatype_t *jl_new_uninitialized_datatype(size_t nfields)
{
jl_datatype_t *t = (jl_datatype_t*)
newobj((jl_value_t*)jl_datatype_type,
NWORDS(sizeof(jl_datatype_t) + nfields*sizeof(jl_fielddesc_t)));
t->nfields = nfields;
return t;
}
static jl_value_t *new_scalar(jl_bits_type_t *bt)
{
size_t nb = jl_bitstype_nbits(bt)/8;
jl_value_t *v =
(jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
sizeof(void*));
v->type = (jl_type_t*)bt;
return v;
}
/*
* Better Sieve of Atkin.
*
* Uses 1 bit per odd number.
*
* Just some simple optimizations to make it a little better. Still not good.
*
* Time for Pi(10^10) = 97.2s
*/
static WTYPE* sieve_atkin_2(WTYPE end)
{
WTYPE* mem;
size_t x, y, n, sqlimit;
size_t last = (end+1+1)/2;
long loopend, y_limit, dn;
end++;
mem = (WTYPE*) malloc( NWORDS(last) * sizeof(WTYPE) );
assert(mem != 0);
/* mark everything as a composite */
memset(mem, 0xFF, NBYTES(last));
sqlimit = sqrtf(end);
for (x = 1; x <= sqlimit; x++) {
{
size_t xx4 = 4*x*x;
y = 1;
for (n = xx4+1; n <= end; n = xx4+y*y) {
size_t nmod12 = n%12;
if ( (nmod12 == 1) || (nmod12 == 5) )
XOR_ARRAY_BIT(mem,n/2);
y++;
}
}
{
size_t xx3 = 3*x*x;
y = 1;
for (n = xx3+1; n <= end; n = xx3+y*y) {
size_t nmod12 = n%12;
if (nmod12 == 7)
XOR_ARRAY_BIT(mem,n/2);
y++;
}
y = x-1;
while ( y*y >= xx3 )
y--;
for (n = xx3-y*y; y >= 1 && n <= end; n = xx3-y*y) {
size_t nmod12 = n%12;
if (nmod12 == 11)
XOR_ARRAY_BIT(mem,n/2);
y--;
}
}
}
/* Mark all squares of primes as composite */
for (n = 5; n <= sqlimit; n += 2)
if (!IS_SET_ARRAY_BIT(mem,n/2))
for (y = n*n; y <= end; y += 2*n*n)
SET_ARRAY_BIT(mem,y/2);
CLR_ARRAY_BIT(mem, 3/2); /* 3 is prime */
return mem;
}
DLLEXPORT jl_function_t *jl_new_closure(jl_fptr_t fptr, jl_value_t *env,
jl_lambda_info_t *linfo)
{
jl_function_t *f = (jl_function_t*)alloc_3w(); assert(NWORDS(sizeof(jl_function_t))==3);
jl_set_typeof(f, jl_function_type);
f->fptr = (fptr!=NULL ? fptr : linfo->fptr);
f->env = env;
f->linfo = linfo;
return f;
}
jl_typename_t *jl_new_typename(jl_sym_t *name)
{
jl_typename_t *tn=(jl_typename_t*)newobj((jl_value_t*)jl_typename_type, NWORDS(sizeof(jl_typename_t)));
tn->name = name;
tn->module = jl_current_module;
tn->primary = NULL;
tn->cache = (jl_value_t*)jl_emptysvec;
tn->names = NULL;
tn->uid = jl_assign_type_uid();
return tn;
}
jl_expr_t *jl_exprn(jl_sym_t *head, size_t n)
{
jl_array_t *ar = n==0 ? (jl_array_t*)jl_an_empty_vec_any : jl_alloc_vec_any(n);
JL_GC_PUSH1(&ar);
jl_expr_t *ex = (jl_expr_t*)jl_gc_alloc_3w(); assert(NWORDS(sizeof(jl_expr_t))==3);
jl_set_typeof(ex, jl_expr_type);
ex->head = head;
ex->args = ar;
ex->etype = (jl_value_t*)jl_any_type;
JL_GC_POP();
return ex;
}
/*
* Naive Wheel factoring based on algorithm Ek from Sorenson 1991
*
* Uses 1 bit per odd number.
*
* Note we're including initialization code that marks all 3,5 multiples.
* If the caller didn't look at these, this could be skipped.
*
* Time for Pi(10^10) = 46.4s
*/
static WTYPE* sieve_eratek(WTYPE end)
{
WTYPE* mem;
size_t p, f, x;
size_t last = (end+1)/2;
static const WTYPE wheel[] = {1, 7, 11, 13, 17, 19, 23, 29};
static const WTYPE W[] = {0,6,0,0,0,0,0,4,0,0,0,2,0,4,0,0,0,2,0,4,0,0,0,6,0,0,0,0,0,2,0};
mem = (WTYPE*) calloc( NWORDS(last), sizeof(WTYPE) );
assert(mem != 0);
/* Mark all multiples of 3 and 5 as composite. */
//for (p = 3*3; p <= end; p += 2*3) SET_ARRAY_BIT(mem,p/2);
//for (p = 5*5; p <= end; p += 2*5) SET_ARRAY_BIT(mem,p/2);
p = 9;
while (p <= end) {
SET_ARRAY_BIT(mem,p/2); p += 6; if (p > end) break; // mark 9, p = 15
SET_ARRAY_BIT(mem,p/2); p += 6; if (p > end) break; // mark 15, p = 21
SET_ARRAY_BIT(mem,p/2); p += 4; if (p > end) break; // mark 21, p = 25
SET_ARRAY_BIT(mem,p/2); p += 2; if (p > end) break; // mark 25, p = 27
SET_ARRAY_BIT(mem,p/2); p += 6; if (p > end) break; // mark 27, p = 33
SET_ARRAY_BIT(mem,p/2); p += 2; if (p > end) break; // mark 33, p = 35
SET_ARRAY_BIT(mem,p/2); p += 4; // mark 35, p = 39
}
p = 7;
while ((p*p) <= end) {
{
size_t fidx = p%30;
f = p;
/* Here's the problem -- for each prime, we're walking the array from
* start to finish 8 times. The operation count is the same as the
* faster wheel-30 sieves, but this is just horrible for the cache. */
while (f < p+30) {
for (x = p*f; x <= end; x += p*30)
SET_ARRAY_BIT(mem,x/2);
size_t move = W[fidx];
f += move; fidx += move;
if (fidx > 30) fidx -= 30;
}
}
//p = next_prime(p);
do { p += 2; } while (IS_SET_ARRAY_BIT(mem,p/2));
}
SET_ARRAY_BIT(mem, 1/2); /* 1 is composite */
CLR_ARRAY_BIT(mem, 3/2); /* 3 is prime */
CLR_ARRAY_BIT(mem, 5/2); /* 5 is prime */
return mem;
}
JL_DLLEXPORT jl_value_t *jl_new_type_constructor(jl_svec_t *p, jl_value_t *body)
{
#ifndef NDEBUG
size_t i, np = jl_svec_len(p);
for (i = 0; i < np; i++) {
jl_tvar_t *tv = (jl_tvar_t*)jl_svecref(p, i);
assert(jl_is_typevar(tv) && !tv->bound);
}
#endif
jl_typector_t *tc = (jl_typector_t*)newobj((jl_value_t*)jl_typector_type, NWORDS(sizeof(jl_typector_t)));
tc->parameters = p;
tc->body = body;
return (jl_value_t*)tc;
}
JL_DLLEXPORT jl_datatype_t *jl_new_uninitialized_datatype(size_t nfields, int8_t fielddesc_type)
{
// fielddesc_type is specified manually for builtin types
// and is (will be) calculated automatically for user defined types.
uint32_t fielddesc_size = jl_fielddesc_size(fielddesc_type);
jl_datatype_t *t = (jl_datatype_t*)
newobj((jl_value_t*)jl_datatype_type,
NWORDS(sizeof(jl_datatype_t) + nfields * fielddesc_size));
// fielddesc_type should only be assigned here. It can cause data
// corruption otherwise.
t->fielddesc_type = fielddesc_type;
t->nfields = nfields;
t->haspadding = 0;
t->pointerfree = 0;
return t;
}
JL_DLLEXPORT jl_typename_t *jl_new_typename_in(jl_sym_t *name, jl_module_t *module)
{
jl_typename_t *tn=(jl_typename_t*)newobj((jl_value_t*)jl_typename_type, NWORDS(sizeof(jl_typename_t)));
tn->name = name;
tn->module = module;
tn->primary = NULL;
tn->cache = jl_emptysvec;
tn->linearcache = jl_emptysvec;
tn->names = NULL;
tn->uid = jl_assign_type_uid();
tn->mt = NULL;
JL_GC_PUSH1(&tn);
tn->mt = NULL;
JL_GC_POP();
return tn;
}
static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len)
{
if (jl_is_tuple(dt)) {
jl_tuple_t *tuple = (jl_tuple_t*)dt;
*len = LLT_ALIGN(*len, jl_new_bits_align(dt));
size_t i, l = jl_tuple_len(tuple);
jl_value_t *v = (jl_value_t*) jl_alloc_tuple(l);
JL_GC_PUSH1(v);
for (i = 0; i < l; i++) {
jl_tupleset(v,i,jl_new_bits_internal(jl_tupleref(tuple,i), (char*)data, len));
}
JL_GC_POP();
return v;
}
jl_datatype_t *bt = (jl_datatype_t*)dt;
size_t nb = jl_datatype_size(bt);
if (nb == 0)
return jl_new_struct_uninit(bt);
*len = LLT_ALIGN(*len, bt->alignment);
data = (char*)data + (*len);
*len += nb;
if (bt == jl_uint8_type) return jl_box_uint8(*(uint8_t*)data);
if (bt == jl_int64_type) return jl_box_int64(*(int64_t*)data);
if (bt == jl_bool_type) return (*(int8_t*)data) ? jl_true:jl_false;
if (bt == jl_int32_type) return jl_box_int32(*(int32_t*)data);
if (bt == jl_float64_type) return jl_box_float64(*(double*)data);
jl_value_t *v =
(jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
sizeof(void*));
v->type = (jl_value_t*)bt;
switch (nb) {
case 1: *(int8_t*) jl_data_ptr(v) = *(int8_t*)data; break;
case 2: *(int16_t*) jl_data_ptr(v) = *(int16_t*)data; break;
case 4: *(int32_t*) jl_data_ptr(v) = *(int32_t*)data; break;
case 8: *(int64_t*) jl_data_ptr(v) = *(int64_t*)data; break;
case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
default: memcpy(jl_data_ptr(v), data, nb);
}
return v;
}
/*
* Naive Sieve of Atkin.
*
* Uses 1 bit per odd number.
*
* This is really slow. Just keeping it here as a reference.
*
* Time for Pi(10^10) = 123.5s
*/
static WTYPE* sieve_atkin_naive(WTYPE end)
{
WTYPE* mem;
size_t x, y, n, sqlimit;
size_t last = (end+1+1)/2;
long loopend, y_limit, dn;
end++;
mem = (WTYPE*) malloc( NWORDS(last) * sizeof(WTYPE) );
assert(mem != 0);
/* mark everything as a composite */
memset(mem, 0xFF, NBYTES(last));
sqlimit = sqrt(end);
for (x = 1; x <= sqlimit; x++) {
for (y = 1; y <= sqlimit; y++) {
n = 4*x*x + y*y;
if ( (n <= end) && (n % 12 == 1 || n % 12 == 5) )
XOR_ARRAY_BIT(mem,n/2);
n = 3*x*x + y*y;
if ( (n <= end) && (n % 12 == 7) )
XOR_ARRAY_BIT(mem,n/2);
n = 3*x*x - y*y;
if ( (n <= end) && (x > y) && (n % 12 == 11) )
XOR_ARRAY_BIT(mem,n/2);
}
}
/* Mark all squares of primes as composite */
for (n = 5; n <= sqlimit; n += 2)
if (!IS_SET_ARRAY_BIT(mem,n/2))
for (y = n*n; y <= end; y += 2*n*n)
SET_ARRAY_BIT(mem,y/2);
CLR_ARRAY_BIT(mem, 3/2); /* 3 is prime */
return mem;
}
JL_DLLEXPORT jl_method_t *jl_new_method_uninit(void)
{
jl_method_t *m =
(jl_method_t*)newobj((jl_value_t*)jl_method_type,
NWORDS(sizeof(jl_method_t)));
m->specializations.unknown = jl_nothing;
m->sig = NULL;
m->tvars = NULL;
m->ambig = NULL;
m->roots = NULL;
m->module = jl_current_module;
m->lambda_template = NULL;
m->name = NULL;
m->file = null_sym;
m->line = 0;
m->called = 0xff;
m->invokes.unknown = NULL;
m->isstaged = 0;
m->needs_sparam_vals_ducttape = 2;
m->traced = 0;
return m;
}
jl_value_t *jl_new_bits(jl_datatype_t *bt, void *data)
{
if (bt == jl_uint8_type) return jl_box_uint8(*(uint8_t*)data);
else if (bt == jl_int64_type) return jl_box_int64(*(int64_t*)data);
else if (bt == jl_bool_type) return (*(int8_t*)data) ? jl_true:jl_false;
else if (bt == jl_int32_type) return jl_box_int32(*(int32_t*)data);
else if (bt == jl_float64_type) return jl_box_float64(*(double*)data);
size_t nb = jl_datatype_size(bt);
jl_value_t *v =
(jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
sizeof(void*));
v->type = (jl_value_t*)bt;
switch (nb) {
case 1: *(int8_t*) jl_data_ptr(v) = *(int8_t*)data; break;
case 2: *(int16_t*) jl_data_ptr(v) = *(int16_t*)data; break;
case 4: *(int32_t*) jl_data_ptr(v) = *(int32_t*)data; break;
case 8: *(int64_t*) jl_data_ptr(v) = *(int64_t*)data; break;
case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
default: memcpy(jl_data_ptr(v), data, nb);
}
return v;
}
DLLEXPORT
jl_lambda_info_t *jl_new_lambda_info(jl_value_t *ast, jl_svec_t *sparams)
{
jl_lambda_info_t *li =
(jl_lambda_info_t*)newobj((jl_value_t*)jl_lambda_info_type,
NWORDS(sizeof(jl_lambda_info_t)));
li->ast = ast;
li->file = null_sym;
li->line = 0;
if (ast != NULL && jl_is_expr(ast)) {
jl_value_t *body1 = skip_meta(jl_lam_body((jl_expr_t*)ast)->args);
if (jl_is_expr(body1) && ((jl_expr_t*)body1)->head == line_sym) {
li->file = (jl_sym_t*)jl_exprarg(body1, 1);
li->line = jl_unbox_long(jl_exprarg(body1, 0));
}
}
li->module = jl_current_module;
li->sparams = sparams;
li->tfunc = jl_nothing;
li->fptr = &jl_trampoline;
li->roots = NULL;
li->functionObject = NULL;
li->specFunctionObject = NULL;
li->cFunctionList = NULL;
li->functionID = 0;
li->specFunctionID = 0;
li->specTypes = NULL;
li->inferred = 0;
li->inInference = 0;
li->inCompile = 0;
li->unspecialized = NULL;
li->specializations = NULL;
li->name = anonymous_sym;
li->def = li;
li->capt = NULL;
return li;
}
/*
* Straightforward Sieve of Eratosthenes.
*
* Uses 1 bit per odd number.
*
* Time for Pi(10^10) = 54.6s
*/
static WTYPE* sieve_erat(WTYPE end)
{
WTYPE* mem;
size_t n, s;
size_t last = (end+1)/2;
mem = (WTYPE*) calloc( NWORDS(last), sizeof(WTYPE) );
assert(mem != 0);
// Tight:
// for (n = 3; (n*n) <= end; n = next_prime(n))
// for (s = n*n; s <= end; s += 2*n)
// SET_ARRAY_BIT(mem,s/2);
n = 3;
while ( (n*n) <= end) {
for (s = n*n; s <= end; s += 2*n)
SET_ARRAY_BIT(mem,s/2);
// Could do: n = next_prime(n)
do { n += 2; } while (IS_SET_ARRAY_BIT(mem,n/2));
}
SET_ARRAY_BIT(mem, 1/2); /* 1 is composite */
return mem;
}
JL_DLLEXPORT
jl_lambda_info_t *jl_new_lambda_info(jl_value_t *ast, jl_svec_t *tvars, jl_svec_t *sparams,
jl_module_t *ctx)
{
jl_lambda_info_t *li =
(jl_lambda_info_t*)newobj((jl_value_t*)jl_lambda_info_type,
NWORDS(sizeof(jl_lambda_info_t)));
li->ast = ast;
li->rettype = (jl_value_t*)jl_any_type;
li->file = null_sym;
li->module = ctx;
li->sparam_syms = tvars;
li->sparam_vals = sparams;
li->tfunc = jl_nothing;
li->fptr = NULL;
li->jlcall_api = 0;
li->roots = NULL;
li->functionObjects.functionObject = NULL;
li->functionObjects.specFunctionObject = NULL;
li->functionObjects.cFunctionList = NULL;
li->functionID = 0;
li->specFunctionID = 0;
li->specTypes = NULL;
li->inferred = 0;
li->inInference = 0;
li->inCompile = 0;
li->unspecialized = NULL;
li->specializations = NULL;
li->name = anonymous_sym;
li->def = li;
li->line = 0;
li->pure = 0;
li->called = 0xff;
li->needs_sparam_vals_ducttape = 0;
if (ast && jl_is_expr(ast)) {
jl_array_t *body = jl_lam_body((jl_expr_t*)ast)->args;
if (has_meta(body, pure_sym))
li->pure = 1;
jl_value_t *body1 = skip_meta(body);
if (jl_is_linenode(body1)) {
li->file = jl_linenode_file(body1);
li->line = jl_linenode_line(body1);
}
else if (jl_is_expr(body1) && ((jl_expr_t*)body1)->head == line_sym) {
li->file = (jl_sym_t*)jl_exprarg(body1, 1);
li->line = jl_unbox_long(jl_exprarg(body1, 0));
}
jl_array_t *vis = jl_lam_vinfo((jl_expr_t*)li->ast);
jl_array_t *args = jl_lam_args((jl_expr_t*)li->ast);
size_t narg = jl_array_len(args);
uint8_t called=0;
int i, j=0;
for(i=1; i < narg && i <= 8; i++) {
jl_value_t *ai = jl_cellref(args,i);
if (ai == (jl_value_t*)unused_sym || !jl_is_symbol(ai)) continue;
jl_value_t *vj;
do {
vj = jl_cellref(vis, j++);
} while (jl_cellref(vj,0) != ai);
if (jl_unbox_long(jl_cellref(vj,2))&64)
called |= (1<<(i-1));
}
li->called = called;
if (tvars != jl_emptysvec)
if (jl_has_intrinsics(li, (jl_expr_t*)ast, ctx))
li->needs_sparam_vals_ducttape = 1;
}
return li;
}
/*
* Better Sieve of Atkin.
*
* Uses 1 bit per odd number.
*
* From Mike on Programming Praxis. Pretty fast, but not really an improvement
* over a good SoE. Note that the limits aren't handled quite right, so I have
* to add an "if (n <= end)" in front of each XOR.
*
* Time for Pi(10^10) = 53.9s
*/
static WTYPE* sieve_atkin(WTYPE end)
{
WTYPE* mem;
size_t n, s, k;
size_t last = (end+1)/2; /* Extra space allocated */
long loopend, y_limit, dn;
end++;
mem = (WTYPE*) malloc( NWORDS(last) * sizeof(WTYPE) );
assert(mem != 0);
/* mark everything as a composite */
memset(mem, 0xFF, NBYTES(last));
{
long xx3 = 3;
long dxx;
loopend = 12 * (long) sqrtf((end-1)/3.0);
for (dxx = 0; dxx < loopend; dxx += 24) {
xx3 += dxx;
y_limit = (long) (12.0*sqrtf( end - xx3 )) - 36;
n = xx3 + 16;
for (dn = -12; dn < (y_limit+1); dn += 72) {
n += dn;
if (n <= end) XOR_ARRAY_BIT(mem,n/2);
}
n = xx3 + 4;
for (dn = 12; dn < (y_limit+1); dn += 72) {
n += dn;
if (n <= end) XOR_ARRAY_BIT(mem,n/2);
}
}
}
{
long xx4 = 0;
long dxx4;
loopend = 8 * (long) sqrtf((end-1)/4.0) + 4;
for (dxx4 = 4; dxx4 < loopend; dxx4 += 8) {
xx4 += dxx4;
n = xx4 + 1;
if (xx4%3) {
y_limit = 4 * (long)sqrtf( end - xx4 ) - 3;
for (dn = 0; dn < y_limit; dn += 8) {
n += dn;
if (n <= end) XOR_ARRAY_BIT(mem,n/2);
}
} else {
y_limit = 12 * (long)sqrtf( end - xx4 ) - 36;
n = xx4 + 25;
for (dn = -24; dn < (y_limit+1); dn += 72) {
n += dn;
if (n <= end) XOR_ARRAY_BIT(mem,n/2);
}
n = xx4 + 1;
for (dn = 24; dn < (y_limit+1); dn += 72) {
n += dn;
if (n <= end) XOR_ARRAY_BIT(mem,n/2);
}
}
}
}
{
long xx = 1;
long x;
loopend = (long) sqrtf((float)end/2.0) + 1;
for (x = 3; x < loopend; x += 2) {
xx += 4*x - 4;
n = 3*xx;
if (n > end) {
long min_y = (( (long) (sqrtf(n - end)) >>2)<<2);
long yy = min_y * min_y;
n -= yy;
s = 4*min_y + 4;
} else {
s = 4;
}
for (dn = s; dn < 4*x; dn += 8) {
n -= dn;
if ((n <= end) && ((n%12) == 11))
XOR_ARRAY_BIT(mem,n/2);
}
}
/*
* ss_entry() - Thread entry point for all state sets.
* Provides the main loop for state set processing.
*/
static void ss_entry(void *arg)
{
SSCB *ss = (SSCB *)arg;
PROG *sp = ss->prog;
/* Attach to PV system; was already done for the first state set */
if (ss != sp->ss)
{
ss->threadId = epicsThreadGetIdSelf();
createOrAttachPvSystem(sp);
}
/* Register this thread with the EPICS watchdog (no callback func) */
taskwdInsert(ss->threadId, 0, 0);
/* In safe mode, update local var buffer with global one before
entering the event loop. Must do this using
ss_read_all_buffer since CA and other state sets could
already post events resp. pvPut. */
if (optTest(sp, OPT_SAFE))
ss_read_all_buffer(sp, ss);
/* Initial state is the first one */
ss->currentState = 0;
ss->nextState = -1;
ss->prevState = -1;
DEBUG("ss %s: entering main loop\n", ss->ssName);
/*
* ============= Main loop ==============
*/
while (TRUE)
{
boolean ev_trig;
int transNum = 0; /* highest prio trans. # triggered */
STATE *st = ss->states + ss->currentState;
double now;
/* Set state to current state */
assert(ss->currentState >= 0);
/* Set state set event mask to this state's event mask */
ss->mask = st->eventMask;
/* If we've changed state, do any entry actions. Also do these
* even if it's the same state if option to do so is enabled.
*/
if (st->entryFunc && (ss->prevState != ss->currentState
|| optTest(st, OPT_DOENTRYFROMSELF)))
{
st->entryFunc(ss);
}
/* Flush any outstanding DB requests */
pvSysFlush(sp->pvSys);
/* Setting this semaphore here guarantees that a when() is
* always executed at least once when a state is first entered.
*/
epicsEventSignal(ss->syncSem);
pvTimeGetCurrentDouble(&now);
/* Set time we entered this state if transition from a different
* state or else if option not to do so is off for this state.
*/
if ((ss->currentState != ss->prevState) ||
!optTest(st, OPT_NORESETTIMERS))
{
ss->timeEntered = now;
}
ss->wakeupTime = epicsINF;
/* Loop until an event is triggered, i.e. when() returns TRUE
*/
do {
/* Wake up on PV event, event flag, or expired delay */
DEBUG("before epicsEventWaitWithTimeout(ss=%d,timeout=%f)\n",
ss - sp->ss, ss->wakeupTime - now);
epicsEventWaitWithTimeout(ss->syncSem, ss->wakeupTime - now);
DEBUG("after epicsEventWaitWithTimeout()\n");
/* Check whether we have been asked to exit */
if (sp->die) goto exit;
/* Copy dirty variable values from CA buffer
* to user (safe mode only).
*/
if (optTest(sp, OPT_SAFE))
ss_read_all_buffer(sp, ss);
ss->wakeupTime = epicsINF;
/* Check state change conditions */
ev_trig = st->eventFunc(ss,
&transNum, &ss->nextState);
/* Clear all event flags (old ef mode only) */
if (ev_trig && !optTest(sp, OPT_NEWEF))
{
unsigned i;
for (i = 0; i < NWORDS(sp->numEvFlags); i++)
{
sp->evFlags[i] &= ~ss->mask[i];
}
}
if (!ev_trig)
pvTimeGetCurrentDouble(&now);
} while (!ev_trig);
/* Execute the state change action */
st->actionFunc(ss, transNum, &ss->nextState);
/* Check whether we have been asked to exit */
if (sp->die) goto exit;
/* If changing state, do exit actions */
if (st->exitFunc && (ss->currentState != ss->nextState
|| optTest(st, OPT_DOEXITTOSELF)))
{
st->exitFunc(ss);
}
/* Change to next state */
ss->prevState = ss->currentState;
ss->currentState = ss->nextState;
}
/* Thread exit has been requested */
exit:
taskwdRemove(ss->threadId);
/* Declare ourselves dead */
if (ss != sp->ss)
epicsEventSignal(ss->dead);
}
