@@ -176,72 +176,85 @@ gfc_class_len_get (tree decl)
if (POINTER_TYPE_P (TREE_TYPE (decl)))
decl = build_fold_indirect_ref_loc (input_location, decl);
len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl)),
- CLASS_LEN_FIELD);
+ CLASS_LEN_FIELD);
return fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (len), decl, len,
NULL_TREE);
}
+/* Get the specified FIELD from the VPTR. */
+
static tree
-gfc_vtable_field_get (tree decl, int field)
+vptr_field_get (tree vptr, int fieldno)
{
- tree size;
- tree vptr;
- vptr = gfc_class_vptr_get (decl);
+ tree field;
vptr = build_fold_indirect_ref_loc (input_location, vptr);
- size = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (vptr)),
- field);
- size = fold_build3_loc (input_location, COMPONENT_REF,
- TREE_TYPE (size), vptr, size,
- NULL_TREE);
- /* Always return size as an array index type. */
- if (field == VTABLE_SIZE_FIELD)
- size = fold_convert (gfc_array_index_type, size);
- gcc_assert (size);
- return size;
+ field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (vptr)),
+ fieldno);
+ field = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (field), vptr, field,
+ NULL_TREE);
+ gcc_assert (field);
+ return field;
}
-tree
-gfc_vtable_hash_get (tree decl)
-{
- return gfc_vtable_field_get (decl, VTABLE_HASH_FIELD);
-}
-
+/* Get the field from the class' vptr. */
-tree
-gfc_vtable_size_get (tree decl)
+static tree
+class_vtab_field_get (tree decl, int fieldno)
{
- return gfc_vtable_field_get (decl, VTABLE_SIZE_FIELD);
+ tree vptr;
+ vptr = gfc_class_vptr_get (decl);
+ return vptr_field_get (vptr, fieldno);
}
-tree
-gfc_vtable_extends_get (tree decl)
-{
- return gfc_vtable_field_get (decl, VTABLE_EXTENDS_FIELD);
+/* Define a macro for creating the class_vtab_* and vptr_* accessors in
+ unison. */
+#define VTAB_GET_FIELD_GEN(name, field) tree \
+gfc_class_vtab_## name ##_get (tree cl) \
+{ \
+ return class_vtab_field_get (cl, field); \
+} \
+ \
+tree \
+gfc_vptr_## name ##_get (tree vptr) \
+{ \
+ return vptr_field_get (vptr, field); \
}
+VTAB_GET_FIELD_GEN (hash, VTABLE_HASH_FIELD)
+VTAB_GET_FIELD_GEN (extends, VTABLE_EXTENDS_FIELD)
+VTAB_GET_FIELD_GEN (def_init, VTABLE_DEF_INIT_FIELD)
+VTAB_GET_FIELD_GEN (copy, VTABLE_COPY_FIELD)
+VTAB_GET_FIELD_GEN (final, VTABLE_FINAL_FIELD)
-tree
-gfc_vtable_def_init_get (tree decl)
-{
- return gfc_vtable_field_get (decl, VTABLE_DEF_INIT_FIELD);
-}
+/* The size field is returned as an array index. Therefore treat it and only
+ it specially. */
tree
-gfc_vtable_copy_get (tree decl)
+gfc_class_vtab_size_get (tree cl)
{
- return gfc_vtable_field_get (decl, VTABLE_COPY_FIELD);
+ tree size;
+ size = class_vtab_field_get (cl, VTABLE_SIZE_FIELD);
+ /* Always return size as an array index type. */
+ size = fold_convert (gfc_array_index_type, size);
+ gcc_assert (size);
+ return size;
}
-
tree
-gfc_vtable_final_get (tree decl)
+gfc_vptr_size_get (tree vptr)
{
- return gfc_vtable_field_get (decl, VTABLE_FINAL_FIELD);
+ tree size;
+ size = vptr_field_get (vptr, VTABLE_SIZE_FIELD);
+ /* Always return size as an array index type. */
+ size = fold_convert (gfc_array_index_type, size);
+ gcc_assert (size);
+ return size;
}
@@ -346,17 +346,32 @@ typedef struct
gfc_wrapped_block;
/* Class API functions. */
+tree gfc_class_set_static_fields (tree, tree, tree);
tree gfc_class_data_get (tree);
tree gfc_class_vptr_get (tree);
tree gfc_class_len_get (tree);
+#define gfc_vtable_hash_get gfc_class_vtab_hash_get
+#define gfc_vtable_size_get gfc_class_vtab_size_get
+#define gfc_vtable_extends_get gfc_class_vtab_extends_get
+#define gfc_vtable_def_init_get gfc_class_vtab_def_init_get
+#define gfc_vtable_copy_get gfc_class_vtab_copy_get
+#define gfc_vtable_final_get gfc_class_vtab_final_get
+/* Get an accessor to the class' vtab's * field, when a class handle is
+ available. */
+tree gfc_class_vtab_hash_get (tree);
+tree gfc_class_vtab_size_get (tree);
+tree gfc_class_vtab_extends_get (tree);
+tree gfc_class_vtab_def_init_get (tree);
+tree gfc_class_vtab_copy_get (tree);
+tree gfc_class_vtab_final_get (tree);
+/* Get an accessor to the vtab's * field, when a vptr handle is present. */
+tree gfc_vtpr_hash_get (tree);
+tree gfc_vptr_size_get (tree);
+tree gfc_vptr_extends_get (tree);
+tree gfc_vptr_def_init_get (tree);
+tree gfc_vptr_copy_get (tree);
+tree gfc_vptr_final_get (tree);
void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
-tree gfc_class_set_static_fields (tree, tree, tree);
-tree gfc_vtable_hash_get (tree);
-tree gfc_vtable_size_get (tree);
-tree gfc_vtable_extends_get (tree);
-tree gfc_vtable_def_init_get (tree);
-tree gfc_vtable_copy_get (tree);
-tree gfc_vtable_final_get (tree);
tree gfc_get_vptr_from_expr (tree);
tree gfc_get_class_array_ref (tree, tree);
tree gfc_copy_class_to_class (tree, tree, tree);