ffetype
ffetype_new (void)
{
ffetype type;
type = (ffetype) malloc_new_kp (malloc_pool_image (), "ffetype",
sizeof (*type));
type->kinds_ = NULL;
type->stars_ = NULL;
type->alignment_ = 0;
type->modulo_ = 0;
type->size_ = 0;
return type;
}
ffestorag
ffestorag_new (ffestoragList sl)
{
ffestorag s;
s = malloc_new_kp (ffe_pool_program_unit (), "ffestorag", sizeof (*s));
s->next = (ffestorag) &sl->first;
s->previous = sl->last;
s->hook = FFECOM_storageNULL;
s->previous->next = s;
sl->last = s;
s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first;
return s;
}
void
ffetype_set_star (ffetype base_type, int star, ffetype type)
{
if (base_type->stars_ == NULL)
{
int i;
base_type->stars_
= (ffetype_indexes_) malloc_new_kp (malloc_pool_image (),
"ffetype_indexes_[stars]",
sizeof (*(base_type->stars_)));
for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->stars_->type_); ++i)
base_type->stars_->type_[i] = NULL;
}
assert (base_type->stars_->type_[star] == NULL);
base_type->stars_->type_[star] = type;
}
void
ffetype_set_kind (ffetype base_type, int kind, ffetype type)
{
assert (kind < (int) sizeof (*(base_type->kinds_)));
if (base_type->kinds_ == NULL)
{
int i;
base_type->kinds_
= (ffetype_indexes_) malloc_new_kp (malloc_pool_image (),
"ffetype_indexes_[kinds]",
sizeof (*(base_type->kinds_)));
for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->kinds_->type_); ++i)
base_type->kinds_->type_[i] = NULL;
}
assert (base_type->kinds_->type_[kind] == NULL);
base_type->kinds_->type_[kind] = type;
}
static ffesymbol
ffesymbol_new_ (ffename n)
{
ffesymbol s;
ffesymbolRetract_ r;
assert (n != NULL);
s = malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL", sizeof (*s));
s->name = n;
s->other_space_name = NULL;
#if FFEGLOBAL_ENABLED
s->global = NULL;
#endif
s->attrs = FFESYMBOL_attrsetNONE;
s->state = FFESYMBOL_stateNONE;
s->info = ffeinfo_new_null ();
s->dims = NULL;
s->extents = NULL;
s->dim_syms = NULL;
s->array_size = NULL;
s->init = NULL;
s->accretion = NULL;
s->accretes = 0;
s->dummy_args = NULL;
s->namelist = NULL;
s->common_list = NULL;
s->sfunc_expr = NULL;
s->list_bottom = NULL;
s->common = NULL;
s->equiv = NULL;
s->storage = NULL;
s->hook = FFECOM_symbolNULL;
s->sfa_dummy_parent = NULL;
s->func_result = NULL;
s->value = 0;
s->check_state = FFESYMBOL_checkstateNONE_;
s->check_token = NULL;
s->max_entry_num = 0;
s->num_entries = 0;
s->generic = FFEINTRIN_genNONE;
s->specific = FFEINTRIN_specNONE;
s->implementation = FFEINTRIN_impNONE;
s->is_save = FALSE;
s->is_init = FALSE;
s->do_iter = FALSE;
s->reported = FALSE;
s->explicit_where = FALSE;
s->namelisted = FALSE;
s->assigned = FALSE;
ffename_set_symbol (n, s);
if (!ffesymbol_retractable_)
{
s->have_old = FALSE;
return s;
}
r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract",
sizeof (*r));
r->next = NULL;
r->command = FFESYMBOL_retractcommandDELETE_;
r->live = s;
r->symbol = NULL; /* No backup copy. */
*ffesymbol_retract_list_ = r;
ffesymbol_retract_list_ = &r->next;
s->have_old = TRUE;
return s;
}
