Move sources to src/ subdirectory.

1 files changed, 977 insertions, 0 deletions

diff --git a/src/ortho/mcode/binary_file.adb b/src/ortho/mcode/binary_file.adb
new file mode 100644
index 000000000..6043d7319
--- /dev/null
+++ b/src/ortho/mcode/binary_file.adb
@@ -0,0 +1,977 @@
+--  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.Storage_Elements;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Conversion;
+with Hex_Images; use Hex_Images;
+with Disassemble;
+
+package body Binary_File is
+   Cur_Sect : Section_Acc := null;
+
+   HT : Character renames Ada.Characters.Latin_1.HT;
+
+   function To_Byte_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Byte_Array_Acc);
+
+   --  Resize a section to SIZE bytes.
+   procedure Resize (Sect : Section_Acc; Size : Pc_Type)
+   is
+   begin
+      Sect.Data_Max := Size;
+      Memsegs.Resize (Sect.Seg, Natural (Size));
+      Sect.Data := To_Byte_Array_Acc (Memsegs.Get_Address (Sect.Seg));
+   end Resize;
+
+   function Get_Scope (Sym : Symbol) return Symbol_Scope is
+   begin
+      return Symbols.Table (Sym).Scope;
+   end Get_Scope;
+
+   procedure Set_Scope (Sym : Symbol; Scope : Symbol_Scope) is
+   begin
+      Symbols.Table (Sym).Scope := Scope;
+   end Set_Scope;
+
+   function Get_Section (Sym : Symbol) return Section_Acc is
+   begin
+      return Symbols.Table (Sym).Section;
+   end Get_Section;
+
+   procedure Set_Section (Sym : Symbol; Sect : Section_Acc) is
+   begin
+      Symbols.Table (Sym).Section := Sect;
+   end Set_Section;
+
+   function Get_Number (Sym : Symbol) return Natural is
+   begin
+      return Symbols.Table (Sym).Number;
+   end Get_Number;
+
+   procedure Set_Number (Sym : Symbol; Num : Natural) is
+   begin
+      Symbols.Table (Sym).Number := Num;
+   end Set_Number;
+
+   function Get_Relocs (Sym : Symbol) return Reloc_Acc is
+   begin
+      return Symbols.Table (Sym).Relocs;
+   end Get_Relocs;
+
+   procedure Set_Relocs (Sym : Symbol; Reloc : Reloc_Acc) is
+   begin
+      Symbols.Table (Sym).Relocs := Reloc;
+   end Set_Relocs;
+
+   function Get_Name (Sym : Symbol) return O_Ident is
+   begin
+      return Symbols.Table (Sym).Name;
+   end Get_Name;
+
+   function Get_Used (Sym : Symbol) return Boolean is
+   begin
+      return Symbols.Table (Sym).Used;
+   end Get_Used;
+
+   procedure Set_Used (Sym : Symbol; Val : Boolean) is
+   begin
+      Symbols.Table (Sym).Used := Val;
+   end Set_Used;
+
+   function Get_Symbol_Value (Sym : Symbol) return Pc_Type is
+   begin
+      return Symbols.Table (Sym).Value;
+   end Get_Symbol_Value;
+
+   procedure Set_Symbol_Value (Sym : Symbol; Val : Pc_Type) is
+   begin
+      Symbols.Table (Sym).Value := Val;
+   end Set_Symbol_Value;
+
+   function S_Defined (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) /= Sym_Undef;
+   end S_Defined;
+   pragma Unreferenced (S_Defined);
+
+   function S_Local (Sym : Symbol) return Boolean is
+   begin
+      return Get_Scope (Sym) = Sym_Local;
+   end S_Local;
+
+   procedure Create_Section (Sect : out Section_Acc;
+                             Name : String; Flags : Section_Flags)
+   is
+   begin
+      Sect := new Section_Type'(Next => null,
+                                Flags => Flags,
+                                Name => new String'(Name),
+                                Link => null,
+                                Align => 2,
+                                Esize => 0,
+                                Pc => 0,
+                                Insn_Pc => 0,
+                                Data => null,
+                                Data_Max => 0,
+                                First_Reloc => null,
+                                Last_Reloc => null,
+                                Nbr_Relocs => 0,
+                                Number => 0,
+                                Seg => Memsegs.Create,
+                                Vaddr => 0);
+      if (Flags and Section_Zero) = 0 then
+         --  Allocate memory for the segment, unless BSS.
+         Resize (Sect, 8192);
+      end if;
+      if (Flags and Section_Strtab) /= 0 then
+         Sect.Align := 0;
+      end if;
+      if Section_Chain = null then
+         Section_Chain := Sect;
+      else
+         Section_Last.Next := Sect;
+      end if;
+      Section_Last := Sect;
+      Nbr_Sections := Nbr_Sections + 1;
+   end Create_Section;
+
+   procedure Sect_Prealloc (Sect : Section_Acc; L : Pc_Type)
+   is
+      New_Max : Pc_Type;
+   begin
+      if Sect.Pc + L < Sect.Data_Max then
+         return;
+      end if;
+      New_Max := Sect.Data_Max;
+      loop
+         New_Max := New_Max * 2;
+         exit when Sect.Pc + L < New_Max;
+      end loop;
+      Resize (Sect, New_Max);
+   end Sect_Prealloc;
+
+   procedure Merge_Section (Dest : Section_Acc; Src : Section_Acc)
+   is
+      Rel : Reloc_Acc;
+   begin
+      --  Sanity checks.
+      if Src = null or else Dest = Src then
+         raise Program_Error;
+      end if;
+
+      Rel := Src.First_Reloc;
+
+      if Rel /= null then
+         --  Move relocs.
+         if Dest.Last_Reloc = null then
+            Dest.First_Reloc := Rel;
+            Dest.Last_Reloc := Rel;
+         else
+            Dest.Last_Reloc.Sect_Next := Rel;
+            Dest.Last_Reloc := Rel;
+         end if;
+         Dest.Nbr_Relocs := Dest.Nbr_Relocs + Src.Nbr_Relocs;
+
+
+         --  Reloc reloc, since the pc has changed.
+         while Rel /= null loop
+            Rel.Addr := Rel.Addr + Dest.Pc;
+            Rel := Rel.Sect_Next;
+         end loop;
+      end if;
+
+      if Src.Pc > 0 then
+         Sect_Prealloc (Dest, Src.Pc);
+         Dest.Data (Dest.Pc .. Dest.Pc + Src.Pc - 1) :=
+           Src.Data (0 .. Src.Pc - 1);
+         Dest.Pc := Dest.Pc + Src.Pc;
+      end if;
+
+      Memsegs.Delete (Src.Seg);
+      Src.Pc := 0;
+      Src.Data_Max := 0;
+      Src.Data := null;
+      Src.First_Reloc := null;
+      Src.Last_Reloc := null;
+      Src.Nbr_Relocs := 0;
+
+      --  Remove from section_chain.
+      if Section_Chain = Src then
+         Section_Chain := Src.Next;
+      else
+         declare
+            Sect : Section_Acc;
+         begin
+            Sect := Section_Chain;
+            while Sect.Next /= Src loop
+               Sect := Sect.Next;
+            end loop;
+            Sect.Next := Src.Next;
+            if Section_Last = Src then
+               Section_Last := Sect;
+            end if;
+         end;
+      end if;
+      Nbr_Sections := Nbr_Sections - 1;
+   end Merge_Section;
+
+   procedure Set_Section_Info (Sect : Section_Acc;
+                               Link : Section_Acc;
+                               Align : Natural;
+                               Esize : Natural)
+   is
+   begin
+      Sect.Link := Link;
+      Sect.Align := Align;
+      Sect.Esize := Esize;
+   end Set_Section_Info;
+
+   procedure Set_Current_Section (Sect : Section_Acc) is
+   begin
+      --  If the current section does not change, this is a no-op.
+      if Cur_Sect = Sect then
+         return;
+      end if;
+
+      if Dump_Asm then
+         Put_Line (HT & ".section """ & Sect.Name.all & """");
+      end if;
+      Cur_Sect := Sect;
+   end Set_Current_Section;
+
+   function Get_Current_Pc return Pc_Type is
+   begin
+      return Cur_Sect.Pc;
+   end Get_Current_Pc;
+
+   function Get_Pc (Sect : Section_Acc) return Pc_Type is
+   begin
+      return Sect.Pc;
+   end Get_Pc;
+
+
+   procedure Prealloc (L : Pc_Type) is
+   begin
+      Sect_Prealloc (Cur_Sect, L);
+   end Prealloc;
+
+   procedure Start_Insn is
+   begin
+      --  Check there is enough memory for the next instruction.
+      Sect_Prealloc (Cur_Sect, 16);
+      if Cur_Sect.Insn_Pc /= 0 then
+         --  end_insn was not called.
+         raise Program_Error;
+      end if;
+      Cur_Sect.Insn_Pc := Cur_Sect.Pc;
+   end Start_Insn;
+
+   procedure Get_Symbol_At_Addr (Addr : System.Address;
+                                 Line : in out String;
+                                 Line_Len : in out Natural)
+   is
+      use System;
+      use System.Storage_Elements;
+      Off : Pc_Type;
+      Reloc : Reloc_Acc;
+   begin
+      --  Check if addr is in the current section.
+      if Addr < Cur_Sect.Data (0)'Address
+        or else Addr > Cur_Sect.Data (Cur_Sect.Pc)'Address
+      then
+         raise Program_Error;
+         --return;
+      end if;
+      Off := Pc_Type
+        (To_Integer (Addr) - To_Integer (Cur_Sect.Data (0)'Address));
+
+      --  Find a relocation at OFF.
+      Reloc := Cur_Sect.First_Reloc;
+      while Reloc /= null loop
+         if Reloc.Addr = Off then
+            declare
+               Str : constant String := Get_Symbol_Name (Reloc.Sym);
+            begin
+               Line (Line'First .. Line'First + Str'Length - 1) := Str;
+               Line_Len := Line_Len + Str'Length;
+               return;
+            end;
+         end if;
+         Reloc := Reloc.Sect_Next;
+      end loop;
+   end Get_Symbol_At_Addr;
+
+   procedure End_Insn
+   is
+      Str : String (1 .. 256);
+      Len : Natural;
+      Insn_Len : Natural;
+   begin
+      --if Insn_Pc = 0 then
+      --   --  start_insn was not called.
+      --   raise Program_Error;
+      --end if;
+      if Debug_Hex then
+         Put (HT);
+         Put ('#');
+         for I in Cur_Sect.Insn_Pc .. Cur_Sect.Pc - 1 loop
+            Put (' ');
+            Put (Hex_Image (Unsigned_8 (Cur_Sect.Data (I))));
+         end loop;
+         New_Line;
+      end if;
+
+      if Dump_Asm then
+         Disassemble.Disassemble_Insn
+           (Cur_Sect.Data (Cur_Sect.Insn_Pc)'Address,
+            Unsigned_32 (Cur_Sect.Insn_Pc),
+            Str, Len, Insn_Len,
+            Get_Symbol_At_Addr'Access);
+         Put (HT);
+         Put_Line (Str (1 .. Len));
+      end if;
+      --if Natural (Cur_Pc - Insn_Pc) /= Insn_Len then
+      --   raise Program_Error;
+      --end if;
+      Cur_Sect.Insn_Pc := 0;
+   end End_Insn;
+
+   procedure Gen_B8 (B : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := B;
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_B8;
+
+   procedure Gen_B16 (B0, B1 : Byte) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := B0;
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := B1;
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_B16;
+
+   procedure Gen_Le8 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc) := Byte (B and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 1;
+   end Gen_Le8;
+
+   procedure Gen_Le16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Le16;
+
+   procedure Gen_Be16 (B : Unsigned_32) is
+   begin
+      Cur_Sect.Data (Cur_Sect.Pc + 0) := Byte (Shift_Right (B, 8) and 16#Ff#);
+      Cur_Sect.Data (Cur_Sect.Pc + 1) := Byte (Shift_Right (B, 0) and 16#Ff#);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_Be16;
+
+   procedure Write_B8 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      Sect.Data (Pc) := Byte (V);
+   end Write_B8;
+
+   procedure Write_Be16 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be16;
+
+   procedure Write_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 0) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 24) and 16#Ff#);
+   end Write_Le32;
+
+   procedure Write_Be32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Sect.Data (Pc + 0) := Byte (Shift_Right (V, 24) and 16#Ff#);
+      Sect.Data (Pc + 1) := Byte (Shift_Right (V, 16) and 16#Ff#);
+      Sect.Data (Pc + 2) := Byte (Shift_Right (V, 8) and 16#Ff#);
+      Sect.Data (Pc + 3) := Byte (Shift_Right (V, 0) and 16#Ff#);
+   end Write_Be32;
+
+   procedure Write_16 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B2 is Byte_Array_Base (0 .. 1);
+      function To_B2 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_16, Target => B2);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 1) := To_B2 (Unsigned_16 (B));
+   end Write_16;
+
+   procedure Write_32 (Sect : Section_Acc; Pc : Pc_Type; B : Unsigned_32)
+   is
+      subtype B4 is Byte_Array_Base (0 .. 3);
+      function To_B4 is new Ada.Unchecked_Conversion
+        (Source => Unsigned_32, Target => B4);
+   begin
+      Sect.Data (Pc + 0 .. Pc + 3) := To_B4 (B);
+   end Write_32;
+
+   procedure Gen_16 (B : Unsigned_32) is
+   begin
+      Write_16 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 2;
+   end Gen_16;
+
+   procedure Gen_32 (B : Unsigned_32) is
+   begin
+      Write_32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_32;
+
+   function Read_Le32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 0)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 24);
+   end Read_Le32;
+
+   function Read_Be32 (Sect : Section_Acc; Pc : Pc_Type) return Unsigned_32 is
+   begin
+      return Shift_Left (Unsigned_32 (Sect.Data (Pc + 0)), 24)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 1)), 16)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 2)), 8)
+        or Shift_Left (Unsigned_32 (Sect.Data (Pc + 3)), 0);
+   end Read_Be32;
+
+   procedure Add_Le32 (Sect : Section_Acc; Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      Write_Le32 (Sect, Pc, V + Read_Le32 (Sect, Pc));
+   end Add_Le32;
+
+   procedure Patch_Le32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Le32 (Cur_Sect, Pc, V);
+   end Patch_Le32;
+
+   procedure Patch_Be32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be32 (Cur_Sect, Pc, V);
+   end Patch_Be32;
+
+   procedure Patch_Be16 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 2 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_Be16 (Cur_Sect, Pc, V);
+   end Patch_Be16;
+
+   procedure Patch_B8 (Pc : Pc_Type; V : Unsigned_8) is
+   begin
+      if Pc >= Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_B8 (Cur_Sect, Pc, V);
+   end Patch_B8;
+
+   procedure Patch_32 (Pc : Pc_Type; V : Unsigned_32) is
+   begin
+      if Pc + 4 > Get_Current_Pc then
+         raise Program_Error;
+      end if;
+      Write_32 (Cur_Sect, Pc, V);
+   end Patch_32;
+
+   procedure Gen_Le32 (B : Unsigned_32) is
+   begin
+      Write_Le32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Le32;
+
+   procedure Gen_Be32 (B : Unsigned_32) is
+   begin
+      Write_Be32 (Cur_Sect, Cur_Sect.Pc, B);
+      Cur_Sect.Pc := Cur_Sect.Pc + 4;
+   end Gen_Be32;
+
+   procedure Gen_Data_Le8 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".byte 0x" & Hex_Image (Unsigned_8 (B)));
+      end if;
+      Gen_Le8 (B);
+   end Gen_Data_Le8;
+
+   procedure Gen_Data_Le16 (B : Unsigned_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".half 0x" & Hex_Image (Unsigned_16 (B)));
+      end if;
+      Gen_Le16 (B);
+   end Gen_Data_Le16;
+
+   procedure Gen_Data_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Dump_Asm then
+         if Sym = Null_Symbol then
+            Put_Line (HT & ".word 0x" & Hex_Image (Offset));
+         else
+            if Offset = 0 then
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym));
+            else
+               Put_Line (HT & ".word " & Get_Symbol_Name (Sym) & " + "
+                         & Hex_Image (Offset));
+            end if;
+         end if;
+      end if;
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Data_32;
+
+   function Create_Symbol (Name : O_Ident) return Symbol
+   is
+   begin
+      Symbols.Append (Symbol_Type'(Section => null,
+                                   Value => 0,
+                                   Scope => Sym_Undef,
+                                   Used => False,
+                                   Name => Name,
+                                   Relocs => null,
+                                   Number => 0));
+      return Symbols.Last;
+   end Create_Symbol;
+
+   Last_Label : Natural := 1;
+
+   function Create_Local_Symbol return Symbol is
+   begin
+      Symbols.Append (Symbol_Type'(Section => Cur_Sect,
+                                   Value => 0,
+                                   Scope => Sym_Local,
+                                   Used => False,
+                                   Name => O_Ident_Nul,
+                                   Relocs => null,
+                                   Number => Last_Label));
+
+      Last_Label := Last_Label + 1;
+
+      return Symbols.Last;
+   end Create_Local_Symbol;
+
+   function Get_Symbol_Name (Sym : Symbol) return String
+   is
+      Res : String (1 .. 10);
+      N : Natural;
+      P : Natural;
+   begin
+      if S_Local (Sym) then
+         N := Get_Number (Sym);
+         P := Res'Last;
+         loop
+            Res (P) := Character'Val ((N mod 10) + Character'Pos ('0'));
+            N := N / 10;
+            P := P - 1;
+            exit when N = 0;
+         end loop;
+         Res (P) := 'L';
+         Res (P - 1) := '.';
+         return Res (P - 1 .. Res'Last);
+      else
+         if Is_Nul (Get_Name (Sym)) then
+            return "ANON";
+         else
+            return Get_String (Get_Name (Sym));
+         end if;
+      end if;
+   end Get_Symbol_Name;
+
+   function Get_Symbol_Name_Length (Sym : Symbol) return Natural
+   is
+      N : Natural;
+   begin
+      if S_Local (Sym) then
+         N := 10;
+         for I in 3 .. 8 loop
+            if Get_Number (Sym) < N then
+               return I;
+            end if;
+            N := N * 10;
+         end loop;
+         raise Program_Error;
+      else
+         return Get_String_Length (Get_Name (Sym));
+      end if;
+   end Get_Symbol_Name_Length;
+
+   function Get_Symbol (Name : String) return Symbol is
+   begin
+      for I in Symbols.First .. Symbols.Last loop
+         if Get_Symbol_Name (I) = Name then
+            return I;
+         end if;
+      end loop;
+      return Null_Symbol;
+   end Get_Symbol;
+
+   function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type
+   is
+      Tmp : Pc_Type;
+   begin
+      Tmp := V + 2 ** Align - 1;
+      return Tmp - (Tmp mod Pc_Type (2 ** Align));
+   end Pow_Align;
+
+   procedure Gen_Pow_Align (Align : Natural) is
+   begin
+      if Align = 0 then
+         return;
+      end if;
+      if Dump_Asm then
+         Put_Line (HT & ".align" & Natural'Image (Align));
+      end if;
+      Cur_Sect.Pc := Pow_Align (Cur_Sect.Pc, Align);
+   end Gen_Pow_Align;
+
+   --  Generate LENGTH bytes set to 0.
+   procedure Gen_Space (Length : Integer_32) is
+   begin
+      if Dump_Asm then
+         Put_Line (HT & ".space" & Integer_32'Image (Length));
+      end if;
+      Cur_Sect.Pc := Cur_Sect.Pc + Pc_Type (Length);
+   end Gen_Space;
+
+   procedure Set_Symbol_Pc (Sym : Symbol; Export : Boolean) is
+   begin
+      case Get_Scope (Sym) is
+         when Sym_Local =>
+            if Export then
+               raise Program_Error;
+            end if;
+         when Sym_Private
+           | Sym_Global =>
+            raise Program_Error;
+         when Sym_Undef =>
+            if Export then
+               Set_Scope (Sym, Sym_Global);
+            else
+               Set_Scope (Sym, Sym_Private);
+            end if;
+      end case;
+      --  Set value/section.
+      Set_Symbol_Value (Sym, Cur_Sect.Pc);
+      Set_Section (Sym, Cur_Sect);
+
+      if Dump_Asm then
+         if Export then
+            Put_Line (HT & ".globl " & Get_Symbol_Name (Sym));
+         end if;
+         Put (Get_Symbol_Name (Sym));
+         Put_Line (":");
+      end if;
+   end Set_Symbol_Pc;
+
+   procedure Add_Reloc (Sym : Symbol; Kind : Reloc_Kind)
+   is
+      Reloc : Reloc_Acc;
+   begin
+      Reloc := new Reloc_Type'(Kind => Kind,
+                               Done => False,
+                               Sym_Next => Get_Relocs (Sym),
+                               Sect_Next => null,
+                               Addr => Cur_Sect.Pc,
+                               Sym => Sym);
+      Set_Relocs (Sym, Reloc);
+      if Cur_Sect.First_Reloc = null then
+         Cur_Sect.First_Reloc := Reloc;
+      else
+         Cur_Sect.Last_Reloc.Sect_Next := Reloc;
+      end if;
+      Cur_Sect.Last_Reloc := Reloc;
+      Cur_Sect.Nbr_Relocs := Cur_Sect.Nbr_Relocs + 1;
+   end Add_Reloc;
+
+   procedure Gen_X86_Pc32 (Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Pc32);
+      Gen_Le32 (16#ff_ff_ff_fc#);
+   end Gen_X86_Pc32;
+
+   procedure Gen_Sparc_Disp22 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp22;
+
+   procedure Gen_Sparc_Disp30 (W : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Disp30);
+      Gen_Be32 (W);
+   end Gen_Sparc_Disp30;
+
+   procedure Gen_Sparc_Hi22 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Hi22);
+      Gen_Be32 (W);
+   end Gen_Sparc_Hi22;
+
+   procedure Gen_Sparc_Lo10 (W : Unsigned_32;
+                             Sym : Symbol; Off : Unsigned_32)
+   is
+      pragma Unreferenced (Off);
+   begin
+      Add_Reloc (Sym, Reloc_Lo10);
+      Gen_Be32 (W);
+   end Gen_Sparc_Lo10;
+
+   function Conv is new Ada.Unchecked_Conversion
+     (Source => Integer_32, Target => Unsigned_32);
+
+   procedure Gen_X86_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Le32 (Conv (Offset));
+   end Gen_X86_32;
+
+   procedure Gen_Sparc_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_32);
+      end if;
+      Gen_Be32 (Conv (Offset));
+   end Gen_Sparc_32;
+
+   procedure Gen_Sparc_Ua_32 (Sym : Symbol; Offset : Integer_32)
+   is
+      pragma Unreferenced (Offset);
+   begin
+      if Sym /= Null_Symbol then
+         Add_Reloc (Sym, Reloc_Ua_32);
+      end if;
+      Gen_Be32 (0);
+   end Gen_Sparc_Ua_32;
+
+   procedure Gen_Ua_32 (Sym : Symbol; Offset : Integer_32) is
+   begin
+      case Arch is
+         when Arch_X86 =>
+            Gen_X86_32 (Sym, Offset);
+         when Arch_Sparc =>
+            Gen_Sparc_Ua_32 (Sym, Offset);
+         when others =>
+            raise Program_Error;
+      end case;
+   end Gen_Ua_32;
+
+   procedure Gen_Ppc_24 (V : Unsigned_32; Sym : Symbol)
+   is
+   begin
+      Add_Reloc (Sym, Reloc_Ppc_Addr24);
+      Gen_32 (V);
+   end Gen_Ppc_24;
+
+   function Get_Symbol_Vaddr (Sym : Symbol) return Pc_Type is
+   begin
+      return Get_Section (Sym).Vaddr + Get_Symbol_Value (Sym);
+   end Get_Symbol_Vaddr;
+
+   procedure Write_Left_Be32 (Sect : Section_Acc;
+                              Addr : Pc_Type;
+                              Size : Natural;
+                              Val : Unsigned_32)
+   is
+      W : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      --  Write value.
+      Mask := Shift_Left (1, Size) - 1;
+      W := Read_Be32 (Sect, Addr);
+      Write_Be32 (Sect, Addr, (W and not Mask) or (Val and Mask));
+   end Write_Left_Be32;
+
+   procedure Set_Wdisp (Sect : Section_Acc;
+                        Addr : Pc_Type;
+                        Sym : Symbol;
+                        Size : Natural)
+   is
+      D : Unsigned_32;
+      Mask : Unsigned_32;
+   begin
+      D := Unsigned_32 (Get_Symbol_Vaddr (Sym) - (Sect.Vaddr + Addr));
+      --  Check overflow.
+      Mask := Shift_Left (1, Size + 2) - 1;
+      if (D and Shift_Left (1, Size + 1)) = 0 then
+         if (D and not Mask) /= 0 then
+            raise Program_Error;
+         end if;
+      else
+         if (D and not Mask) /= not Mask then
+            raise Program_Error;
+         end if;
+      end if;
+      --  Write value.
+      Write_Left_Be32 (Sect, Addr, Size, D / 4);
+   end Set_Wdisp;
+
+   procedure Do_Reloc (Kind : Reloc_Kind;
+                       Sect : Section_Acc; Addr : Pc_Type; Sym : Symbol)
+   is
+   begin
+      if Get_Scope (Sym) = Sym_Undef then
+         raise Program_Error;
+      end if;
+
+      case Kind is
+         when Reloc_32 =>
+            Add_Le32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+
+         when Reloc_Pc32 =>
+            Add_Le32 (Sect, Addr,
+                      Unsigned_32 (Get_Symbol_Vaddr (Sym)
+                                     - (Sect.Vaddr + Addr)));
+         when Reloc_Disp22 =>
+            Set_Wdisp (Sect, Addr, Sym, 22);
+         when Reloc_Disp30 =>
+            Set_Wdisp (Sect, Addr, Sym, 30);
+         when Reloc_Hi22 =>
+            Write_Left_Be32 (Sect, Addr, 22,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym) / 1024));
+         when Reloc_Lo10 =>
+            Write_Left_Be32 (Sect, Addr, 10,
+                             Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ua_32 =>
+            Write_Be32 (Sect, Addr, Unsigned_32 (Get_Symbol_Vaddr (Sym)));
+         when Reloc_Ppc_Addr24 =>
+            raise Program_Error;
+      end case;
+   end Do_Reloc;
+
+   function Is_Reloc_Relative (Reloc : Reloc_Acc) return Boolean is
+   begin
+      case Reloc.Kind is
+         when Reloc_Pc32
+           | Reloc_Disp22
+           | Reloc_Disp30 =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Reloc_Relative;
+
+   procedure Apply_Reloc (Sect : Section_Acc; Reloc : Reloc_Acc) is
+   begin
+      Do_Reloc (Reloc.Kind, Sect, Reloc.Addr, Reloc.Sym);
+   end Apply_Reloc;
+
+   procedure Do_Intra_Section_Reloc (Sect : Section_Acc)
+   is
+      Prev : Reloc_Acc;
+      Rel : Reloc_Acc;
+      Next : Reloc_Acc;
+   begin
+      Rel := Sect.First_Reloc;
+      Prev := null;
+      while Rel /= null loop
+         Next := Rel.Sect_Next;
+         if Get_Scope (Rel.Sym) /= Sym_Undef then
+            Do_Reloc (Rel.Kind, Sect, Rel.Addr, Rel.Sym);
+            Rel.Done := True;
+
+            if Get_Section (Rel.Sym) = Sect
+              and then Is_Reloc_Relative (Rel)
+            then
+               --  Remove reloc.
+               Sect.Nbr_Relocs := Sect.Nbr_Relocs - 1;
+               if Prev = null then
+                  Sect.First_Reloc := Next;
+               else
+                  Prev.Sect_Next := Next;
+               end if;
+               if Next = null then
+                  Sect.Last_Reloc := Prev;
+               end if;
+               Free (Rel);
+            else
+               Prev := Rel;
+            end if;
+         else
+            Set_Used (Rel.Sym, True);
+            Prev := Rel;
+         end if;
+         Rel := Next;
+      end loop;
+   end Do_Intra_Section_Reloc;
+
+   --  Return VAL rounded up to 2 ^ POW.
+--    function Align_Pow (Val : Integer; Pow : Natural) return Integer
+--    is
+--       N : Integer;
+--       Tmp : Integer;
+--    begin
+--       N := 2 ** Pow;
+--       Tmp := Val + N - 1;
+--       return Tmp - (Tmp mod N);
+--    end Align_Pow;
+
+   procedure Disp_Stats is
+   begin
+      Put_Line ("Number of Symbols: " & Symbol'Image (Symbols.Last));
+   end Disp_Stats;
+
+   procedure Finish
+   is
+      Sect : Section_Acc;
+      Rel, N_Rel : Reloc_Acc;
+   begin
+      Symbols.Free;
+      Sect := Section_Chain;
+      while Sect /= null loop
+         --  Free relocs.
+         Rel := Sect.First_Reloc;
+         while Rel /= null loop
+            N_Rel := Rel.Sect_Next;
+            Free (Rel);
+            Rel := N_Rel;
+         end loop;
+         Sect.First_Reloc := null;
+         Sect.Last_Reloc := null;
+
+         Sect := Sect.Next;
+      end loop;
+   end Finish;
+end Binary_File;