-- 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 : 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;