path: root/ortho/mcode/binary_file.ads

--  Binary file handling.
--  Copyright (C) 2006 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 System;
with Interfaces; use Interfaces;
with Ada.Unchecked_Deallocation;
with Ortho_Ident; use Ortho_Ident;
with GNAT.Table;
with Memsegs;

package Binary_File is
   type Section_Type is limited private;
   type Section_Acc is access Section_Type;

   type Section_Flags is new Unsigned_32;
   Section_None   : constant Section_Flags;
   Section_Exec   : constant Section_Flags;
   Section_Read   : constant Section_Flags;
   Section_Write  : constant Section_Flags;
   Section_Zero   : constant Section_Flags;
   Section_Strtab : constant Section_Flags;
   Section_Debug  : constant Section_Flags;

   type Byte is new Unsigned_8;

   type Symbol is range -2 ** 31 .. 2 ** 31 - 1;
   for Symbol'Size use 32;
   Null_Symbol : constant Symbol := 0;

   type Pc_Type is mod System.Memory_Size;
   Null_Pc : constant Pc_Type := 0;

   type Arch_Kind is (Arch_Unknown, Arch_X86, Arch_Sparc, Arch_Ppc);
   Arch : Arch_Kind := Arch_Unknown;

   --  Dump assembly when generated.
   Dump_Asm : Boolean := False;

   Debug_Hex : Boolean := False;

   --  Create a section.
   procedure Create_Section (Sect : out Section_Acc;
                             Name : String; Flags : Section_Flags);
   procedure Set_Section_Info (Sect : Section_Acc;
                               Link : Section_Acc;
                               Align : Natural;
                               Esize : Natural);

   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc);

   --  Set the current section.
   procedure Set_Current_Section (Sect : Section_Acc);

   --  Create an undefined local (anonymous) symbol in the  current section.
   function Create_Local_Symbol return Symbol;
   function Create_Symbol (Name : O_Ident) return Symbol;

   --  Research symbol NAME, very expansive call.
   --  Return NULL_Symbol if not found.
   function Get_Symbol (Name : String) return Symbol;

   --  Get the virtual address of a symbol.
   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type;
   pragma Inline (Get_Symbol_Vaddr);

   --  Set the value of a symbol.
   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean);
   function Get_Symbol_Value (Sym : Symbol) return Pc_Type;

   --  Get the current PC.
   function Get_Current_Pc return Pc_Type;
   pragma Inline (Get_Current_Pc);

   function Get_Pc (Sect : Section_Acc) return Pc_Type;
   pragma Inline (Get_Pc);

   --  Align the current section of 2 ** ALIGN.
   procedure Gen_Pow_Align (Align : Natural);

   --  Generate LENGTH times 0.
   procedure Gen_Space (Length : Integer_32);

   --  Add a reloc in the current section at the current address.
   procedure Gen_X86_Pc32 (Sym : Symbol);
   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol);
   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol);
   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
                             Sym : Symbol; Off : Unsigned_32);
   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
                             Sym : Symbol; Off : Unsigned_32);

   --  Add a 32 bits value with a symbol relocation in the current section at
   --  the current address.
   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32);
   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32);
   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32);

   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol);

   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32);

   --  Start/finish an instruction in the current section.
   procedure Start_Insn;
   procedure End_Insn;
   --  Pre allocate L bytes.
   procedure Prealloc (L : Pc_Type);

   --  Add bits in the current section.
   procedure Gen_B8 (B : Byte);
   procedure Gen_B16 (B0, B1 : Byte);
   procedure Gen_Le8 (B : Unsigned_32);
   procedure Gen_Le16 (B : Unsigned_32);
   procedure Gen_Be16 (B : Unsigned_32);
   procedure Gen_Le32 (B : Unsigned_32);
   procedure Gen_Be32 (B : Unsigned_32);

   procedure Gen_16 (B : Unsigned_32);
   procedure Gen_32 (B : Unsigned_32);

   --  Add bits in the current section, but as stand-alone data.
   procedure Gen_Data_Le8 (B : Unsigned_32);
   procedure Gen_Data_Le16 (B : Unsigned_32);
   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32);

   --  Modify already generated code.
   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8);
   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32);
   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32);
   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32);
   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32);

   --  Binary writers:

   --  Set ERROR in case of error (undefined symbol).
   --procedure Write_Memory (Error : out Boolean);

   procedure Disp_Stats;
   procedure Finish;
