-- Iir to ortho translator. -- Copyright (C) 2002 - 2014 Tristan Gingold -- -- GHDL is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation; either version 2, or (at your option) any later -- version. -- -- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY -- WARRANTY; without even the implied warranty of MERCHANTABILITY or -- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- for more details. -- -- You should have received a copy of the GNU General Public License -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Name_Table; with Files_Map; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Configuration; with Libraries; with Trans.Chap7; with Trans; use Trans.Helpers; with Trans.Helpers2; use Trans.Helpers2; package body Trans.Rtis is -- Node for block, generate, processes. Ghdl_Rtin_Block : O_Tnode; Ghdl_Rtin_Block_Common : O_Fnode; Ghdl_Rtin_Block_Name : O_Fnode; Ghdl_Rtin_Block_Loc : O_Fnode; Ghdl_Rtin_Block_Linecol : O_Fnode; Ghdl_Rtin_Block_Parent : O_Fnode; Ghdl_Rtin_Block_Nbr_Child : O_Fnode; Ghdl_Rtin_Block_Children : O_Fnode; -- A block with a filename: for package, body, entity and architecture. Ghdl_Rtin_Block_File : O_Tnode; Ghdl_Rtin_Block_File_Block : O_Fnode; Ghdl_Rtin_Block_File_Filename : O_Fnode; -- For generate statement. Ghdl_Rtin_Generate : O_Tnode; Ghdl_Rtin_Generate_Common : O_Fnode; Ghdl_Rtin_Generate_Name : O_Fnode; Ghdl_Rtin_Generate_Loc : O_Fnode; Ghdl_Rtin_Generate_Linecol : O_Fnode; Ghdl_Rtin_Generate_Parent : O_Fnode; Ghdl_Rtin_Generate_Size : O_Fnode; Ghdl_Rtin_Generate_Child : O_Fnode; -- Node for scalar type decls. Ghdl_Rtin_Type_Scalar : O_Tnode; Ghdl_Rtin_Type_Scalar_Common : O_Fnode; Ghdl_Rtin_Type_Scalar_Name : O_Fnode; -- Node for an enumeration type definition. Ghdl_Rtin_Type_Enum : O_Tnode; Ghdl_Rtin_Type_Enum_Common : O_Fnode; Ghdl_Rtin_Type_Enum_Name : O_Fnode; Ghdl_Rtin_Type_Enum_Nbr : O_Fnode; Ghdl_Rtin_Type_Enum_Lits : O_Fnode; -- Node for an unit64. Ghdl_Rtin_Unit64 : O_Tnode; Ghdl_Rtin_Unit64_Common : O_Fnode; Ghdl_Rtin_Unit64_Name : O_Fnode; Ghdl_Rtin_Unit64_Value : O_Fnode; -- Node for an unitptr. Ghdl_Rtin_Unitptr : O_Tnode; Ghdl_Rtin_Unitptr_Common : O_Fnode; Ghdl_Rtin_Unitptr_Name : O_Fnode; Ghdl_Rtin_Unitptr_Value : O_Fnode; -- Node for a physical type Ghdl_Rtin_Type_Physical : O_Tnode; Ghdl_Rtin_Type_Physical_Common : O_Fnode; Ghdl_Rtin_Type_Physical_Name : O_Fnode; Ghdl_Rtin_Type_Physical_Nbr : O_Fnode; Ghdl_Rtin_Type_Physical_Units : O_Fnode; -- Node for a scalar subtype definition. Ghdl_Rtin_Subtype_Scalar : O_Tnode; Ghdl_Rtin_Subtype_Scalar_Common : O_Fnode; Ghdl_Rtin_Subtype_Scalar_Name : O_Fnode; Ghdl_Rtin_Subtype_Scalar_Base : O_Fnode; Ghdl_Rtin_Subtype_Scalar_Range : O_Fnode; -- Node for an access or a file type. Ghdl_Rtin_Type_Fileacc : O_Tnode; Ghdl_Rtin_Type_Fileacc_Common : O_Fnode; Ghdl_Rtin_Type_Fileacc_Name : O_Fnode; Ghdl_Rtin_Type_Fileacc_Base : O_Fnode; -- Node for an array type. Ghdl_Rtin_Type_Array : O_Tnode; Ghdl_Rtin_Type_Array_Common : O_Fnode; Ghdl_Rtin_Type_Array_Name : O_Fnode; Ghdl_Rtin_Type_Array_Element : O_Fnode; Ghdl_Rtin_Type_Array_Nbrdim : O_Fnode; Ghdl_Rtin_Type_Array_Indexes : O_Fnode; -- Node for a composite subtype. Ghdl_Rtin_Subtype_Composite : O_Tnode; Ghdl_Rtin_Subtype_Composite_Common : O_Fnode; Ghdl_Rtin_Subtype_Composite_Name : O_Fnode; Ghdl_Rtin_Subtype_Composite_Basetype : O_Fnode; Ghdl_Rtin_Subtype_Composite_Layout : O_Fnode; -- Node for a record element. Ghdl_Rtin_Element : O_Tnode; Ghdl_Rtin_Element_Common : O_Fnode; Ghdl_Rtin_Element_Name : O_Fnode; Ghdl_Rtin_Element_Type : O_Fnode; Ghdl_Rtin_Element_Valoff : O_Fnode; Ghdl_Rtin_Element_Sigoff : O_Fnode; Ghdl_Rtin_Element_Layout : O_Fnode; -- Node for a record type. Ghdl_Rtin_Type_Record : O_Tnode; Ghdl_Rtin_Type_Record_Common : O_Fnode; Ghdl_Rtin_Type_Record_Name : O_Fnode; Ghdl_Rtin_Type_Record_Nbrel : O_Fnode; Ghdl_Rtin_Type_Record_Elements : O_Fnode; Ghdl_Rtin_Type_Record_Layout : O_Fnode; -- Node for an object. Ghdl_Rtin_Object : O_Tnode; Ghdl_Rtin_Object_Common : O_Fnode; Ghdl_Rtin_Object_Name : O_Fnode; Ghdl_Rtin_Object_Loc : O_Fnode; Ghdl_Rtin_Object_Type : O_Fnode; Ghdl_Rtin_Object_Linecol : O_Fnode; -- Node for an instance. Ghdl_Rtin_Instance : O_Tnode; Ghdl_Rtin_Instance_Common : O_Fnode; Ghdl_Rtin_Instance_Name : O_Fnode; Ghdl_Rtin_Instance_Linecol : O_Fnode; Ghdl_Rtin_Instance_Loc : O_Fnode; Ghdl_Rtin_Instance_Parent : O_Fnode; Ghdl_Rtin_Instance_Type : O_Fnode; -- Node for a component. Ghdl_Rtin_Component : O_Tnode; Ghdl_Rtin_Component_Common : O_Fnode; Ghdl_Rtin_Component_Name : O_Fnode; Ghdl_Rtin_Component_Nbr_Child : O_Fnode; Ghdl_Rtin_Component_Children : O_Fnode; Null_Loc : O_Cnode; function Get_Context_Rti (Node : Iir) return O_Dnode; -- Create all the declarations for RTIs. procedure Rti_Initialize is begin -- Create type ghdl_rti_kind is (ghdl_rtik_typedef_bool, ...) declare Constr : O_Enum_List; begin Start_Enum_Type (Constr, 8); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_top"), Ghdl_Rtik_Top); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_library"), Ghdl_Rtik_Library); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_package"), Ghdl_Rtik_Package); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_package_body"), Ghdl_Rtik_Package_Body); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_entity"), Ghdl_Rtik_Entity); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_architecture"), Ghdl_Rtik_Architecture); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_process"), Ghdl_Rtik_Process); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_block"), Ghdl_Rtik_Block); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_if_generate"), Ghdl_Rtik_If_Generate); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_case_generate"), Ghdl_Rtik_Case_Generate); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_for_generate"), Ghdl_Rtik_For_Generate); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_generate_body"), Ghdl_Rtik_Generate_Body); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_instance"), Ghdl_Rtik_Instance); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_constant"), Ghdl_Rtik_Constant); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_iterator"), Ghdl_Rtik_Iterator); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_variable"), Ghdl_Rtik_Variable); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_signal"), Ghdl_Rtik_Signal); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_file"), Ghdl_Rtik_File); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_port"), Ghdl_Rtik_Port); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_generic"), Ghdl_Rtik_Generic); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_alias"), Ghdl_Rtik_Alias); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_guard"), Ghdl_Rtik_Guard); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_component"), Ghdl_Rtik_Component); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_attribute"), Ghdl_Rtik_Attribute); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_b1"), Ghdl_Rtik_Type_B1); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_e8"), Ghdl_Rtik_Type_E8); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_e32"), Ghdl_Rtik_Type_E32); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_i32"), Ghdl_Rtik_Type_I32); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_i64"), Ghdl_Rtik_Type_I64); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_f64"), Ghdl_Rtik_Type_F64); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_p32"), Ghdl_Rtik_Type_P32); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_p64"), Ghdl_Rtik_Type_P64); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_access"), Ghdl_Rtik_Type_Access); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_array"), Ghdl_Rtik_Type_Array); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_record"), Ghdl_Rtik_Type_Record); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_unbounded_record"), Ghdl_Rtik_Type_Unbounded_Record); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_file"), Ghdl_Rtik_Type_File); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_scalar"), Ghdl_Rtik_Subtype_Scalar); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_array"), Ghdl_Rtik_Subtype_Array); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_unconstrained_array"), Ghdl_Rtik_Subtype_Unconstrained_Array); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_record"), Ghdl_Rtik_Subtype_Record); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_unbounded_record"), Ghdl_Rtik_Subtype_Unbounded_Record); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_access"), Ghdl_Rtik_Subtype_Access); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_protected"), Ghdl_Rtik_Type_Protected); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_element"), Ghdl_Rtik_Element); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unit64"), Ghdl_Rtik_Unit64); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unitptr"), Ghdl_Rtik_Unitptr); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_attribute_transaction"), Ghdl_Rtik_Attribute_Transaction); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_attribute_quiet"), Ghdl_Rtik_Attribute_Quiet); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_attribute_stable"), Ghdl_Rtik_Attribute_Stable); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_psl_assert"), Ghdl_Rtik_Psl_Assert); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_psl_cover"), Ghdl_Rtik_Psl_Cover); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_psl_endpoint"), Ghdl_Rtik_Psl_Endpoint); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_error"), Ghdl_Rtik_Error); Finish_Enum_Type (Constr, Ghdl_Rtik); New_Type_Decl (Get_Identifier ("__ghdl_rtik"), Ghdl_Rtik); end; -- Create type ghdl_rti_depth. Ghd
// dear imgui: Platform Binding for SDL2
// This needs to be used along with a Renderer (e.g. DirectX11, OpenGL3, Vulkan..)
// (Info: SDL2 is a cross-platform general purpose library for handling windows, inputs, graphics context creation, etc.)

