void
gfc_save_backend_locus (locus * loc)
{
loc->lb = XCNEW (gfc_linebuf);
loc->lb->location = input_location;
loc->lb->file = gfc_current_backend_file;
}
void Terrain::LoadHeightMap()
{
FILE *pFilePtr;
i32 error;
u32 count;
BITMAPFILEHEADER bitmapFileHeader;
BITMAPINFOHEADER bitmapInfoHeader;
//Open the height map file in binary
error = fopen_s(&pFilePtr, m_pHeightMapFileName.c_str(), "rb");
if (error != 0)
{
SimpleTerrain::GenerateVertices();
XCASSERT(false);
return;
}
//Read the file header
count = fread(&bitmapFileHeader, sizeof(BITMAPFILEHEADER), 1, pFilePtr);
if (count != 1)
{
SimpleTerrain::GenerateVertices();
XCASSERT(false);
return;
}
//Read in the bitmap info header
count = fread(&bitmapInfoHeader, sizeof(BITMAPINFOHEADER), 1, pFilePtr);
if (count != 1)
{
SimpleTerrain::GenerateVertices();
XCASSERT(false);
return;
}
m_rows = bitmapInfoHeader.biWidth;
m_cols = bitmapInfoHeader.biHeight;
m_totalVertices = m_rows * m_cols;
i32 imageSize = m_rows * m_cols * 3;
m_pBitmapImage = XCNEW(u8)[imageSize];
//Move to first position within the bitmap file
fseek(pFilePtr, bitmapFileHeader.bfOffBits, SEEK_SET);
//Read in the bitmap image data
count = fread(m_pBitmapImage, 1, imageSize, pFilePtr);
if (count != imageSize)
{
XCASSERT(false);
return;
}
//Close the file
fclose(pFilePtr);
}
segT
subseg_get (const char *segname, int force_new)
{
segT secptr;
segment_info_type *seginfo;
const char *now_seg_name = (now_seg
? bfd_get_section_name (stdoutput, now_seg)
: 0);
if (!force_new
&& now_seg_name
&& (now_seg_name == segname
|| !strcmp (now_seg_name, segname)))
return now_seg;
if (!force_new)
secptr = bfd_make_section_old_way (stdoutput, segname);
else
secptr = bfd_make_section_anyway (stdoutput, segname);
seginfo = seg_info (secptr);
if (! seginfo)
{
secptr->output_section = secptr;
seginfo = XCNEW (segment_info_type);
seginfo->bfd_section = secptr;
bfd_set_section_userdata (stdoutput, secptr, seginfo);
}
return secptr;
}
gfc_code *
gfc_get_code (void)
{
gfc_code *c;
c = XCNEW (gfc_code);
c->loc = gfc_current_locus;
return c;
}
gfc_code *
gfc_get_code (gfc_exec_op op)
{
gfc_code *c;
c = XCNEW (gfc_code);
c->op = op;
c->loc = gfc_current_locus;
return c;
}
void
solaris_elf_asm_comdat_section (const char *name, unsigned int flags, tree decl)
{
const char *signature;
char *section;
comdat_entry entry, **slot;
if (TREE_CODE (decl) == IDENTIFIER_NODE)
signature = IDENTIFIER_POINTER (decl);
else
signature = IDENTIFIER_POINTER (DECL_COMDAT_GROUP (decl));
/* Sun as requires group sections to be fragmented, i.e. to have names of
the form <section>%<fragment>. Strictly speaking this is only
necessary to support cc -xF, but is enforced globally in violation of
the ELF gABI. We keep the section names generated by GCC (generally
of the form .text.<signature>) and append %<signature> to pacify as,
despite the redundancy. */
section = concat (name, "%", signature, NULL);
/* Clear SECTION_LINKONCE flag so targetm.asm_out.named_section only
emits this as a regular section. Emit section before .group
directive since Sun as treats undeclared sections as @progbits,
which conflicts with .bss* sections which are @nobits. */
targetm.asm_out.named_section (section, flags & ~SECTION_LINKONCE, decl);
/* Sun as separates declaration of a group section and of the group
itself, using the .group directive and the #comdat flag. */
fprintf (asm_out_file, "\t.group\t%s," SECTION_NAME_FORMAT ",#comdat\n",
signature, section);
/* Unlike GNU as, group signature symbols need to be defined explicitly
for Sun as. With a few exceptions, this is already the case. To
identify the missing ones without changing the affected frontents,
remember the signature symbols and emit those not marked
TREE_SYMBOL_REFERENCED in solaris_file_end. */
if (solaris_comdat_htab == NULL)
solaris_comdat_htab = htab_create_alloc (37, comdat_hash, comdat_eq, NULL,
xcalloc, free);
entry.sig = signature;
slot = (comdat_entry **) htab_find_slot (solaris_comdat_htab, &entry, INSERT);
if (*slot == NULL)
{
*slot = XCNEW (comdat_entry);
/* Remember fragmented section name. */
(*slot)->name = section;
/* Emit as regular section, .group declaration has already been done. */
(*slot)->flags = flags & ~SECTION_LINKONCE;
(*slot)->decl = decl;
(*slot)->sig = signature;
}
}
gfc_constructor *
gfc_constructor_get (void)
{
gfc_constructor *c = XCNEW (gfc_constructor);
c->base = NULL;
c->expr = NULL;
c->iterator = NULL;
mpz_init_set_si (c->offset, 0);
mpz_init_set_si (c->repeat, 1);
return c;
}
static void
copy_equiv_list_to_ns (segment_info *c)
{
segment_info *f;
gfc_equiv_info *s;
gfc_equiv_list *l;
l = XCNEW (gfc_equiv_list);
l->next = c->sym->ns->equiv_lists;
c->sym->ns->equiv_lists = l;
for (f = c; f; f = f->next)
{
s = XCNEW (gfc_equiv_info);
s->next = l->equiv;
l->equiv = s;
s->sym = f->sym;
s->offset = f->offset;
s->length = f->length;
}
}
/*
* subseg_change()
*
* Change the subsegment we are in, BUT DO NOT MAKE A NEW FRAG for the
* subsegment. If we are already in the correct subsegment, change nothing.
* This is used eg as a worker for subseg_set [which does make a new frag_now]
* and for changing segments after we have read the source. We construct eg
* fixSs even after the source file is read, so we do have to keep the
* segment context correct.
*/
void
subseg_change (segT seg, int subseg)
{
segment_info_type *seginfo = seg_info (seg);
now_seg = seg;
now_subseg = subseg;
if (! seginfo)
{
seginfo = XCNEW (segment_info_type);
seginfo->bfd_section = seg;
bfd_set_section_userdata (stdoutput, seg, seginfo);
}
}
static struct ui_file *
ioscm_file_port_new (SCM port)
{
ioscm_file_port *stream = XCNEW (ioscm_file_port);
struct ui_file *file = ui_file_new ();
set_ui_file_data (file, stream, ioscm_file_port_delete);
set_ui_file_rewind (file, ioscm_file_port_rewind);
set_ui_file_put (file, ioscm_file_port_put);
set_ui_file_write (file, ioscm_file_port_write);
stream->magic = &file_port_magic;
stream->port = port;
return file;
}
static gfc_constructor *
node_copy (splay_tree_node node, void *base)
{
gfc_constructor *c, *src = (gfc_constructor*)node->value;
c = XCNEW (gfc_constructor);
c->base = (gfc_constructor_base)base;
c->expr = gfc_copy_expr (src->expr);
c->iterator = gfc_copy_iterator (src->iterator);
c->where = src->where;
c->n.component = src->n.component;
mpz_init_set (c->offset, src->offset);
mpz_init_set (c->repeat, src->repeat);
return c;
}
cpp_hash_table *
ht_create (unsigned int order)
{
unsigned int nslots = 1 << order;
cpp_hash_table *table;
table = XCNEW (cpp_hash_table);
/* Strings need no alignment. */
obstack_specify_allocation (&table->stack, 0, 0, xmalloc, free);
obstack_alignment_mask (&table->stack) = 0;
table->entries = XCNEWVEC (hashnode, nslots);
table->entries_owned = true;
table->nslots = nslots;
return table;
}
static segment_info *
get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
{
segment_info *s;
/* Make sure we've got the character length. */
if (sym->ts.type == BT_CHARACTER)
gfc_conv_const_charlen (sym->ts.u.cl);
/* Create the segment_info and fill it in. */
s = XCNEW (segment_info);
s->sym = sym;
/* We will use this type when building the segment aggregate type. */
s->field = gfc_sym_type (sym);
s->length = int_size_in_bytes (s->field);
s->offset = offset;
return s;
}
hash_table *
ht_create (unsigned int order)
{
unsigned int nslots = 1 << order;
hash_table *table;
table = XCNEW (hash_table);
/* Strings need no alignment. */
_obstack_begin (&table->stack, 0, 0,
(void *(*) (long)) xmalloc,
(void (*) (void *)) free);
obstack_alignment_mask (&table->stack) = 0;
table->entries = XCNEWVEC (hashnode, nslots);
table->entries_owned = true;
table->nslots = nslots;
return table;
}
static void
add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
{
gfc_component *c;
c = gfc_find_component (vtype, name, true, true);
if (c == NULL)
{
/* Add procedure component. */
if (gfc_add_component (vtype, name, &c) == FAILURE)
return;
if (tb->u.specific)
c->ts.interface = tb->u.specific->n.sym;
if (!c->tb)
c->tb = XCNEW (gfc_typebound_proc);
*c->tb = *tb;
c->tb->ppc = 1;
c->attr.procedure = 1;
c->attr.proc_pointer = 1;
c->attr.flavor = FL_PROCEDURE;
c->attr.access = ACCESS_PRIVATE;
c->attr.external = 1;
c->attr.untyped = 1;
c->attr.if_source = IFSRC_IFBODY;
/* A static initializer cannot be used here because the specific
function is not a constant; internal compiler error: in
output_constant, at varasm.c:4623 */
c->initializer = NULL;
}
else if (c->attr.proc_pointer && c->tb)
{
*c->tb = *tb;
c->tb->ppc = 1;
c->ts.interface = tb->u.specific->n.sym;
}
}
static void
add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
{
gfc_component *c;
c = gfc_find_component (vtype, name, true, true);
if (c == NULL)
{
/* Add procedure component. */
if (gfc_add_component (vtype, name, &c) == FAILURE)
return;
if (!c->tb)
c->tb = XCNEW (gfc_typebound_proc);
*c->tb = *tb;
c->tb->ppc = 1;
c->attr.procedure = 1;
c->attr.proc_pointer = 1;
c->attr.flavor = FL_PROCEDURE;
c->attr.access = ACCESS_PRIVATE;
c->attr.external = 1;
c->attr.untyped = 1;
c->attr.if_source = IFSRC_IFBODY;
}
else if (c->attr.proc_pointer && c->tb)
{
*c->tb = *tb;
c->tb->ppc = 1;
}
if (tb->u.specific)
{
c->ts.interface = tb->u.specific->n.sym;
if (!tb->deferred)
c->initializer = gfc_get_variable_expr (tb->u.specific);
}
}
/* Initialize a cpp_reader structure. */
cpp_reader *
cpp_create_reader (enum c_lang lang, hash_table *table,
struct line_maps *line_table)
{
cpp_reader *pfile;
/* Initialize this instance of the library if it hasn't been already. */
init_library ();
pfile = XCNEW (cpp_reader);
memset (&pfile->base_context, 0, sizeof (pfile->base_context));
cpp_set_lang (pfile, lang);
CPP_OPTION (pfile, warn_multichar) = 1;
CPP_OPTION (pfile, discard_comments) = 1;
CPP_OPTION (pfile, discard_comments_in_macro_exp) = 1;
CPP_OPTION (pfile, tabstop) = 8;
CPP_OPTION (pfile, operator_names) = 1;
CPP_OPTION (pfile, warn_trigraphs) = 2;
CPP_OPTION (pfile, warn_endif_labels) = 1;
CPP_OPTION (pfile, cpp_warn_deprecated) = 1;
CPP_OPTION (pfile, cpp_warn_long_long) = 0;
CPP_OPTION (pfile, dollars_in_ident) = 1;
CPP_OPTION (pfile, warn_dollars) = 1;
CPP_OPTION (pfile, warn_variadic_macros) = 1;
CPP_OPTION (pfile, warn_builtin_macro_redefined) = 1;
/* By default, track locations of tokens resulting from macro
expansion. The '2' means, track the locations with the highest
accuracy. Read the comments for struct
cpp_options::track_macro_expansion to learn about the other
values. */
CPP_OPTION (pfile, track_macro_expansion) = 2;
CPP_OPTION (pfile, warn_normalize) = normalized_C;
CPP_OPTION (pfile, warn_literal_suffix) = 1;
/* Default CPP arithmetic to something sensible for the host for the
benefit of dumb users like fix-header. */
CPP_OPTION (pfile, precision) = CHAR_BIT * sizeof (long);
CPP_OPTION (pfile, char_precision) = CHAR_BIT;
CPP_OPTION (pfile, wchar_precision) = CHAR_BIT * sizeof (int);
CPP_OPTION (pfile, int_precision) = CHAR_BIT * sizeof (int);
CPP_OPTION (pfile, unsigned_char) = 0;
CPP_OPTION (pfile, unsigned_wchar) = 1;
CPP_OPTION (pfile, bytes_big_endian) = 1; /* does not matter */
/* Default to no charset conversion. */
CPP_OPTION (pfile, narrow_charset) = _cpp_default_encoding ();
CPP_OPTION (pfile, wide_charset) = 0;
/* Default the input character set to UTF-8. */
CPP_OPTION (pfile, input_charset) = _cpp_default_encoding ();
/* A fake empty "directory" used as the starting point for files
looked up without a search path. Name cannot be '/' because we
don't want to prepend anything at all to filenames using it. All
other entries are correct zero-initialized. */
pfile->no_search_path.name = (char *) "";
/* Initialize the line map. */
pfile->line_table = line_table;
/* Initialize lexer state. */
pfile->state.save_comments = ! CPP_OPTION (pfile, discard_comments);
/* Set up static tokens. */
pfile->avoid_paste.type = CPP_PADDING;
pfile->avoid_paste.val.source = NULL;
pfile->eof.type = CPP_EOF;
pfile->eof.flags = 0;
/* Create a token buffer for the lexer. */
_cpp_init_tokenrun (&pfile->base_run, 250);
pfile->cur_run = &pfile->base_run;
pfile->cur_token = pfile->base_run.base;
/* Initialize the base context. */
pfile->context = &pfile->base_context;
pfile->base_context.c.macro = 0;
pfile->base_context.prev = pfile->base_context.next = 0;
/* Aligned and unaligned storage. */
pfile->a_buff = _cpp_get_buff (pfile, 0);
pfile->u_buff = _cpp_get_buff (pfile, 0);
/* Initialize table for push_macro/pop_macro. */
pfile->pushed_macros = 0;
/* Do not force token locations by default. */
pfile->forced_token_location_p = NULL;
/* The expression parser stack. */
_cpp_expand_op_stack (pfile);
/* Initialize the buffer obstack. */
_obstack_begin (&pfile->buffer_ob, 0, 0,
(void *(*) (long)) xmalloc,
(void (*) (void *)) free);
_cpp_init_files (pfile);
_cpp_init_hashtable (pfile, table);
return pfile;
}
void XCShaderContainer::LoadShaders()
{
IShader* binShader;
FlatBuffersSystem& fbSystem = SystemLocator::GetInstance()->RequestSystem<FlatBuffersSystem>("FlatBuffersSystem");
fbSystem.ParseAndLoadFile(SHADER_SCHEMA_FILEPATH, m_fbBuffer);
fbSystem.ParseAndLoadFile(SHADER_DATA_FILEPATH, m_fbBuffer);
#if defined(LOAD_SHADERS_FROM_DATA)
auto FBShadersRoot = GetFBRootShader(m_fbBuffer.GetBufferFromLoadedData());
for (auto it = FBShadersRoot->FBShaders()->begin(); it != FBShadersRoot->FBShaders()->end(); ++it)
{
binShader = XCNEW(XCShaderHandle)();
binShader->Load((void*) *it);
m_Shaders[it->ShaderUsage()] = binShader;
}
#else
for (u32 shaderIndex = 0; shaderIndex < ShaderType_Max; shaderIndex++)
{
switch (shaderIndex)
{
case ShaderType_DEFAULT:
{
binShader = new DefaultShader(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_DEFAULT] = binShader;
break;
}
case ShaderType_SolidColor:
{
binShader = new SolidColorShader(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_SolidColor] = binShader;
break;
}
case ShaderType_LightTexture:
{
binShader = new LightTextureShader(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_LightTexture] = binShader;
break;
}
case ShaderType_REFELECTED_LIGHTTEXTURE:
{
binShader = new XCShaderHandle(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_REFELECTED_LIGHTTEXTURE] = binShader;
break;
}
case ShaderType_TerrainMultiTexture:
{
binShader = new TerrainMultiTex(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_TerrainMultiTexture] = binShader;
break;
}
case ShaderType_SimpleCubeMap:
{
binShader = new CubeMapShader(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_SimpleCubeMap] = binShader;
break;
}
case ShaderType_SkinnedCharacter:
{
binShader = new SkinnedCharacterShader(m_device);
binShader->LoadShader();
binShader->CreateConstantBuffers();
m_Shaders[ShaderType_SkinnedCharacter] = binShader;
break;
}
case ShaderType_Max:
break;
default:
break;
}
}
#endif
}
gfc_symbol *
gfc_find_derived_vtab (gfc_symbol *derived)
{
gfc_namespace *ns;
gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
/* Find the top-level namespace (MODULE or PROGRAM). */
for (ns = gfc_current_ns; ns; ns = ns->parent)
if (!ns->parent)
break;
/* If the type is a class container, use the underlying derived type. */
if (derived->attr.is_class)
derived = gfc_get_derived_super_type (derived);
if (ns)
{
char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
get_unique_hashed_string (tname, derived);
sprintf (name, "__vtab_%s", tname);
/* Look for the vtab symbol in various namespaces. */
gfc_find_symbol (name, gfc_current_ns, 0, &vtab);
if (vtab == NULL)
gfc_find_symbol (name, ns, 0, &vtab);
if (vtab == NULL)
gfc_find_symbol (name, derived->ns, 0, &vtab);
if (vtab == NULL)
{
gfc_get_symbol (name, ns, &vtab);
vtab->ts.type = BT_DERIVED;
if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
&gfc_current_locus) == FAILURE)
goto cleanup;
vtab->attr.target = 1;
vtab->attr.save = SAVE_IMPLICIT;
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
gfc_set_sym_referenced (vtab);
sprintf (name, "__vtype_%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
{
gfc_component *c;
gfc_symbol *parent = NULL, *parent_vtab = NULL;
gfc_get_symbol (name, ns, &vtype);
if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
NULL, &gfc_current_locus) == FAILURE)
goto cleanup;
vtype->attr.access = ACCESS_PUBLIC;
vtype->attr.vtype = 1;
gfc_set_sym_referenced (vtype);
/* Add component '_hash'. */
if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE;
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, derived->hash_value);
/* Add component '_size'. */
if (gfc_add_component (vtype, "_size", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE;
/* Remember the derived type in ts.u.derived,
so that the correct initializer can be set later on
(in gfc_conv_structure). */
c->ts.u.derived = derived;
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, 0);
/* Add component _extends. */
if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
parent = gfc_get_derived_super_type (derived);
if (parent)
{
parent_vtab = gfc_find_derived_vtab (parent);
c->ts.type = BT_DERIVED;
c->ts.u.derived = parent_vtab->ts.u.derived;
c->initializer = gfc_get_expr ();
c->initializer->expr_type = EXPR_VARIABLE;
gfc_find_sym_tree (parent_vtab->name, parent_vtab->ns,
0, &c->initializer->symtree);
}
else
{
c->ts.type = BT_DERIVED;
c->ts.u.derived = vtype;
c->initializer = gfc_get_null_expr (NULL);
}
if (derived->components == NULL && !derived->attr.zero_comp)
{
/* At this point an error must have occurred.
Prevent further errors on the vtype components. */
found_sym = vtab;
goto have_vtype;
}
/* Add component _def_init. */
if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
c->ts.type = BT_DERIVED;
c->ts.u.derived = derived;
if (derived->attr.abstract)
c->initializer = gfc_get_null_expr (NULL);
else
{
/* Construct default initialization variable. */
sprintf (name, "__def_init_%s", tname);
gfc_get_symbol (name, ns, &def_init);
def_init->attr.target = 1;
def_init->attr.save = SAVE_IMPLICIT;
def_init->attr.access = ACCESS_PUBLIC;
def_init->attr.flavor = FL_VARIABLE;
gfc_set_sym_referenced (def_init);
def_init->ts.type = BT_DERIVED;
def_init->ts.u.derived = derived;
def_init->value = gfc_default_initializer (&def_init->ts);
c->initializer = gfc_lval_expr_from_sym (def_init);
}
/* Add component _copy. */
if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
if (derived->attr.abstract)
c->initializer = gfc_get_null_expr (NULL);
else
{
/* Set up namespace. */
gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
sub_ns->sibling = ns->contained;
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
sprintf (name, "__copy_%s", tname);
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
copy->attr.if_source = IFSRC_DECL;
if (ns->proc_name->attr.flavor == FL_MODULE)
copy->module = ns->proc_name->name;
gfc_set_sym_referenced (copy);
/* Set up formal arguments. */
gfc_get_symbol ("src", sub_ns, &src);
src->ts.type = BT_DERIVED;
src->ts.u.derived = derived;
src->attr.flavor = FL_VARIABLE;
src->attr.dummy = 1;
gfc_set_sym_referenced (src);
copy->formal = gfc_get_formal_arglist ();
copy->formal->sym = src;
gfc_get_symbol ("dst", sub_ns, &dst);
dst->ts.type = BT_DERIVED;
dst->ts.u.derived = derived;
dst->attr.flavor = FL_VARIABLE;
dst->attr.dummy = 1;
gfc_set_sym_referenced (dst);
copy->formal->next = gfc_get_formal_arglist ();
copy->formal->next->sym = dst;
/* Set up code. */
sub_ns->code = gfc_get_code ();
sub_ns->code->op = EXEC_INIT_ASSIGN;
sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
/* Set initializer. */
c->initializer = gfc_lval_expr_from_sym (copy);
c->ts.interface = copy;
}
/* Add procedure pointers for type-bound procedures. */
add_procs_to_declared_vtab (derived, vtype);
}
have_vtype:
vtab->ts.u.derived = vtype;
vtab->value = gfc_default_initializer (&vtab->ts);
}
}
found_sym = vtab;
cleanup:
/* It is unexpected to have some symbols added at resolution or code
generation time. We commit the changes in order to keep a clean state. */
if (found_sym)
{
gfc_commit_symbol (vtab);
if (vtype)
gfc_commit_symbol (vtype);
if (def_init)
gfc_commit_symbol (def_init);
if (copy)
gfc_commit_symbol (copy);
if (src)
gfc_commit_symbol (src);
if (dst)
gfc_commit_symbol (dst);
}
else
gfc_undo_symbols ();
return found_sym;
}
