Move sources to src/ subdirectory.

1 files changed, 0 insertions, 407 deletions

diff --git a/ortho/mcode/binary_file-coff.adb b/ortho/mcode/binary_file-coff.adb
deleted file mode 100644
index cf3cba3..0000000
--- a/ortho/mcode/binary_file-coff.adb
+++ /dev/null
@@ -1,407 +0,0 @@
---  Binary file COFF writer.
---  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 Ada.Characters.Latin_1;
-with Coff; use Coff;
-
-package body Binary_File.Coff is
-   NUL : Character renames Ada.Characters.Latin_1.NUL;
-
-   procedure Write_Coff (Fd : GNAT.OS_Lib.File_Descriptor)
-   is
-      use GNAT.OS_Lib;
-
-      procedure Xwrite (Data : System.Address; Len : Natural) is
-      begin
-         if Write (Fd, Data, Len) /= Len then
-            raise Write_Error;
-         end if;
-      end Xwrite;
-
-      type Section_Info_Type is record
-         Sect : Section_Acc;
-         --  File offset for the data.
-         Data_Offset : Natural;
-         --  File offset for the relocs.
-         Reloc_Offset : Natural;
-         --  Number of relocs to write.
-         Nbr_Relocs : Natural;
-      end record;
-      type Section_Info_Array is array (Natural range <>) of Section_Info_Type;
-      Sections : Section_Info_Array (1 .. Nbr_Sections + 3);
-      Nbr_Sect : Natural;
-      Sect_Text : constant Natural := 1;
-      Sect_Data : constant Natural := 2;
-      Sect_Bss : constant Natural := 3;
-      Sect : Section_Acc;
-
-      --Section_Align : constant Natural := 2;
-
-      Offset : Natural;
-      Symtab_Offset : Natural;
-      --  Number of symtab entries.
-      Nbr_Symbols : Natural;
-      Strtab_Offset : Natural;
-
-      function Gen_String (Str : String) return Sym_Name
-      is
-         Res : Sym_Name;
-      begin
-         if Str'Length <= 8 then
-            Res.E_Name := (others => NUL);
-            Res.E_Name (1 .. Str'Length) := Str;
-         else
-            Res.E := (E_Zeroes => 0, E_Offset => Unsigned_32 (Offset));
-            Offset := Offset + Str'Length + 1;
-         end if;
-         return Res;
-      end Gen_String;
-
-      --  Well known sections name.
-      type String_Array is array (Sect_Text .. Sect_Bss) of String (1 .. 8);
-      Sect_Name : constant String_Array :=
-        (Sect_Text => ".text" & NUL & NUL & NUL,
-         Sect_Data => ".data" & NUL & NUL & NUL,
-         Sect_Bss => ".bss" & NUL & NUL & NUL & NUL);
-      type Unsigned32_Array is array (Sect_Text .. Sect_Bss) of Unsigned_32;
-      Sect_Flags : constant Unsigned32_Array :=
-        (Sect_Text => STYP_TEXT,
-         Sect_Data => STYP_DATA,
-         Sect_Bss => STYP_BSS);
-
-      --  If true, do local relocs.
-      Flag_Reloc : constant Boolean := True;
-      --  If true, discard local symbols;
-      Flag_Discard_Local : Boolean := True;
-   begin
-      --  If relocations are not performs, then local symbols cannot be
-      --  discarded.
-      if not Flag_Reloc then
-         Flag_Discard_Local := False;
-      end if;
-
-      --  Fill sections.
-      Sect := Section_Chain;
-      Nbr_Sect := 3;
-      declare
-         N : Natural;
-      begin
-         while Sect /= null loop
-            if Sect.Name.all = ".text" then
-               N := Sect_Text;
-            elsif Sect.Name.all = ".data" then
-               N := Sect_Data;
-            elsif Sect.Name.all = ".bss" then
-               N := Sect_Bss;
-            else
-               Nbr_Sect := Nbr_Sect + 1;
-               N := Nbr_Sect;
-            end if;
-            Sections (N).Sect := Sect;
-            Sect.Number := N;
-            Sect := Sect.Next;
-         end loop;
-      end;
-
-      --  Set data offset.
-      Offset := Filehdr_Size + Nbr_Sect * Scnhdr_Size;
-      for I in 1 .. Nbr_Sect loop
-         if Sections (I).Sect /= null
-           and then Sections (I).Sect.Data /= null
-         then
-            Sections (I).Data_Offset := Offset;
-            Offset := Offset + Natural (Sections (I).Sect.Pc);
-         else
-            Sections (I).Data_Offset := 0;
-         end if;
-      end loop;
-
-      --  Set relocs offset.
-      declare
-         Rel : Reloc_Acc;
-      begin
-         for I in 1 .. Nbr_Sect loop
-            Sections (I).Nbr_Relocs := 0;
-            if Sections (I).Sect /= null then
-               Sections (I).Reloc_Offset := Offset;
-               if not Flag_Reloc then
-                  --  Do local relocations.
-                  Rel := Sections (I).Sect.First_Reloc;
-                  while Rel /= null loop
-                     if S_Local (Rel.Sym) then
-                        if Get_Section (Rel.Sym) = Sections (I).Sect
-                        then
-                           --  Intra section local reloc.
-                           Apply_Reloc (Sections (I).Sect, Rel);
-                        else
-                           --  Inter section local reloc.
-                           --  A relocation is still required.
-                           Sections (I).Nbr_Relocs :=
-                             Sections (I).Nbr_Relocs + 1;
-                           --  FIXME: todo.
-                           raise Program_Error;
-                        end if;
-                     else
-                        Sections (I).Nbr_Relocs := Sections (I).Nbr_Relocs + 1;
-                     end if;
-                     Rel := Rel.Sect_Next;
-                  end loop;
-               else
-                  Sections (I).Nbr_Relocs := Sections (I).Sect.Nbr_Relocs;
-               end if;
-               Offset := Offset + Sections (I).Nbr_Relocs * Relsz;
-            else
-               Sections (I).Reloc_Offset := 0;
-            end if;
-         end loop;
-      end;
-
-      Symtab_Offset := Offset;
-      Nbr_Symbols := 2 + Nbr_Sect * 2; --  2 for file.
-      for I in Symbols.First .. Symbols.Last loop
-         Set_Number (I, Nbr_Symbols);
-         Nbr_Symbols := Nbr_Symbols + 1;
-      end loop;
-      Offset := Offset + Nbr_Symbols * Symesz;
-      Strtab_Offset := Offset;
-      Offset := Offset + 4;
-
-      --  Write file header.
-      declare
-         Hdr : Filehdr;
-      begin
-         Hdr.F_Magic := I386magic;
-         Hdr.F_Nscns := Unsigned_16 (Nbr_Sect);
-         Hdr.F_Timdat := 0;
-         Hdr.F_Symptr := Unsigned_32 (Symtab_Offset);
-         Hdr.F_Nsyms := Unsigned_32 (Nbr_Symbols);
-         Hdr.F_Opthdr := 0;
-         Hdr.F_Flags := F_Lnno;
-         Xwrite (Hdr'Address, Filehdr_Size);
-      end;
-
-      --  Write sections header.
-      for I in 1 .. Nbr_Sect loop
-         declare
-            Hdr : Scnhdr;
-            L : Natural;
-         begin
-            case I is
-               when Sect_Text
-                 | Sect_Data
-                 | Sect_Bss =>
-                  Hdr.S_Name := Sect_Name (I);
-                  Hdr.S_Flags := Sect_Flags (I);
-               when others =>
-                  Hdr.S_Flags := 0;
-                  L := Sections (I).Sect.Name'Length;
-                  if L > Hdr.S_Name'Length then
-                     Hdr.S_Name := Sections (I).Sect.Name
-                       (Sections (I).Sect.Name'First ..
-                        Sections (I).Sect.Name'First + Hdr.S_Name'Length - 1);
-                  else
-                     Hdr.S_Name (1 .. L) := Sections (I).Sect.Name.all;
-                     Hdr.S_Name (L + 1 .. Hdr.S_Name'Last) := (others => NUL);
-                  end if;
-            end case;
-            Hdr.S_Paddr := 0;
-            Hdr.S_Vaddr := 0;
-            Hdr.S_Scnptr := Unsigned_32 (Sections (I).Data_Offset);
-            Hdr.S_Relptr := Unsigned_32 (Sections (I).Reloc_Offset);
-            Hdr.S_Lnnoptr := 0;
-            Hdr.S_Nreloc := Unsigned_16 (Sections (I).Nbr_Relocs);
-            if Sections (I).Sect /= null then
-               Hdr.S_Size := Unsigned_32 (Sections (I).Sect.Pc);
-            else
-               Hdr.S_Size := 0;
-            end if;
-            Hdr.S_Nlnno := 0;
-            Xwrite (Hdr'Address, Scnhdr_Size);
-         end;
-      end loop;
-
-      --  Write sections content.
-      for I in 1 .. Nbr_Sect loop
-         if Sections (I).Sect /= null
-           and then Sections (I).Sect.Data /= null
-         then
-            Xwrite (Sections (I).Sect.Data (0)'Address,
-                    Natural (Sections (I).Sect.Pc));
-         end if;
-      end loop;
-
-      --  Write sections reloc.
-      for I in 1 .. Nbr_Sect loop
-         if Sections (I).Sect /= null then
-            declare
-               R : Reloc_Acc;
-               Rel : Reloc;
-            begin
-               R := Sections (I).Sect.First_Reloc;
-               while R /= null loop
-                  case R.Kind is
-                     when Reloc_32 =>
-                        Rel.R_Type := Reloc_Addr32;
-                     when Reloc_Pc32 =>
-                        Rel.R_Type := Reloc_Rel32;
-                     when others =>
-                        raise Program_Error;
-                  end case;
-                  Rel.R_Vaddr := Unsigned_32 (R.Addr);
-                  Rel.R_Symndx := Unsigned_32 (Get_Number (R.Sym));
-                  Xwrite (Rel'Address, Relsz);
-                  R := R.Sect_Next;
-               end loop;
-            end;
-         end if;
-      end loop;
-
-      --  Write symtab.
-      --   Write file symbol + aux
-      declare
-         Sym : Syment;
-         A_File : Auxent_File;
-      begin
-         Sym := (E => (Inline => True,
-                       E_Name => ".file" & NUL & NUL & NUL),
-                 E_Value => 0,
-                 E_Scnum => N_DEBUG,
-                 E_Type => 0,
-                 E_Sclass => C_FILE,
-                 E_Numaux => 1);
-         Xwrite (Sym'Address, Symesz);
-         A_File := (Inline => True,
-                    X_Fname => "testfile.xxxxx");
-         Xwrite (A_File'Address, Symesz);
-      end;
-      --   Write sections symbol + aux
-      for I in 1 .. Nbr_Sect loop
-         declare
-            A_Scn : Auxent_Scn;
-            Sym : Syment;
-         begin
-            Sym := (E => (Inline => True, E_Name => (others => NUL)),
-                    E_Value => 0,
-                    E_Scnum => Unsigned_16 (I),
-                    E_Type => 0,
-                    E_Sclass => C_STAT,
-                    E_Numaux => 1);
-            if I <= Sect_Bss then
-               Sym.E.E_Name := Sect_Name (I);
-            else
-               Sym.E := Gen_String (Sections (I).Sect.Name.all);
-            end if;
-            Xwrite (Sym'Address, Symesz);
-            if Sections (I).Sect /= null
-              and then Sections (I).Sect.Data /= null
-            then
-               A_Scn :=
-                 (X_Scnlen => Unsigned_32 (Sections (I).Sect.Pc),
-                  X_Nreloc => Unsigned_16 (Sections (I).Nbr_Relocs),
-                  X_Nlinno => 0);
-            else
-               A_Scn := (X_Scnlen => 0, X_Nreloc => 0, X_Nlinno => 0);
-            end if;
-            Xwrite (A_Scn'Address, Symesz);
-         end;
-      end loop;
-
-      --   Write symbols.
-      declare
-         procedure Write_Symbol (S : Symbol)
-         is
-            Sym : Syment;
-         begin
-            Sym := (E => Gen_String (Get_Symbol_Name (S)),
-                    E_Value => Unsigned_32 (Get_Symbol_Value (S)),
-                    E_Scnum => 0,
-                    E_Type => 0,
-                    E_Sclass => C_EXT,
-                    E_Numaux => 0);
-            case Get_Scope (S) is
-               when Sym_Local
-                 | Sym_Private =>
-                  Sym.E_Sclass := C_STAT;
-               when Sym_Undef
-                 | Sym_Global =>
-                  Sym.E_Sclass := C_EXT;
-            end case;
-            if Get_Section (S) /= null then
-               Sym.E_Scnum := Unsigned_16 (Get_Section (S).Number);
-            end if;
-            Xwrite (Sym'Address, Symesz);
-         end Write_Symbol;
-      begin
-         --  First the non-local symbols (1).
-         for I in Symbols.First .. Symbols.Last loop
-            if Get_Scope (I) in Symbol_Scope_External then
-               Write_Symbol (I);
-            end if;
-         end loop;
-         --  Then the local symbols (2).
-         if not Flag_Discard_Local then
-            for I in Symbols.First .. Symbols.Last loop
-               if Get_Scope (I) not in Symbol_Scope_External then
-                  Write_Symbol (I);
-               end if;
-            end loop;
-         end if;
-      end;
-
-      --  Write strtab.
-      --    Write strtab length.
-      declare
-         L : Unsigned_32;
-
-         procedure Write_String (Str : String) is
-         begin
-            if Str (Str'Last) /= NUL then
-               raise Program_Error;
-            end if;
-            if Str'Length <= 9 then
-               return;
-            end if;
-            Xwrite (Str'Address, Str'Length);
-            Strtab_Offset := Strtab_Offset + Str'Length;
-         end Write_String;
-      begin
-         L := Unsigned_32 (Offset - Strtab_Offset);
-         Xwrite (L'Address, 4);
-
-         --  Write section name string.
-         for I in Sect_Bss + 1 .. Nbr_Sect loop
-            if Sections (I).Sect /= null
-              and then Sections (I).Sect.Name'Length > 8
-            then
-               Write_String (Sections (I).Sect.Name.all & NUL);
-            end if;
-         end loop;
-
-         for I in Symbols.First .. Symbols.Last loop
-            declare
-               Str : constant String := Get_Symbol_Name (I);
-            begin
-               Write_String (Str & NUL);
-            end;
-         end loop;
-         if Strtab_Offset + 4 /= Offset then
-            raise Program_Error;
-         end if;
-      end;
-   end Write_Coff;
-
-end Binary_File.Coff;