static void
gfc_be_parse_file (void)
{
gfc_create_decls ();
gfc_parse_file ();
gfc_generate_constructors ();
/* Clear the binding level stack. */
while (!global_bindings_p ())
poplevel (0, 0);
/* Finalize all of the globals.
Emulated tls lowering needs to see all TLS variables before we
call finalize_compilation_unit. The C/C++ front ends manage this
by calling decl_rest_of_compilation on each global and static
variable as they are seen. The Fortran front end waits until
here. */
for (tree decl = getdecls (); decl ; decl = DECL_CHAIN (decl))
rest_of_decl_compilation (decl, true, true);
/* Switch to the default tree diagnostics here, because there may be
diagnostics before gfc_finish(). */
gfc_diagnostics_finish ();
global_decl_processing ();
}
tree
pushdecl (tree decl)
{
if (global_bindings_p ())
DECL_CONTEXT (decl) = current_translation_unit;
else
{
/* External objects aren't nested. For debug info insert a copy
of the decl into the binding level. */
if (DECL_EXTERNAL (decl))
{
tree orig = decl;
decl = copy_node (decl);
DECL_CONTEXT (orig) = NULL_TREE;
}
DECL_CONTEXT (decl) = current_function_decl;
}
/* Put the declaration on the list. */
DECL_CHAIN (decl) = current_binding_level->names;
current_binding_level->names = decl;
/* For the declaration of a type, set its name if it is not already set. */
if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
{
if (DECL_SOURCE_LINE (decl) == 0)
TYPE_NAME (TREE_TYPE (decl)) = decl;
else
TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
}
return decl;
}
int
expand_catch_class (treetreehash_entry **entry, int)
{
struct treetreehash_entry *ite = *entry;
tree addr = TREE_VALUE ((tree)ite->value);
tree decl;
STRIP_NOPS (addr);
decl = TREE_OPERAND (addr, 0);
rest_of_decl_compilation (decl, global_bindings_p (), 0);
return true;
}
static void
gfc_be_parse_file (void)
{
int errors;
int warnings;
gfc_create_decls ();
gfc_parse_file ();
gfc_generate_constructors ();
/* Tell the frontend about any errors. */
gfc_get_errors (&warnings, &errors);
errorcount += errors;
warningcount += warnings;
/* Clear the binding level stack. */
while (!global_bindings_p ())
poplevel (0, 0);
}
void
compile_resource_data (const char *name, const char *buffer, int length)
{
tree rtype, field = NULL_TREE, data_type, rinit, data, decl;
char buf[60];
data_type = build_prim_array_type (unsigned_byte_type_node,
strlen (name) + length);
rtype = make_node (RECORD_TYPE);
PUSH_FIELD (rtype, field, "name_length", unsigned_int_type_node);
PUSH_FIELD (rtype, field, "resource_length", unsigned_int_type_node);
PUSH_FIELD (rtype, field, "data", data_type);
FINISH_RECORD (rtype);
START_RECORD_CONSTRUCTOR (rinit, rtype);
PUSH_FIELD_VALUE (rinit, "name_length",
build_int_cst (NULL_TREE, strlen (name)));
PUSH_FIELD_VALUE (rinit, "resource_length",
build_int_cst (NULL_TREE, length));
data = build_string (strlen(name) + length, buffer);
TREE_TYPE (data) = data_type;
PUSH_FIELD_VALUE (rinit, "data", data);
FINISH_RECORD_CONSTRUCTOR (rinit);
TREE_CONSTANT (rinit) = 1;
TREE_INVARIANT (rinit) = 1;
/* Generate a unique-enough identifier. */
sprintf (buf, "_Jr%d", ++Jr_count);
decl = build_decl (VAR_DECL, get_identifier (buf), rtype);
TREE_STATIC (decl) = 1;
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
TREE_READONLY (decl) = 1;
TREE_THIS_VOLATILE (decl) = 0;
DECL_INITIAL (decl) = rinit;
layout_decl (decl, 0);
pushdecl (decl);
rest_of_decl_compilation (decl, global_bindings_p (), 0);
make_decl_rtl (decl);
assemble_variable (decl, 1, 0, 0);
resources = tree_cons (NULL_TREE, decl, resources);
}
void
compile_resource_data (const char *name, const char *buffer, int length)
{
tree rtype, field = NULL_TREE, data_type, rinit, data, decl;
VEC(constructor_elt,gc) *v = NULL;
data_type = build_prim_array_type (unsigned_byte_type_node,
strlen (name) + length);
rtype = make_node (RECORD_TYPE);
PUSH_FIELD (input_location,
rtype, field, "name_length", unsigned_int_type_node);
PUSH_FIELD (input_location,
rtype, field, "resource_length", unsigned_int_type_node);
PUSH_FIELD (input_location, rtype, field, "data", data_type);
FINISH_RECORD (rtype);
START_RECORD_CONSTRUCTOR (v, rtype);
PUSH_FIELD_VALUE (v, "name_length",
build_int_cst (NULL_TREE, strlen (name)));
PUSH_FIELD_VALUE (v, "resource_length",
build_int_cst (NULL_TREE, length));
data = build_string (strlen(name) + length, buffer);
TREE_TYPE (data) = data_type;
PUSH_FIELD_VALUE (v, "data", data);
FINISH_RECORD_CONSTRUCTOR (rinit, v, rtype);
TREE_CONSTANT (rinit) = 1;
decl = build_decl (input_location,
VAR_DECL, java_mangle_resource_name (name), rtype);
TREE_STATIC (decl) = 1;
TREE_PUBLIC (decl) = 1;
java_hide_decl (decl);
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
TREE_READONLY (decl) = 1;
TREE_THIS_VOLATILE (decl) = 0;
DECL_INITIAL (decl) = rinit;
layout_decl (decl, 0);
pushdecl (decl);
rest_of_decl_compilation (decl, global_bindings_p (), 0);
varpool_finalize_decl (decl);
VEC_safe_push (tree, gc, resources, decl);
}
static void
gfc_be_parse_file (void)
{
int errors;
int warnings;
gfc_create_decls ();
gfc_parse_file ();
gfc_generate_constructors ();
/* Tell the frontend about any errors. */
gfc_get_errors (&warnings, &errors);
errorcount += errors;
warningcount += warnings;
/* Clear the binding level stack. */
while (!global_bindings_p ())
poplevel (0, 0);
/* Switch to the default tree diagnostics here, because there may be
diagnostics before gfc_finish(). */
gfc_diagnostics_finish ();
}
exp = convert (ptr_type_node, exp);
*slot = tree_cons (type, exp, NULL_TREE);
return exp;
}
static int
expand_catch_class (void **entry, void *x ATTRIBUTE_UNUSED)
{
struct treetreehash_entry *ite = (struct treetreehash_entry *) *entry;
tree addr = TREE_VALUE ((tree)ite->value);
tree decl;
STRIP_NOPS (addr);
decl = TREE_OPERAND (addr, 0);
rest_of_decl_compilation (decl, global_bindings_p (), 0);
return true;
}
/* For every class in the TYPE_TO_RUNTIME_MAP, expand the
corresponding object that is used by the runtime type matcher. */
void
java_expand_catch_classes (tree this_class)
{
if (TYPE_TO_RUNTIME_MAP (this_class))
htab_traverse
(TYPE_TO_RUNTIME_MAP (this_class),
expand_catch_class, NULL);
}
static void
c_lex_one_token (c_token *token)
{
#if 0
timevar_push (TV_LEX);
token->type = c_lex_with_flags (&token->value, &token->location, NULL);
#else
token->type = clilex();
token->value = yylval.type_node_p;
#endif
token->in_system_header = in_system_header;
switch (token->type)
{
case T_NAME:
case CPP_NAME:
token->id_kind = C_ID_NONE;
token->keyword = RID_MAX;
{
tree decl;
int objc_force_identifier = objc_need_raw_identifier;
#if 0
OBJC_NEED_RAW_IDENTIFIER (0);
#endif
if (0/*C_IS_RESERVED_WORD (token->value)*/)
{
enum rid rid_code = 0/*C_RID_CODE (token->value)*/;
#if 0
if (c_dialect_objc ())
{
if (!OBJC_IS_AT_KEYWORD (rid_code)
&& (!OBJC_IS_PQ_KEYWORD (rid_code) || objc_pq_context))
{
/* Return the canonical spelling for this keyword. */
token->value = ridpointers[(int) rid_code];
token->type = CPP_KEYWORD;
token->keyword = rid_code;
break;
}
}
else
#endif
{
/* Return the canonical spelling for this keyword. */
#if 0
token->value = ridpointers[(int) rid_code];
#endif
token->type = CPP_KEYWORD;
token->keyword = rid_code;
break;
}
}
#if 0
decl = lookup_name (token->value);
if (decl)
{
if (TREE_CODE (decl) == TYPE_DECL)
{
token->id_kind = C_ID_TYPENAME;
break;
}
}
#if 0
else if (c_dialect_objc ())
{
tree objc_interface_decl = objc_is_class_name (token->value);
/* Objective-C class names are in the same namespace as
variables and typedefs, and hence are shadowed by local
declarations. */
if (objc_interface_decl
&& (global_bindings_p ()
|| (!objc_force_identifier && !decl)))
{
token->value = objc_interface_decl;
token->id_kind = C_ID_CLASSNAME;
break;
}
}
#endif
#endif
}
token->id_kind = C_ID_ID;
break;
#if 0
case CPP_AT_NAME:
/* This only happens in Objective-C; it must be a keyword. */
token->type = CPP_KEYWORD;
token->id_kind = C_ID_NONE;
token->keyword = C_RID_CODE (token->value);
break;
#endif
case ':':
case ',':
case ')':
case ';':
case CPP_COLON:
case CPP_COMMA:
case CPP_CLOSE_PAREN:
case CPP_SEMICOLON:
/* These tokens may affect the interpretation of any identifiers
following, if doing Objective-C. */
#if 0
OBJC_NEED_RAW_IDENTIFIER (0);
#endif
token->id_kind = C_ID_NONE;
token->keyword = RID_MAX;
break;
default:
token->id_kind = C_ID_NONE;
token->keyword = RID_MAX;
break;
}
#if 0
timevar_pop (TV_LEX);
#endif
}