// Implemented features:
//  [X] Platform: Mouse cursor shape and visibility. Disable with 'io.ConfigFlags |= ImGuiConfigFlags_NoMouseCursorChange'.
//  [X] Platform: Clipboard support.
//  [X] Platform: Keyboard arrays indexed using SDL_SCANCODE_* codes, e.g. ImGui::IsKeyPressed(SDL_SCANCODE_SPACE).
// Missing features:
//  [ ] Platform: SDL2 handling of IME under Windows appears to be broken and it explicitly disable the regular Windows IME. You can restore Windows IME by compiling SDL with SDL_DISABLE_WINDOWS_IME.
//  [ ] Platform: Gamepad support (need to use SDL_GameController API to fill the io.NavInputs[] value when ImGuiConfigFlags_NavEnableGamepad is set).

// You can copy and use unmodified imgui_impl_* files in your project. See main.cpp for an example of using this.
// If you are new to dear imgui, read examples/README.txt and read the documentation at the top of imgui.cpp.
// https://github.com/ocornut/imgui

// CHANGELOG
// (minor and older changes stripped away, please see git history for details)
//  2018-08-01: Inputs: Workaround for Emscripten which doesn't seem to handle focus related calls.
//  2018-06-29: Inputs: Added support for the ImGuiMouseCursor_Hand cursor.
//  2018-06-08: Misc: Extracted imgui_impl_sdl.cpp/.h away from the old combined SDL2+OpenGL/Vulkan examples.
//  2018-06-08: Misc: ImGui_ImplSDL2_InitForOpenGL() now takes a SDL_GLContext parameter. 
//  2018-05-09: Misc: Fixed clipboard paste memory leak (we didn't call SDL_FreeMemory on the data returned by SDL_GetClipboardText).
//  2018-03-20: Misc: Setup io.BackendFlags ImGuiBackendFlags_HasMouseCursors flag + honor ImGuiConfigFlags_NoMouseCursorChange flag.
//  2018-02-16: Inputs: Added support for mouse cursors, honoring ImGui::GetMouseCursor() value.
//  2018-02-06: Misc: Removed call to ImGui::Shutdown() which is not available from 1.60 WIP, user needs to call CreateContext/DestroyContext themselves.
//  2018-02-06: Inputs: Added mapping for ImGuiKey_Space.
//  2018-02-05: Misc: Using SDL_GetPerformanceCounter() instead of SDL_GetTicks() to be able to handle very high framerate (1000+ FPS).
//  2018-02-05: Inputs: Keyboard mapping is using scancodes everywhere instead of a confusing mixture of keycodes and scancodes. 
//  2018-01-20: Inputs: Added Horizontal Mouse Wheel support.
//  2018-01-19: Inputs: When available (SDL 2.0.4+) using SDL_CaptureMouse() to retrieve coordinates outside of client area when dragging. Otherwise (SDL 2.0.3 and before) testing for SDL_WINDOW_INPUT_FOCUS instead of SDL_WINDOW_MOUSE_FOCUS.
//  2018-01-18: Inputs: Added mapping for ImGuiKey_Insert.
//  2017-08-25: Inputs: MousePos set to -FLT_MAX,-FLT_MAX when mouse is unavailable/missing (instead of -1,-1).
//  2016-10-15: Misc: Added a void* user_data parameter to Clipboard function handlers.

#include "imgui.h"
#include "imgui_impl_sdl.h"

// SDL
// (the multi-viewports feature requires SDL features supported from SDL 2.0.5+)
#include <SDL.h>
#include <SDL_syswm.h>

#define SDL_HAS_CAPTURE_MOUSE               SDL_VERSION_ATLEAST(2,0,4)
#define SDL_HAS_VULKAN                      SDL_VERSION_ATLEAST(2,0,6)
#define SDL_HAS_MOUSE_FOCUS_CLICKTHROUGH    SDL_VERSION_ATLEAST(2,0,5)
#if !SDL_HAS_VULKAN
static const Uint32 SDL_WINDOW_VULKAN = 0x10000000;
#endif

// Data
static SDL_Window*  g_Window = NULL;
static Uint64       g_Time = 0;
static bool         g_MousePressed[3] = { false, false, false };
static SDL_Cursor*  g_MouseCursors[ImGuiMouseCursor_COUNT] = { 0 };
static char*        g_ClipboardTextData = NULL;

static const char* ImGui_ImplSDL2_GetClipboardText(void*)
{
    if (g_ClipboardTextData)
        SDL_free(g_ClipboardTextData);
    g_ClipboardTextData = SDL_GetClipboardText();
    return g_ClipboardTextData;
}

static void ImGui_ImplSDL2_SetClipboardText(void*, const char* text)
{
    SDL_SetClipboardText(text);
}

// You can read the io.WantCaptureMouse, io.WantCaptureKeyboard flags to tell if dear imgui wants to use your inputs.
// - When io.WantCaptureMouse is true, do not dispatch mouse input data to your main application.
// - When io.WantCaptureKeyboard is true, do not dispatch keyboard input data to your main application.
// Generally you may always pass all inputs to dear imgui, and hide them from your application based on those two flags.
bool ImGui_ImplSDL2_ProcessEvent(SDL_Event* event)
{
    ImGuiIO& io = ImGui::GetIO();
    switch (event->type)
    {
    case SDL_MOUSEWHEEL:
        {
            if (event->wheel.x > 0) io.MouseWheelH += 1;
            if (event->wheel.x < 0) io.MouseWheelH -= 1;
            if (event->wheel.y > 0) io.MouseWheel += 1;
            if (event->wheel.y < 0) io.MouseWheel -= 1;
            return true;
        }
    case SDL_MOUSEBUTTONDOWN:
        {
            if (event->button.button == SDL_BUTTON_LEFT) g_MousePressed[0] = true;
            if (event->button.button == SDL_BUTTON_RIGHT) g_MousePressed[1] = true;
            if (event->button.button == SDL_BUTTON_MIDDLE) g_MousePressed[2] = true;
            return true;
        }
    case SDL_TEXTINPUT:
        {
            io.AddInputCharactersUTF8(event->text.text);
            return true;
        }
    case SDL_KEYDOWN:
    case SDL_KEYUP:
        {
            int key = event->key.keysym.scancode;
            IM_ASSERT(key >= 0 && key < IM_ARRAYSIZE(io.KeysDown));
            io.KeysDown[key] = (event->type == SDL_KEYDOWN);
            io.KeyShift = ((SDL_GetModState() & KMOD_SHIFT) != 0);
            io.KeyCtrl = ((SDL_GetModState() & KMOD_CTRL) != 0);
            io.KeyAlt = ((SDL_GetModState() & KMOD_ALT) != 0);
            io.KeySuper = ((SDL_GetModState() & KMOD_GUI) != 0);
            return true;
        }
    }
    return false;
}

