1!===-- module/__fortran_type_info.f90 --------------------------------------===!
2!
3! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4! See https://llvm.org/LICENSE.txt for license information.
5! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6!
7!===------------------------------------------------------------------------===!
8
9! Fortran definitions of runtime type description schemata.
10! See flang/runtime/type-info.h for C++ perspective.
11! The Semantics phase of the compiler requires the module file of this module
12! in order to generate description tables for all other derived types.
13
14module __Fortran_type_info
15
16  private
17
18  integer, parameter :: int64 = selected_int_kind(18)
19
20  type, public :: __builtin_c_ptr
21    integer(kind=int64) :: __address
22  end type
23
24  type, public :: __builtin_c_funptr
25    integer(kind=int64) :: __address
26  end type
27
28  type :: DerivedType
29    ! "TBP" bindings appear first.  Inherited bindings, with overrides already
30    ! applied, appear in the initial entries in the same order as they
31    ! appear in the parent type's bindings, if any.  They are followed
32    ! by new local bindings in alphabetic order of theing binding names.
33    type(Binding), pointer, contiguous :: binding(:)
34    character(len=:), pointer :: name
35    integer(kind=int64) :: sizeInBytes
36    ! Instances of parameterized derived types use the "uninstantiated"
37    ! component to point to the pristine original definition.
38    type(DerivedType), pointer :: uninstantiated
39    integer(kind=int64) :: typeHash
40    integer(kind=int64), pointer, contiguous :: kindParameter(:) ! values of instance
41    integer(1), pointer, contiguous :: lenParameterKind(:) ! INTEGER kinds of LEN types
42    ! Data components appear in component order.
43    ! The parent component, if any, appears explicitly and first.
44    type(Component), pointer, contiguous :: component(:) ! data components
45    type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
46    ! Special bindings of the ancestral types are not duplicated here.
47    type(SpecialBinding), pointer, contiguous :: special(:)
48    integer(1) :: hasParent
49    integer(1) :: noInitializationNeeded ! 1 if no component w/ init
50    integer(1) :: noDestructionNeeded ! 1 if no component w/ dealloc/final
51    integer(1) :: __padding0(5)
52  end type
53
54  type :: Binding
55    type(__builtin_c_funptr) :: proc
56    character(len=:), pointer :: name
57  end type
58
59  ! Array bounds and type parameters of components are deferred
60  ! (for allocatables and pointers), explicit constants, or
61  ! taken from LEN type parameters for automatic components.
62  enum, bind(c) ! Value::Genre
63    enumerator :: Deferred = 1, Explicit = 2, LenParameter = 3
64  end enum
65
66  type, bind(c) :: Value
67    integer(1) :: genre ! Value::Genre
68    integer(1) :: __padding0(7)
69    integer(kind=int64) :: value
70  end type
71
72  enum, bind(c) ! Component::Genre
73    enumerator :: Data = 1, Pointer = 2, Allocatable = 3, Automatic = 4
74  end enum
75
76  enum, bind(c) ! common::TypeCategory
77    enumerator :: CategoryInteger = 0, CategoryReal = 1, &
78      CategoryComplex = 2, CategoryCharacter = 3, &
79      CategoryLogical = 4, CategoryDerived = 5
80  end enum
81
82  type :: Component ! data components, incl. object pointers
83    character(len=:), pointer :: name
84    integer(1) :: genre ! Component::Genre
85    integer(1) :: category
86    integer(1) :: kind
87    integer(1) :: rank
88    integer(1) :: __padding0(4)
89    integer(kind=int64) :: offset
90    type(Value) :: characterLen ! for category == Character
91    type(DerivedType), pointer :: derived ! for category == Derived
92    type(Value), pointer, contiguous :: lenValue(:) ! (SIZE(derived%lenParameterKind))
93    type(Value), pointer, contiguous :: bounds(:, :) ! (2, rank): lower, upper
94    type(__builtin_c_ptr) :: initialization
95  end type
96
97  type :: ProcPtrComponent ! procedure pointer components
98    character(len=:), pointer :: name
99    integer(kind=int64) :: offset
100    type(__builtin_c_funptr) :: initialization
101  end type
102
103  enum, bind(c) ! SpecialBinding::Which
104    enumerator :: Assignment = 4, ElementalAssignment = 5
105    enumerator :: Final = 8, ElementalFinal = 9, AssumedRankFinal = 10
106    enumerator :: ReadFormatted = 16, ReadUnformatted = 17
107    enumerator :: WriteFormatted = 18, WriteUnformatted = 19
108  end enum
109
110  type, bind(c) :: SpecialBinding
111    integer(1) :: which ! SpecialBinding::Which
112    integer(1) :: rank ! for which == SpecialBinding::Which::Final only
113    integer(1) :: isArgDescriptorSet
114    integer(1) :: __padding0(5)
115    type(__builtin_c_funptr) :: proc
116  end type
117
118end module
119