diff options
Diffstat (limited to 'ortho/mcode/binary_file-coff.adb')
| -rw-r--r-- | ortho/mcode/binary_file-coff.adb | 407 |
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; |