static bool ImGui_ImplSDL2_Init(SDL_Window* window)
{
    g_Window = window;

    // Setup back-end capabilities flags
    ImGuiIO& io = ImGui::GetIO();
    io.BackendFlags |= ImGuiBackendFlags_HasMouseCursors;       // We can honor GetMouseCursor() values (optional)
    io.BackendFlags |= ImGuiBackendFlags_HasSetMousePos;        // We can honor io.WantSetMousePos requests (optional, rarely used)

    // Keyboard mapping. ImGui will use those indices to peek into the io.KeysDown[] array.
    io.KeyMap[ImGuiKey_Tab] = SDL_SCANCODE_TAB;
    io.KeyMap[ImGuiKey_LeftArrow] = SDL_SCANCODE_LEFT;
    io.KeyMap[ImGuiKey_RightArrow] = SDL_SCANCODE_RIGHT;
    io.KeyMap[ImGuiKey_UpArrow] = SDL_SCANCODE_UP;
    io.KeyMap[ImGuiKey_DownArrow] = SDL_SCANCODE_DOWN;
    io.KeyMap[ImGuiKey_PageUp] = SDL_SCANCODE_PAGEUP;
    io.KeyMap[ImGuiKey_PageDown] = SDL_SCANCODE_PAGEDOWN;
    io.KeyMap[ImGuiKey_Home] = SDL_SCANCODE_HOME;
    io.KeyMap[ImGuiKey_End] = SDL_SCANCODE_END;
    io.KeyMap[ImGuiKey_Insert] = SDL_SCANCODE_INSERT;
    io.KeyMap[ImGuiKey_Delete] = SDL_SCANCODE_DELETE;
    io.KeyMap[ImGuiKey_Backspace] = SDL_SCANCODE_BACKSPACE;
    io.KeyMap[ImGuiKey_Space] = SDL_SCANCODE_SPACE;
    io.KeyMap[ImGuiKey_Enter] = SDL_SCANCODE_RETURN;
    io.KeyMap[ImGuiKey_Escape] = SDL_SCANCODE_ESCAPE;
    io.KeyMap[ImGuiKey_A] = SDL_SCANCODE_A;
    io.KeyMap[ImGuiKey_C] = SDL_SCANCODE_C;
    io.KeyMap[ImGuiKey_V] = SDL_SCANCODE_V;
    io.KeyMap[ImGuiKey_X] = SDL_SCANCODE_X;
    io.KeyMap[ImGuiKey_Y] = SDL_SCANCODE_Y;
    io.KeyMap[ImGuiKey_Z] = SDL_SCANCODE_Z;

    io.SetClipboardTextFn = ImGui_ImplSDL2_SetClipboardText;
    io.GetClipboardTextFn = ImGui_ImplSDL2_GetClipboardText;
    io.ClipboardUserData = NULL;

    g_MouseCursors[ImGuiMouseCursor_Arrow] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_ARROW);
    g_MouseCursors[ImGuiMouseCursor_TextInput] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_IBEAM);
    g_MouseCursors[ImGuiMouseCursor_ResizeAll] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_SIZEALL);
    g_MouseCursors[ImGuiMouseCursor_ResizeNS] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_SIZENS);
    g_MouseCursors[ImGuiMouseCursor_ResizeEW] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_SIZEWE);
    g_MouseCursors[ImGuiMouseCursor_ResizeNESW] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_SIZENESW);
    g_MouseCursors[ImGuiMouseCursor_ResizeNWSE] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_SIZENWSE);
    g_MouseCursors[ImGuiMouseCursor_Hand] = SDL_CreateSystemCursor(SDL_SYSTEM_CURSOR_HAND);

#ifdef _WIN32
    SDL_SysWMinfo wmInfo;
    SDL_VERSION(&wmInfo.version);
    SDL_GetWindowWMInfo(window, &wmInfo);
    io.ImeWindowHandle = wmInfo.info.win.window;
#else
    (void)window;
#endif

    return true;
}

bool ImGui_ImplSDL2_InitForOpenGL(SDL_Window* window, void* sdl_gl_context)
{
    (void)sdl_gl_context; // Viewport branch will need this.
    return ImGui_ImplSDL2_Init(window);
}

bool ImGui_ImplSDL2_InitForVulkan(SDL_Window* window)
{
    #if !SDL_HAS_VULKAN
    IM_ASSERT(0 && "Unsupported");
    #endif
    return ImGui_ImplSDL2_Init(window);
}

void ImGui_ImplSDL2_Shutdown()
{
    g_Window = NULL;

    // Destroy last known clipboard data
    if (g_ClipboardTextData)
        SDL_free(g_ClipboardTextData);
    g_ClipboardTextData = NULL;

    // Destroy SDL mouse cursors
    for (ImGuiMouseCursor cursor_n = 0; cursor_n < ImGuiMouseCursor_COUNT; cursor_n++)
        SDL_FreeCursor(g_MouseCursors[cursor_n]);
    memset(g_MouseCursors, 0, sizeof(g_MouseCursors));
}

static void ImGui_ImplSDL2_UpdateMousePosAndButtons()
{
    ImGuiIO& io = ImGui::GetIO();

    // Set OS mouse position if requested (rarely used, only when ImGuiConfigFlags_NavEnableSetMousePos is enabled by user)
    if (io.WantSetMousePos)
        SDL_WarpMouseInWindow(g_Window, (int)io.MousePos.x, (int)io.MousePos.y);
    else
        io.MousePos = ImVec2(-FLT_MAX, -FLT_MAX);

    int mx, my;
    Uint32 mouse_buttons = SDL_GetMouseState(&mx, &my);
    io.MouseDown[0] = g_MousePressed[0] || (mouse_buttons & SDL_BUTTON(SDL_BUTTON_LEFT)) != 0;  // If a mouse press event came, always pass it as "mouse held this frame", so we don't miss click-release events that are shorter than 1 frame.
    io.MouseDown[1] = g_MousePressed[1] || (mouse_buttons & SDL_BUTTON(SDL_BUTTON_RIGHT)) != 0;
    io.MouseDown[2] = g_MousePressed[2] || (mouse_buttons & SDL_BUTTON(SDL_BUTTON_MIDDLE)) != 0;
    g_MousePressed[0] = g_MousePressed[1] = g_MousePressed[2] = false;

#if SDL_HAS_CAPTURE_MOUSE && !defined(__EMSCRIPTEN__)
    SDL_Window* focused_window = SDL_GetKeyboardFocus();
    if (g_Window == focused_window)
    {
        // SDL_GetMouseState() gives mouse position seemingly based on the last window entered/focused(?)
        // The creation of a new windows at runtime and SDL_CaptureMouse both seems to severely mess up with that, so we retrieve that position globally.
        int wx, wy;
        SDL_GetWindowPosition(focused_window, &wx, &wy);
        SDL_GetGlobalMouseState(&mx, &my);
        mx -= wx;
        my -= wy;
        io.MousePos = ImVec2((float)mx, (float)my);
    }

    // SDL_CaptureMouse() let the OS know e.g. that our imgui drag outside the SDL window boundaries shouldn't e.g. trigger the OS window resize cursor. 
    // The function is only supported from SDL 2.0.4 (released Jan 2016)
    bool any_mouse_button_down = ImGui::IsAnyMouseDown();
    SDL_CaptureMouse(any_mouse_button_down ? SDL_TRUE : SDL_FALSE);
#else
    if (SDL_GetWindowFlags(g_Window) & SDL_WINDOW_INPUT_FOCUS)
        io.MousePos = ImVec2((float)mx, (float)my);
#endif
}

