-- 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 Coff; use Coff;
package body Binary_File.Coff is
NUL : Character renames ASCII.NUL;
procedure Write (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;
end Binary_File.Coff;