private
   type Byte_Array_Base is array (Pc_Type range <>) of Byte;
   subtype Byte_Array is Byte_Array_Base (Pc_Type);
   type Byte_Array_Acc is access Byte_Array;
   type String_Acc is access String;
   --type Section_Flags is new Unsigned_32;

   --  Relocations.
   type Reloc_Kind is (Reloc_32, Reloc_Pc32,
                       Reloc_Ua_32,
                       Reloc_Disp22, Reloc_Disp30,
                       Reloc_Hi22, Reloc_Lo10,
                       Reloc_Ppc_Addr24);
   type Reloc_Type;
   type Reloc_Acc is access Reloc_Type;
   type Reloc_Type is record
      Kind : Reloc_Kind;
      --  If true, the reloc was already applied.
      Done : Boolean;
      --  Next in simply linked list.
      --  next reloc in the section.
      Sect_Next : Reloc_Acc;
      --  next reloc for the symbol.
      Sym_Next : Reloc_Acc;
      --  Address that must be relocated.
      Addr : Pc_Type;
      --  Symbol.
      Sym : Symbol;
   end record;

   type Section_Type is record
      --  Simply linked list of sections.
      Next : Section_Acc;
      --  Flags.
      Flags : Section_Flags;
      --  Name of the section.
      Name : String_Acc;
      --  Link to another section (used by ELF).
      Link : Section_Acc;
      --  Alignment (in power of 2).
      Align : Natural;
      --  Entry size (if any).
      Esize : Natural;
      --  Offset of the next data in DATA.
      Pc : Pc_Type;
      --  Offset of the current instruction.
      Insn_Pc : Pc_Type;
      --  Data for this section.
      Data : Byte_Array_Acc;
      --  Max address for data (before extending the area).
      Data_Max : Pc_Type;
      --  Chain of relocs defined in this section.
      First_Reloc : Reloc_Acc;
      Last_Reloc : Reloc_Acc;
      --  Number of relocs in this section.
      Nbr_Relocs : Natural;
      --  Section number (set and used by binary writer).
      Number : Natural;
      --  Virtual address, if set.
      Vaddr : Pc_Type; -- SSE.Integer_Address;
      --  Memory for this segment.
      Seg : Memsegs.Memseg_Type;
   end record;

   Section_Exec   : constant Section_Flags := 2#0000_0001#;
   Section_Read   : constant Section_Flags := 2#0000_0010#;
   Section_Write  : constant Section_Flags := 2#0000_0100#;
   Section_Zero   : constant Section_Flags := 2#0000_1000#;
   Section_Strtab : constant Section_Flags := 2#0001_0000#;
   Section_Debug  : constant Section_Flags := 2#0010_0000#;
   Section_None   : constant Section_Flags := 2#0000_0000#;

   --  Scope of a symbol:
   --  SYM_PRIVATE: not visible outside of the file.
   --  SYM_UNDEF: not (yet) defined, unresolved.
   --  SYM_GLOBAL: visible to all files.
   --  SYM_LOCAL: locally generated symbol.
   type Symbol_Scope is (Sym_Undef, Sym_Global, Sym_Private, Sym_Local);
   subtype Symbol_Scope_External is Symbol_Scope range Sym_Undef .. Sym_Global;
   type Symbol_Type is record
      Section : Section_Acc;
      Value : Pc_Type;
      Scope : Symbol_Scope;
      --  True if the symbol is referenced/used.
      Used : Boolean;
      --  Name of the symbol.
      Name : O_Ident;
      --  List of relocation made with this symbol.
      Relocs : Reloc_Acc;
      --  Symbol number, from 0.
      Number : Natural;
   end record;

   --  Number of sections.
   Nbr_Sections : Natural := 0;
   --  Simply linked list of sections.
   Section_Chain : Section_Acc := null;
   Section_Last : Section_Acc := null;

   package Symbols is new GNAT.Table
     (Table_Component_Type => Symbol_Type,
      Table_Index_Type => Symbol,
      Table_Low_Bound => 2,
      Table_Initial => 1024,
      Table_Increment => 100);

   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type;

   function Get_Symbol_Name (Sym : Symbol) return String;
   function Get_Symbol_Name_Length (Sym : Symbol) return Natural;

   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type);
   pragma Inline (Set_Symbol_Value);

   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope);
   pragma Inline (Set_Scope);

   function Get_Scope (Sym : Symbol) return Symbol_Scope;
   pragma Inline (Get_Scope);

   function Get_Section (Sym : Symbol) return Section_Acc;
   pragma Inline (Get_Section);

   procedure Set_Section (Sym : Symbol; Sect : Section_Acc);
   pragma Inline (Set_Section);

   function Get_Name (Sym : Symbol) return O_Ident;
   pragma Inline (Get_Name);

   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc);
   pragma Inline (Apply_Reloc);

   procedure Set_Number (Sym : Symbol; Num : Natural);
   pragma Inline (Set_Number);

   function Get_Number (Sym : Symbol) return Natural;
   pragma Inline (Get_Number);

   function Get_Used (Sym : Symbol) return Boolean;
   pragma Inline (Get_Used);

   procedure Do_Intra_Section_Reloc (Sect : Section_Acc);

   function S_Local (Sym : Symbol) return Boolean;
   pragma Inline (S_Local);

   procedure Resize (Sect : Section_Acc; Size : Pc_Type);

   procedure Free is new Ada.Unchecked_Deallocation
     (Name => Reloc_Acc, Object => Reloc_Type);

   Write_Error : exception;
end Binary_File;