static void ImGui_ImplSDL2_UpdateMouseCursor()
{
    ImGuiIO& io = ImGui::GetIO();
    if (io.ConfigFlags & ImGuiConfigFlags_NoMouseCursorChange)
        return;

    ImGuiMouseCursor imgui_cursor = ImGui::GetMouseCursor();
    if (io.MouseDrawCursor || imgui_cursor == ImGuiMouseCursor_None)
    {
        // Hide OS mouse cursor if imgui is drawing it or if it wants no cursor
        SDL_ShowCursor(SDL_FALSE);
    }
    else
    {
        // Show OS mouse cursor
        SDL_SetCursor(g_MouseCursors[imgui_cursor] ? g_MouseCursors[imgui_cursor] : g_MouseCursors[ImGuiMouseCursor_Arrow]);
        SDL_ShowCursor(SDL_TRUE);
    }
}

void ImGui_ImplSDL2_NewFrame(SDL_Window* window)
{
    ImGuiIO& io = ImGui::GetIO();
    IM_ASSERT(io.Fonts->IsBuilt());     // Font atlas needs to be built, call renderer _NewFrame() function e.g. ImGui_ImplOpenGL3_NewFrame() 

    // Setup display size (every frame to accommodate for window resizing)
    int w, h;
    int display_w, display_h;
    SDL_GetWindowSize(window, &w, &h);
    SDL_GL_GetDrawableSize(window, &display_w, &display_h);
    io.DisplaySize = ImVec2((float)w, (float)h);
    io.DisplayFramebufferScale = ImVec2(w > 0 ? ((float)display_w / w) : 0, h > 0 ? ((float)display_h / h) : 0);

    // Setup time step (we don't use SDL_GetTicks() because it is using millisecond resolution)
    static Uint64 frequency = SDL_GetPerformanceFrequency();
    Uint64 current_time = SDL_GetPerformanceCounter();
    io.DeltaTime = g_Time > 0 ? (float)((double)(current_time - g_Time) / frequency) : (float)(1.0f / 60.0f);
    g_Time = current_time;

    ImGui_ImplSDL2_UpdateMousePosAndButtons();
    ImGui_ImplSDL2_UpdateMouseCursor();
}
Val := New_Offsetof (Info.B.Base_Type (I), Field_Info.Field_Node (I), Ghdl_Index_Type); else Val := New_Offsetof (Info.B.Bounds_Type, Field_Info.Field_Node (I), Ghdl_Index_Type); end if; else Val := Ghdl_Index_0; end if; New_Record_Aggr_El (Aggr, Val); end loop; if Is_Unbounded_Type (El_Tinfo) then Val := New_Offsetof (Info.B.Bounds_Type, Field_Info.Field_Bound, Ghdl_Index_Type); else Val := Ghdl_Index_0; end if; New_Record_Aggr_El (Aggr, Val); Finish_Record_Aggr (Aggr, Val); Finish_Init_Value (El_Const, Val); Add_Rti_Node (El_Const); Pop_Identifier_Prefix (Mark); end; end loop; El_Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); Pop_Rti_Node (Prev); Info.B.Rti_Max_Depth := Max_Depth; -- Generate record. declare Aggr : O_Record_Aggr_List; Name : O_Dnode; Rtik : O_Cnode; Depth : Rti_Depth_Type; Layout_Loc : O_Cnode; begin Name := Generate_Type_Name (Atype); Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Record); Depth := 0; Layout_Loc := Null_Loc; if Get_Constraint_State (Atype) = Fully_Constrained then Rtik := Ghdl_Rtik_Type_Record; if Info.S.Composite_Layout /= Null_Var then Depth := Get_Depth_From_Var (Info.S.Composite_Layout); Layout_Loc := Var_Acc_To_Loc (Info.S.Composite_Layout); end if; else Rtik := Ghdl_Rtik_Type_Unbounded_Record; end if; New_Record_Aggr_El (Aggr, Generate_Common_Type (Rtik, Depth, Max_Depth, Type_To_Mode (Atype))); New_Record_Aggr_El (Aggr, New_Name_Address (Name)); New_Record_Aggr_El (Aggr, New_Index_Lit (Unsigned_64 (Get_Nbr_Elements (El_List)))); New_Record_Aggr_El (Aggr, New_Global_Address (New_Global (El_Arr), Ghdl_Rti_Arr_Acc)); New_Record_Aggr_El (Aggr, Layout_Loc); Finish_Record_Aggr (Aggr, Res); Finish_Init_Value (Info.Type_Rti, Res); end; end Generate_Record_Type_Definition; procedure Generate_Protected_Type_Declaration (Atype : Iir) is Info : Type_Info_Acc; Name : O_Dnode; Val : O_Cnode; List : O_Record_Aggr_List; begin Info := Get_Info (Atype); Generate_Type_Rti (Info, Ghdl_Rtin_Type_Scalar); if Global_Storage = O_Storage_External then return; end if; Name := Generate_Type_Name (Atype); Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar); New_Record_Aggr_El (List, Generate_Common_Type (Ghdl_Rtik_Type_Protected, 0, 0, Type_To_Mode (Atype))); New_Record_Aggr_El (List, New_Name_Address (Name)); Finish_Record_Aggr (List, Val); Finish_Init_Value (Info.Type_Rti, Val); end Generate_Protected_Type_Declaration; -- If FORCE is true, force the creation of the type RTI. -- Otherwise, only the declaration (and not the definition) may have -- been created. function Generate_Type_Definition (Atype : Iir; Force : Boolean := False) return O_Dnode is Info : constant Type_Info_Acc := Get_Info (Atype); begin if not Force and then Info.Type_Rti /= O_Dnode_Null then return Info.Type_Rti; end if; case Get_Kind (Atype) is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => raise Internal_Error; when Iir_Kind_Enumeration_Type_Definition => Generate_Enumeration_Type_Definition (Atype); when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition => Generate_Scalar_Subtype_Definition (Atype); when Iir_Kind_Array_Type_Definition => Generate_Array_Type_Definition (Atype); when Iir_Kind_Array_Subtype_Definition => Generate_Array_Subtype_Definition (Atype); when Iir_Kind_Access_Type_Definition | Iir_Kind_File_Type_Definition => Generate_Fileacc_Type_Definition (Atype); when Iir_Kind_Record_Subtype_Definition => Generate_Composite_Subtype_Definition (Atype); when Iir_Kind_Access_Subtype_Definition => -- FIXME: No separate infos (yet). Info.Type_Rti := Get_Info (Get_Base_Type (Atype)).Type_Rti; when Iir_Kind_Record_Type_Definition => Generate_Record_Type_Definition (Atype); when Iir_Kind_Protected_Type_Declaration => Generate_Protected_Type_Declaration (Atype); when others => Error_Kind ("rti.generate_type_definition", Atype); return O_Dnode_Null; end case; return Info.Type_Rti; end Generate_Type_Definition; function Generate_Incomplete_Type_Definition (Def : Iir) return O_Dnode is Ndef : constant Iir := Get_Complete_Type_Definition (Def); Info : constant Type_Info_Acc := Get_Info (Ndef); Rti_Type : O_Tnode; begin case Get_Kind (Ndef) is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Scalar; when Iir_Kind_Physical_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Physical; when Iir_Kind_Enumeration_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Enum; when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition => Rti_Type := Ghdl_Rtin_Subtype_Scalar; when Iir_Kind_Array_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Array; when Iir_Kind_Array_Subtype_Definition => Rti_Type := Ghdl_Rtin_Subtype_Composite; when Iir_Kind_Access_Type_Definition | Iir_Kind_File_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Fileacc; when Iir_Kind_Record_Type_Definition => Rti_Type := Ghdl_Rtin_Type_Record; when others => Error_Kind ("rti.generate_incomplete_type_definition", Ndef); end case; New_Const_Decl (Info.Type_Rti, Create_Identifier ("RTI"), Global_Storage, Rti_Type); return Info.Type_Rti; end Generate_Incomplete_Type_Definition; function Generate_Type_Decl (Decl : Iir) return O_Dnode is Id : constant Name_Id := Get_Identifier (Decl); Def : constant Iir := Get_Type (Decl); Rti : O_Dnode; Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Id); if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then Rti := Generate_Incomplete_Type_Definition (Def); else Rti := Generate_Type_Definition (Def, True); end if; Pop_Identifier_Prefix (Mark); return Rti; end Generate_Type_Decl; procedure Generate_Signal_Rti (Sig : Iir) is Info : constant Signal_Info_Acc := Get_Info (Sig); begin New_Const_Decl (Info.Signal_Rti, Create_Identifier (Sig, "__RTI"), Global_Storage, Ghdl_Rtin_Object); end Generate_Signal_Rti; function Generate_Linecol (Decl : Iir) return O_Cnode is Line : Natural; Col : Natural; Name : Name_Id; begin Files_Map.Location_To_Position (Get_Location (Decl), Name, Line, Col); -- Saturate col and line. Col := Natural'Min (Col, 255); Line := Natural'Min (Line, 2**24 - 1); return Helpers.New_Index_Lit (Unsigned_64 (Line) * 256 + Unsigned_64 (Col)); end Generate_Linecol; procedure Generate_Object (Decl : Iir; Rti : in out O_Dnode) is Decl_Type : Iir; Type_Info : Type_Info_Acc; Name : O_Dnode; Comm : O_Cnode; Val : O_Cnode; List : O_Record_Aggr_List; Info : Ortho_Info_Acc; Mark : Id_Mark_Type; Var : Var_Type; Mode : Natural; Has_Id : Boolean; begin case Get_Kind (Decl) is when Iir_Kind_Transaction_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute => Has_Id := False; Push_Identifier_Prefix_Uniq (Mark); when others => Has_Id := True; Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); end case; if Rti = O_Dnode_Null then New_Const_Decl (Rti, Create_Identifier ("RTI"), Global_Storage, Ghdl_Rtin_Object); end if; if Global_Storage /= O_Storage_External then Decl_Type := Get_Type (Decl); Type_Info := Get_Info (Decl_Type); if Type_Info.Type_Rti = O_Dnode_Null then declare Mark : Id_Mark_Type; Tmp : O_Dnode; pragma Unreferenced (Tmp); begin Push_Identifier_Prefix (Mark, "OT"); Tmp := Generate_Type_Definition (Decl_Type); Pop_Identifier_Prefix (Mark); end; end if; if Has_Id then Name := Generate_Name (Decl); else Name := O_Dnode_Null; end if; Info := Get_Info (Decl); Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Object); Mode := 0; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => Comm := Ghdl_Rtik_Signal; Var := Info.Signal_Sig; when Iir_Kind_Interface_Signal_Declaration => Comm := Ghdl_Rtik_Port; Var := Info.Signal_Sig; Mode := Iir_Mode'Pos (Get_Mode (Decl)); when Iir_Kind_Constant_Declaration => Comm := Ghdl_Rtik_Constant; Var := Info.Object_Var; when Iir_Kind_Interface_Constant_Declaration => Comm := Ghdl_Rtik_Generic; Var := Info.Object_Var; when Iir_Kind_Variable_Declaration => Comm := Ghdl_Rtik_Variable; Var := Info.Object_Var; when Iir_Kind_Guard_Signal_Declaration => Comm := Ghdl_Rtik_Guard; Var := Info.Signal_Sig; when Iir_Kind_Iterator_Declaration => Comm := Ghdl_Rtik_Iterator; Var := Info.Iterator_Var; when Iir_Kind_File_Declaration => Comm := Ghdl_Rtik_File; Var := Info.Object_Var; when Iir_Kind_Attribute_Declaration => Comm := Ghdl_Rtik_Attribute; Var := Null_Var; when Iir_Kind_Transaction_Attribute => Comm := Ghdl_Rtik_Attribute_Transaction; Var := Info.Signal_Sig; when Iir_Kind_Quiet_Attribute => Comm := Ghdl_Rtik_Attribute_Quiet; Var := Info.Signal_Sig; when Iir_Kind_Stable_Attribute => Comm := Ghdl_Rtik_Attribute_Stable; Var := Info.Signal_Sig; when Iir_Kind_Object_Alias_Declaration => Comm := Ghdl_Rtik_Alias; Var := Info.Alias_Var (Info.Alias_Kind); Mode := Object_Kind_Type'Pos (Info.Alias_Kind); when others => Error_Kind ("rti.generate_object", Decl); end case; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Signal_Declaration => if Get_Guarded_Signal_Flag (Decl) then case Get_Signal_Kind (Decl) is when Iir_Register_Kind => Mode := Mode + 16; when Iir_Bus_Kind => Mode := Mode + 32; end case; end if; when others => null; end case; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Transaction_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Delayed_Attribute => if Get_Has_Active_Flag (Decl) then Mode := Mode + 64; end if; when others => null; end case; New_Record_Aggr_El (List, Generate_Common (Comm, Var, Mode)); New_Record_Aggr_El (List, New_Name_Address (Name)); New_Record_Aggr_El (List, Var_Acc_To_Loc_Maybe (Var)); Val := New_Rti_Address (Type_Info.Type_Rti); New_Record_Aggr_El (List, Val); New_Record_Aggr_El (List, Generate_Linecol (Decl)); Finish_Record_Aggr (List, Val); Finish_Init_Value (Rti, Val); end if; Pop_Identifier_Prefix (Mark); end Generate_Object; procedure Generate_Psl_Directive (Decl : Iir) is Info : constant Psl_Info_Acc := Get_Info (Decl); Name : O_Dnode; Kind : O_Cnode; Val : O_Cnode; List : O_Record_Aggr_List; Mark : Id_Mark_Type; Field_Off : O_Cnode; begin pragma Assert (Global_Storage /= O_Storage_External); Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); New_Const_Decl (Info.Psl_Rti_Const, Create_Identifier ("RTI"), Global_Storage, Ghdl_Rtin_Object); Name := Generate_Name (Decl); Start_Init_Value (Info.Psl_Rti_Const); Start_Record_Aggr (List, Ghdl_Rtin_Object); case Get_Kind (Decl) is when Iir_Kind_Psl_Cover_Directive => Kind := Ghdl_Rtik_Psl_Cover; when Iir_Kind_Psl_Assert_Statement => Kind := Ghdl_Rtik_Psl_Assert; when Iir_Kind_Psl_Endpoint_Declaration => Kind := Ghdl_Rtik_Psl_Endpoint; when others => Error_Kind ("rti.generate_psl_directive", Decl); end case; New_Record_Aggr_El (List, Generate_Common (Kind)); New_Record_Aggr_El (List, New_Name_Address (Name)); Field_Off := Get_Scope_Offset (Info.Psl_Scope, Ghdl_Ptr_Type); New_Record_Aggr_El (List, Field_Off); New_Record_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access)); New_Record_Aggr_El (List, Generate_Linecol (Decl)); Finish_Record_Aggr (List, Val); Finish_Init_Value (Info.Psl_Rti_Const, Val); Pop_Identifier_Prefix (Mark); Add_Rti_Node (Info.Psl_Rti_Const); end Generate_Psl_Directive; procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode); procedure Generate_If_Case_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode); procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode); procedure Generate_Declaration_Chain (Chain : Iir; Parent_Rti : O_Dnode); procedure Generate_Component_Declaration (Comp : Iir) is Prev : Rti_Block; Name : O_Dnode; Arr : O_Dnode; List : O_Record_Aggr_List; Res : O_Cnode; Mark : Id_Mark_Type; Info : Comp_Info_Acc; begin Push_Identifier_Prefix (Mark, Get_Identifier (Comp)); Info := Get_Info (Comp); New_Const_Decl (Info.Comp_Rti_Const, Create_Identifier ("RTI"), Global_Storage, Ghdl_Rtin_Component); if Global_Storage /= O_Storage_External then Push_Rti_Node (Prev); Generate_Declaration_Chain (Get_Generic_Chain (Comp), Info.Comp_Rti_Const); Generate_Declaration_Chain (Get_Port_Chain (Comp), Info.Comp_Rti_Const); Name := Generate_Name (Comp); Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); Start_Init_Value (Info.Comp_Rti_Const); Start_Record_Aggr (List, Ghdl_Rtin_Component); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Component)); New_Record_Aggr_El (List, New_Name_Address (Name)); New_Record_Aggr_El (List, New_Index_Lit (Get_Rti_Array_Length)); New_Record_Aggr_El (List, New_Global_Address (New_Global (Arr), Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); Finish_Init_Value (Info.Comp_Rti_Const, Res); Pop_Rti_Node (Prev); end if; Pop_Identifier_Prefix (Mark); Add_Rti_Node (Info.Comp_Rti_Const); end Generate_Component_Declaration; -- Generate RTIs only for types. This is needed for 'image/'value procedure Generate_Declaration_Chain_Depleted (Chain : Iir) is Decl : Iir; begin Decl := Chain; while Decl /= Null_Iir loop case Get_Kind (Decl) is when Iir_Kind_Use_Clause => null; when Iir_Kind_Type_Declaration => -- FIXME: physicals ? if Get_Kind (Get_Type_Definition (Decl)) = Iir_Kind_Enumeration_Type_Definition then Add_Rti_Node (Generate_Type_Decl (Decl)); end if; when Iir_Kind_Subtype_Declaration => -- In a subprogram, a subtype may depends on parameters. -- Eg: array subtypes. null; when Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Constant_Declaration | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Signal_Attribute_Declaration | Iir_Kind_Anonymous_Signal_Declaration => null; when Iir_Kind_Object_Alias_Declaration | Iir_Kind_Attribute_Declaration => null; when Iir_Kind_Component_Declaration => null; when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => -- FIXME: to be added (for foreign). null; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => null; when Iir_Kind_Anonymous_Type_Declaration => -- Handled in subtype declaration. null; when Iir_Kind_Configuration_Specification | Iir_Kind_Attribute_Specification | Iir_Kind_Disconnection_Specification => null; when Iir_Kind_Protected_Type_Body => null; when Iir_Kind_Non_Object_Alias_Declaration => null; when Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration => null; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => null; when others => Error_Kind ("rti.generate_declaration_chain_depleted", Decl); end case; Decl := Get_Chain (Decl); end loop; end Generate_Declaration_Chain_Depleted; procedure Generate_Subprogram_Body (Bod : Iir) is --Decl : Iir; --Mark : Id_Mark_Type; begin --Decl := Get_Subprogram_Specification (Bod); --Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); -- Generate RTI only for types. Generate_Declaration_Chain_Depleted (Get_Declaration_Chain (Bod)); --Pop_Identifier_Prefix (Mark); end Generate_Subprogram_Body; procedure Generate_Instance (Stmt : Iir; Parent : O_Dnode) is Name : O_Dnode; List : O_Record_Aggr_List; Val : O_Cnode; Inst : constant Iir := Get_Instantiated_Unit (Stmt); Info : constant Block_Info_Acc := Get_Info (Stmt); begin Name := Generate_Name (Stmt); New_Const_Decl (Info.Block_Rti_Const, Create_Identifier ("RTI"), Global_Storage, Ghdl_Rtin_Instance); Start_Init_Value (Info.Block_Rti_Const); Start_Record_Aggr (List, Ghdl_Rtin_Instance); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Instance)); New_Record_Aggr_El (List, New_Name_Address (Name)); New_Record_Aggr_El (List, Generate_Linecol (Stmt)); New_Record_Aggr_El (List, New_Offsetof (Get_Scope_Type (Get_Info (Get_Parent (Stmt)).Block_Scope), Info.Block_Link_Field, Ghdl_Ptr_Type)); New_Record_Aggr_El (List, New_Rti_Address (Parent)); if Is_Component_Instantiation (Stmt) then Val := New_Rti_Address (Get_Info (Get_Named_Entity (Inst)).Comp_Rti_Const); else declare Ent : constant Iir := Get_Entity_From_Entity_Aspect (Inst); begin Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const); end; end if; New_Record_Aggr_El (List, Val); Finish_Record_Aggr (List, Val); Finish_Init_Value (Info.Block_Rti_Const, Val); Add_Rti_Node (Info.Block_Rti_Const); end Generate_Instance; procedure Generate_Declaration_Chain (Chain : Iir; Parent_Rti : O_Dnode) is Decl : Iir; begin Decl := Chain; while Decl /= Null_Iir loop case Get_Kind (Decl) is when Iir_Kind_Use_Clause => null; when Iir_Kind_Anonymous_Type_Declaration => -- Handled in subtype declaration. null; when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration => Add_Rti_Node (Generate_Type_Decl (Decl)); when Iir_Kind_Constant_Declaration => -- Do not generate RTIs for full declarations. -- (RTI will be generated for the deferred declaration). if Get_Deferred_Declaration (Decl) = Null_Iir or else Get_Deferred_Declaration_Flag (Decl) then declare Info : constant Object_Info_Acc := Get_Info (Decl); begin Generate_Object (Decl, Info.Object_Rti); Add_Rti_Node (Info.Object_Rti); end; end if; when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration => declare Info : constant Object_Info_Acc := Get_Info (Decl); begin Generate_Object (Decl, Info.Object_Rti); Add_Rti_Node (Info.Object_Rti); end; when Iir_Kind_Signal_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => declare Info : constant Signal_Info_Acc := Get_Info (Decl); begin Generate_Object (Decl, Info.Signal_Rti); Add_Rti_Node (Info.Signal_Rti); end; when Iir_Kind_Signal_Attribute_Declaration => declare Sig : Iir; Info : Signal_Info_Acc; begin Sig := Get_Signal_Attribute_Chain (Decl); while Is_Valid (Sig) loop case Iir_Kinds_Signal_Attribute (Get_Kind (Sig)) is when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute | Iir_Kind_Transaction_Attribute => Info := Get_Info (Sig); Generate_Object (Sig, Info.Signal_Rti); Add_Rti_Node (Info.Signal_Rti); when Iir_Kind_Delayed_Attribute => null; end case; Sig := Get_Attr_Chain (Sig); end loop; end; when Iir_Kind_Object_Alias_Declaration | Iir_Kind_Attribute_Declaration => declare Rti : O_Dnode := O_Dnode_Null; begin Generate_Object (Decl, Rti); Add_Rti_Node (Rti); end; when Iir_Kind_Component_Declaration => Generate_Component_Declaration (Decl); when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => -- FIXME: to be added (for foreign). null; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => -- Already handled by Translate_Subprogram_Body. null; when Iir_Kind_Configuration_Specification | Iir_Kind_Attribute_Specification | Iir_Kind_Disconnection_Specification => null; when Iir_Kind_Protected_Type_Body => null; when Iir_Kind_Non_Object_Alias_Declaration => null; when Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration => null; when Iir_Kind_Package_Declaration => if Get_Info (Decl) /= null then -- Do not generate RTIs for untranslated packages. declare Mark : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); Generate_Block (Decl, Parent_Rti); Pop_Identifier_Prefix (Mark); end; end if; when Iir_Kind_Package_Body => if Get_Info (Get_Package (Decl)) /= null then -- Do not generate RTIs for untranslated packages. declare Mark : Id_Mark_Type; Mark1 : Id_Mark_Type; begin Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); Push_Identifier_Prefix (Mark1, "BODY"); Generate_Block (Decl, Parent_Rti); Pop_Identifier_Prefix (Mark1); Pop_Identifier_Prefix (Mark); end; end if; when Iir_Kind_Package_Instantiation_Declaration => -- FIXME: todo null; when Iir_Kind_Psl_Default_Clock => null; when Iir_Kind_Psl_Declaration => null; when others => Error_Kind ("rti.generate_declaration_chain", Decl); end case; Decl := Get_Chain (Decl); end loop; end Generate_Declaration_Chain; procedure Generate_Concurrent_Statement_Chain (Chain : Iir; Parent_Rti : O_Dnode) is Stmt : Iir; Mark : Id_Mark_Type; begin Stmt := Chain; while Stmt /= Null_Iir loop case Get_Kind (Stmt) is when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Block_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); Generate_Block (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_If_Generate_Statement | Iir_Kind_Case_Generate_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); Generate_If_Case_Generate_Statement (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_For_Generate_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); -- Create the RTI for the iterator type, in the parent of the -- generate statement. declare Param : constant Iir := Get_Parameter_Specification (Stmt); Iter_Type : constant Iir := Get_Type (Param); Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type); Mark : Id_Mark_Type; Iter_Rti : O_Dnode; begin if Type_Info.Type_Rti = O_Dnode_Null then Push_Identifier_Prefix (Mark, "ITERATOR"); Iter_Rti := Generate_Type_Definition (Iter_Type); -- The RTIs for the parent are being defined, so append -- to the parent. Add_Rti_Node (Iter_Rti); Pop_Identifier_Prefix (Mark); end if; end; Generate_For_Generate_Statement (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_Component_Instantiation_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); Generate_Instance (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_Psl_Default_Clock => null; when Iir_Kind_Psl_Declaration => null; when Iir_Kind_Psl_Assert_Statement | Iir_Kind_Psl_Cover_Directive | Iir_Kind_Psl_Endpoint_Declaration => Generate_Psl_Directive (Stmt); when others => Error_Kind ("rti.generate_concurrent_statement_chain", Stmt); end case; Stmt := Get_Chain (Stmt); end loop; end Generate_Concurrent_Statement_Chain; procedure Generate_If_Case_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode) is Info : constant Generate_Info_Acc := Get_Info (Blk); Bod : Iir; Name : O_Dnode; List : O_Record_Aggr_List; Num : Natural; Rti : O_Dnode; Rtik : O_Cnode; Arr : O_Dnode; Prev : Rti_Block; Field_Off : O_Cnode; Res : O_Cnode; Mark : Id_Mark_Type; begin New_Const_Decl (Rti, Create_Identifier ("RTI"), O_Storage_Public, Ghdl_Rtin_Block); Push_Rti_Node (Prev); Num := 0; case Get_Kind (Blk) is when Iir_Kind_If_Generate_Statement => declare Clause : Iir; begin Clause := Blk; while Clause /= Null_Iir loop Bod := Get_Generate_Statement_Body (Clause); Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); Generate_Block (Bod, Rti); Pop_Identifier_Prefix (Mark); Clause := Get_Generate_Else_Clause (Clause); Num := Num + 1; end loop; Rtik := Ghdl_Rtik_If_Generate; end; when Iir_Kind_Case_Generate_Statement => declare Alt : Iir; begin Alt := Get_Case_Statement_Alternative_Chain (Blk); while Alt /= Null_Iir loop if not Get_Same_Alternative_Flag (Alt) then Bod := Get_Associated_Block (Alt); Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); Generate_Block (Bod, Rti); Pop_Identifier_Prefix (Mark); Num := Num + 1; end if; Alt := Get_Chain (Alt); end loop; Rtik := Ghdl_Rtik_Case_Generate; end; when others => raise Internal_Error; end case; Name := Generate_Name (Blk); Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Block); New_Record_Aggr_El (List, Generate_Common (Rtik)); New_Record_Aggr_El (List, New_Name_Address (Name)); -- Field Loc: offset in the instance of the entity. Field_Off := New_Offsetof (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), Get_Info (Blk).Generate_Parent_Field, Ghdl_Ptr_Type); New_Record_Aggr_El (List, Field_Off); New_Record_Aggr_El (List, Generate_Linecol (Blk)); -- Field Parent: RTI of the parent. New_Record_Aggr_El (List, New_Rti_Address (Parent_Rti)); -- Fields Nbr_Child and Children. New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Index_Type, Get_Rti_Array_Length)); New_Record_Aggr_El (List, New_Global_Address (New_Global (Arr), Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); Finish_Init_Value (Rti, Res); Pop_Rti_Node (Prev); -- Put the result in the parent list. Add_Rti_Node (Rti); -- Store the RTI. Info.Generate_Rti_Const := Rti; end Generate_If_Case_Generate_Statement; procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode) is Info : constant Ortho_Info_Acc := Get_Info (Blk); Bod : constant Iir := Get_Generate_Statement_Body (Blk); Bod_Info : constant Block_Info_Acc := Get_Info (Bod); Name : O_Dnode; List : O_Record_Aggr_List; Rti : O_Dnode; Prev : Rti_Block; Field_Off : O_Cnode; Res : O_Cnode; Mark : Id_Mark_Type; begin New_Const_Decl (Rti, Create_Identifier ("RTI"), O_Storage_Public, Ghdl_Rtin_Generate); Push_Rti_Node (Prev); Push_Identifier_Prefix (Mark, "BOD"); Generate_Block (Bod, Rti); Pop_Identifier_Prefix (Mark); Name := Generate_Name (Blk); Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Generate); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_For_Generate)); New_Record_Aggr_El (List, New_Name_Address (Name)); -- Field Loc: offset in the instance of the entity. Field_Off := New_Offsetof (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type); New_Record_Aggr_El (List, Field_Off); New_Record_Aggr_El (List, Generate_Linecol (Blk)); -- Field Parent: RTI of the parent. New_Record_Aggr_El (List, New_Rti_Address (Parent_Rti)); -- Field Size: size of the instance. -- For for-generate: size of instance, which gives the stride in the -- sub-blocks array. New_Record_Aggr_El (List, New_Sizeof (Get_Scope_Type (Bod_Info.Block_Scope), Ghdl_Index_Type)); -- Child. New_Record_Aggr_El (List, New_Rti_Address (Get_Context_Rti (Bod))); Finish_Record_Aggr (List, Res); Finish_Init_Value (Rti, Res); Pop_Rti_Node (Prev); -- Put the result in the parent list. Add_Rti_Node (Rti); -- Store the RTI. if False then -- TODO: there is no info for if_generate/for_generate. -- Not sure we need to store it (except maybe for 'path_name ?) Info.Block_Rti_Const := Rti; end if; end Generate_For_Generate_Statement; procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode) is Info : constant Ortho_Info_Acc := Get_Info (Blk); Name : O_Dnode; Arr : O_Dnode; List : O_Record_Aggr_List; List_File : O_Record_Aggr_List; Rti_Type : O_Tnode; Rti : O_Dnode; Kind : O_Cnode; Res : O_Cnode; Prev : Rti_Block; Field_Off : O_Cnode; begin if Global_Storage /= O_Storage_External then if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then -- Also include filename for units. Rti_Type := Ghdl_Rtin_Block_File; else Rti_Type := Ghdl_Rtin_Block; end if; New_Const_Decl (Rti, Create_Identifier ("RTI"), Global_Storage, Rti_Type); end if; Push_Rti_Node (Prev); Field_Off := O_Cnode_Null; case Get_Kind (Blk) is when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => Kind := Ghdl_Rtik_Package; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); when Iir_Kind_Package_Body => Kind := Ghdl_Rtik_Package_Body; -- Required at least for 'image Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); when Iir_Kind_Architecture_Body => Kind := Ghdl_Rtik_Architecture; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); Generate_Concurrent_Statement_Chain (Get_Concurrent_Statement_Chain (Blk), Rti); Field_Off := New_Offsetof (Get_Scope_Type (Info.Block_Scope), Info.Block_Parent_Field, Ghdl_Ptr_Type); when Iir_Kind_Entity_Declaration => Kind := Ghdl_Rtik_Entity; Generate_Declaration_Chain (Get_Generic_Chain (Blk), Rti); Generate_Declaration_Chain (Get_Port_Chain (Blk), Rti); Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); Generate_Concurrent_Statement_Chain (Get_Concurrent_Statement_Chain (Blk), Rti); when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Kind := Ghdl_Rtik_Process; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); Field_Off := Get_Scope_Offset (Info.Process_Scope, Ghdl_Ptr_Type); when Iir_Kind_Block_Statement => Kind := Ghdl_Rtik_Block; declare Guard : constant Iir := Get_Guard_Decl (Blk); Header : constant Iir := Get_Block_Header (Blk); Guard_Info : Signal_Info_Acc; begin if Guard /= Null_Iir then Guard_Info := Get_Info (Guard); Generate_Object (Guard, Guard_Info.Signal_Rti); Add_Rti_Node (Guard_Info.Signal_Rti); end if; if Header /= Null_Iir then Generate_Declaration_Chain (Get_Generic_Chain (Header), Rti); Generate_Declaration_Chain (Get_Port_Chain (Header), Rti); end if; end; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); Generate_Concurrent_Statement_Chain (Get_Concurrent_Statement_Chain (Blk), Rti); Field_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type); when Iir_Kind_Generate_Statement_Body => Kind := Ghdl_Rtik_Generate_Body; -- Also includes iterator of for_generate_statement. declare Parent : constant Iir := Get_Parent (Blk); Param_Rti : O_Dnode; begin if Get_Kind (Parent) = Iir_Kind_For_Generate_Statement then -- Must be set to null, as this isn't a completion. Param_Rti := O_Dnode_Null; Generate_Object (Get_Parameter_Specification (Parent), Param_Rti); Add_Rti_Node (Param_Rti); end if; end; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); Generate_Concurrent_Statement_Chain (Get_Concurrent_Statement_Chain (Blk), Rti); when others => Error_Kind ("rti.generate_block", Blk); end case; if Global_Storage /= O_Storage_External then Name := Generate_Name (Blk); Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); Start_Init_Value (Rti); if Rti_Type = Ghdl_Rtin_Block_File then Start_Record_Aggr (List_File, Rti_Type); end if; Start_Record_Aggr (List, Ghdl_Rtin_Block); New_Record_Aggr_El (List, Generate_Common (Kind)); New_Record_Aggr_El (List, New_Name_Address (Name)); -- Field Loc: offset in the instance of the entity. if Field_Off = O_Cnode_Null then Field_Off := Null_Loc; end if; New_Record_Aggr_El (List, Field_Off); New_Record_Aggr_El (List, Generate_Linecol (Blk)); -- Field Parent: RTI of the parent. if Parent_Rti = O_Dnode_Null then Res := New_Null_Access (Ghdl_Rti_Access); else Res := New_Rti_Address (Parent_Rti); end if; New_Record_Aggr_El (List, Res); -- Fields Nbr_Child and Children. New_Record_Aggr_El (List, New_Index_Lit (Get_Rti_Array_Length)); New_Record_Aggr_El (List, New_Global_Address (New_Global (Arr), Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); if Rti_Type = Ghdl_Rtin_Block_File then New_Record_Aggr_El (List_File, Res); New_Record_Aggr_El (List_File, New_Name_Address (Current_Filename_Node)); Finish_Record_Aggr (List_File, Res); end if; Finish_Init_Value (Rti, Res); end if; Pop_Rti_Node (Prev); -- Put result in the parent list. case Get_Kind (Blk) is when Iir_Kind_Block_Statement | Iir_Kind_Generate_Statement_Body | Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Add_Rti_Node (Rti); when others => null; end case; -- Store the RTI. case Get_Kind (Blk) is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement | Iir_Kind_Generate_Statement_Body => Info.Block_Rti_Const := Rti; when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Info.Process_Rti_Const := Rti; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => Info.Package_Rti_Const := Rti; when Iir_Kind_Package_Body => -- Replace package declaration RTI with the body one. Get_Info (Get_Package (Blk)).Package_Rti_Const := Rti; when others => Error_Kind ("rti.generate_block", Blk); end case; end Generate_Block; procedure Generate_Library (Lib : Iir_Library_Declaration; Public : Boolean) is use Name_Table; Info : Library_Info_Acc; Id : Name_Id; Val : O_Cnode; Aggr : O_Record_Aggr_List; Name : O_Dnode; Storage : O_Storage; begin Info := Get_Info (Lib); if Info /= null then -- Already generated. return; end if; Info := Add_Info (Lib, Kind_Library); if Lib = Libraries.Work_Library then Id := Libraries.Work_Library_Name; else Id := Get_Identifier (Lib); end if; if Public then Storage := O_Storage_Public; else Storage := O_Storage_External; end if; New_Const_Decl (Info.Library_Rti_Const, Create_Identifier_Without_Prefix (Id, "__RTI"), Storage, Ghdl_Rtin_Type_Scalar); if Public then Name := Create_String (Image (Id), Create_Identifier_Without_Prefix (Id, "__RTISTR")); Start_Init_Value (Info.Library_Rti_Const); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Scalar); New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Library)); New_Record_Aggr_El (Aggr, New_Name_Address (Name)); Finish_Record_Aggr (Aggr, Val); Finish_Init_Value (Info.Library_Rti_Const, Val); end if; end Generate_Library; procedure Generate_Unit (Lib_Unit : Iir) is Info : constant Ortho_Info_Acc := Get_Info (Lib_Unit); Rti : O_Dnode; Mark : Id_Mark_Type; begin case Get_Kind (Lib_Unit) is when Iir_Kind_Configuration_Declaration => -- No RTI for configurations. return; when Iir_Kind_Architecture_Body => if Info.Block_Rti_Const /= O_Dnode_Null then return; end if; when Iir_Kind_Package_Body => Push_Identifier_Prefix (Mark, "BODY"); when others => null; end case; -- Declare node. if Global_Storage = O_Storage_External then New_Const_Decl (Rti, Create_Identifier ("RTI"), O_Storage_External, Ghdl_Rtin_Block); -- Declare inner declarations of entities and packages as they can -- be referenced from architectures and package bodies. case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration | Iir_Kind_Package_Declaration => declare Prev : Rti_Block; begin Push_Rti_Node (Prev); Generate_Declaration_Chain (Get_Declaration_Chain (Lib_Unit), Rti); Pop_Rti_Node (Prev); end; when others => null; end case; case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body => Info.Block_Rti_Const := Rti; when Iir_Kind_Package_Declaration => Info.Package_Rti_Const := Rti; when Iir_Kind_Package_Body => -- Replace package declaration RTI with the body one. Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const := Rti; when others => null; end case; else -- Compute parent RTI. case Get_Kind (Lib_Unit) is when Iir_Kind_Package_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Instantiation_Declaration => -- The library. declare Lib : Iir_Library_Declaration; begin Lib := Get_Library (Get_Design_File (Get_Design_Unit (Lib_Unit))); Generate_Library (Lib, False); Rti := Get_Info (Lib).Library_Rti_Const; end; when Iir_Kind_Package_Body => -- The package spec. Rti := Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const; when Iir_Kind_Architecture_Body => -- The entity. Rti := Get_Info (Get_Entity (Lib_Unit)).Block_Rti_Const; when others => raise Internal_Error; end case; -- Generate RTI for Lib_Unit, using parent RTI. Generate_Block (Lib_Unit, Rti); end if; if Get_Kind (Lib_Unit) = Iir_Kind_Package_Body then Pop_Identifier_Prefix (Mark); end if; end Generate_Unit; procedure Generate_Top (Nbr_Pkgs : out Natural) is use Vhdl.Configuration; Unit : Iir_Design_Unit; Lib : Iir_Library_Declaration; Lib_Unit : Iir; Prev : Rti_Block; begin Push_Rti_Node (Prev); -- Generate RTI for libraries, count number of packages. Nbr_Pkgs := 1; -- At least std.standard. for I in Design_Units.First .. Design_Units.Last loop Unit := Design_Units.Table (I); -- Generate RTI for the library. Lib := Get_Library (Get_Design_File (Unit)); Generate_Library (Lib, True); -- Count the number of top-level packages. Lib_Unit := Get_Library_Unit (Unit); case Get_Kind (Lib_Unit) is when Iir_Kind_Package_Declaration => Nbr_Pkgs := Nbr_Pkgs + 1; when Iir_Kind_Package_Instantiation_Declaration => if Get_Macro_Expanded_Flag (Get_Uninstantiated_Package_Decl (Lib_Unit)) then Nbr_Pkgs := Nbr_Pkgs + 1; end if; when others => null; end case; end loop; Pop_Rti_Node (Prev); end Generate_Top; function Get_Context_Rti (Node : Iir) return O_Dnode is Node_Info : constant Ortho_Info_Acc := Get_Info (Node); begin case Get_Kind (Node) is when Iir_Kind_Component_Declaration => return Node_Info.Comp_Rti_Const; when Iir_Kind_Component_Instantiation_Statement => return Node_Info.Block_Rti_Const; when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement | Iir_Kind_Generate_Statement_Body => return Node_Info.Block_Rti_Const; when Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement => declare Bod : constant Iir := Get_Generate_Statement_Body (Node); Bod_Info : constant Block_Info_Acc := Get_Info (Bod); begin return Bod_Info.Block_Rti_Const; end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => return Node_Info.Package_Rti_Const; when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => return Node_Info.Process_Rti_Const; when Iir_Kind_Psl_Assert_Statement | Iir_Kind_Psl_Cover_Directive | Iir_Kind_Psl_Endpoint_Declaration => return Node_Info.Psl_Rti_Const; when others => Error_Kind ("get_context_rti", Node); end case; end Get_Context_Rti; function Get_Context_Rti (Node : Iir) return O_Enode is begin return New_Rti_Address (Get_Context_Rti (Node)); end Get_Context_Rti; function Get_Context_Addr (Node : Iir) return O_Enode is Node_Info : constant Ortho_Info_Acc := Get_Info (Node); Ref : O_Lnode; begin case Get_Kind (Node) is when Iir_Kind_Component_Declaration => Ref := Get_Instance_Ref (Node_Info.Comp_Scope); when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Block_Statement | Iir_Kind_Generate_Statement_Body => Ref := Get_Instance_Ref (Node_Info.Block_Scope); when Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement => declare Bod : constant Iir := Get_Generate_Statement_Body (Node); Bod_Info : constant Block_Info_Acc := Get_Info (Bod); begin Ref := Get_Instance_Ref (Bod_Info.Block_Scope); end; when Iir_Kind_Package_Declaration | Iir_Kind_Package_Body => return New_Lit (New_Null_Access (Ghdl_Ptr_Type)); when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Ref := Get_Instance_Ref (Node_Info.Process_Scope); when Iir_Kind_Psl_Assert_Statement | Iir_Kind_Psl_Cover_Directive | Iir_Kind_Psl_Endpoint_Declaration => Ref := Get_Instance_Ref (Node_Info.Psl_Scope); when others => Error_Kind ("get_context_addr", Node); end case; return New_Unchecked_Address (Ref, Ghdl_Ptr_Type); end Get_Context_Addr; procedure Associate_Rti_Context (Assoc : in out O_Assoc_List; Node : Iir) is begin New_Association (Assoc, Get_Context_Rti (Node)); New_Association (Assoc, Get_Context_Addr (Node)); end Associate_Rti_Context; procedure Associate_Null_Rti_Context (Assoc : in out O_Assoc_List) is begin New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Rti_Access))); New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type))); end Associate_Null_Rti_Context; end Trans.Rtis;