diff options
Diffstat (limited to 'src/ortho/mcode/binary_file-macho.adb')
| -rw-r--r-- | src/ortho/mcode/binary_file-macho.adb | 345 |
1 files changed, 345 insertions, 0 deletions
diff --git a/src/ortho/mcode/binary_file-macho.adb b/src/ortho/mcode/binary_file-macho.adb new file mode 100644 index 0000000..dbfc882 --- /dev/null +++ b/src/ortho/mcode/binary_file-macho.adb @@ -0,0 +1,345 @@ +-- Binary file Mach-O writer. +-- Copyright (C) 2015 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 Macho; use Macho; + +package body Binary_File.Macho is + procedure Write (Fd : GNAT.OS_Lib.File_Descriptor) + is + use GNAT.OS_Lib; + + -- If true, discard local symbols; + Flag_Discard_Local : Boolean := True; + + procedure Xwrite (Data : System.Address; Len : Natural) is + begin + if Write (Fd, Data, Len) /= Len then + raise Write_Error; + end if; + end Xwrite; + + function Symbol_Discarded (S : Symbol) return Boolean is + begin + case Get_Scope (S) is + when Sym_Local => + if Flag_Discard_Local then + return True; + end if; + when Sym_Private => + null; + when Sym_Global => + null; + when Sym_Undef => + if not Get_Used (S) then + return True; + end if; + end case; + return False; + end Symbol_Discarded; + + procedure Fill_Name (Dest : out String; Src : String) + is + subtype D_Type is String (1 .. Dest'Length); + D : D_Type renames Dest; + subtype S_Type is String (1 .. Src'Length); + S : S_Type renames Src; + begin + if S'Length < D'Length then + D (1 .. S'Length) := S; + D (S'Length + 1 .. D'Last) := (others => ASCII.NUL); + else + D := S (1 .. D'Last); + end if; + end Fill_Name; + + type Section_Info_Type is record + Sect : Section_Acc; + -- Index of the section symbol (in symtab). + end record; + type Section_Info_Array is array (Natural range <>) of Section_Info_Type; + Sects_Info : Section_Info_Array (1 .. Nbr_Sections); + type Section_32_Array is array (Natural range <>) of Section_32; + Sects_Hdr : Section_32_Array (1 .. Nbr_Sections); + Nbr_Sect : Natural; + Sect : Section_Acc; + + -- Various offsets. + File_Offset : Natural; + Seg_Offset : Natural; + Symtab_Offset : Natural; + Strtab_Offset : Natural; + Sizeof_Cmds : Natural; + + -- Number of symtab entries. + Nbr_Symbols : Natural; + + Str_Size : Natural; + + -- If true, do local relocs. + Flag_Reloc : constant 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; + + -- Count sections. + Sect := Section_Chain; + Nbr_Sect := 0; + while Sect /= null loop + Nbr_Sect := Nbr_Sect + 1; + Sects_Info (Nbr_Sect).Sect := Sect; + Sect.Number := Nbr_Sect; + Sect := Sect.Next; + end loop; + + -- Set sections offset. + Sizeof_Cmds := Lc_Size + Segment_Command_32_Size + + Nbr_Sect * Section_32_Size + + Lc_Size + Symtab_Command_Size; + File_Offset := Header_32_Size + Sizeof_Cmds; + Seg_Offset := File_Offset; + for I in 1 .. Nbr_Sect loop + Sect := Sects_Info (I).Sect; + if Sect.Data /= null then + -- FIXME: alignment ? + Sects_Hdr (I).Offset := Unsigned_32 (File_Offset); + File_Offset := File_Offset + Natural (Sect.Pc); + else + Sects_Hdr (I).Offset := 0; + end if; + end loop; + + -- Relocs + -- FIXME: todo. + + Symtab_Offset := File_Offset; + Str_Size := 0; + Nbr_Symbols := 0; + for I in Symbols.First .. Symbols.Last loop + if not Symbol_Discarded (I) then + Nbr_Symbols := Nbr_Symbols + 1; + Set_Number (I, Nbr_Symbols); + Str_Size := Str_Size + Get_Symbol_Name_Length (I) + 1; + else + Set_Number (I, 0); + end if; + end loop; + + File_Offset := File_Offset + Nbr_Symbols * Nlist_32_Size; + Strtab_Offset := File_Offset; + + -- Write file header. + declare + Hdr : Header_32; + begin + Hdr := (Magic => Magic, + Cputype => Cputype_I386, + Cpusubtype => Cpusubtype_I386_All, + Filetype => Mh_Object, + Ncmds => 2, + Sizeofcmds => Unsigned_32 (Sizeof_Cmds), + Flags => 0); + Xwrite (Hdr'Address, Header_32_Size); + end; + + -- Write segment and section commands. + declare + Lc : Load_Command; + Seg : Segment_Command_32; + begin + Lc := (Cmd => Lc_Segment_32, + Cmdsize => Unsigned_32 (Lc_Size + Segment_Command_32_Size + + Nbr_Sect * Section_32_Size)); + Xwrite (Lc'Address, Lc_Size); + Seg := (Segname => (others => ASCII.NUL), + Vmaddr => 0, + Vmsize => 0, -- FIXME + Fileoff => Unsigned_32 (Seg_Offset), + Filesize => Unsigned_32 (Symtab_Offset - Seg_Offset), + Maxprot => 7, -- rwx + Initprot => 7, + Nsects => Unsigned_32 (Nbr_Sect), + Flags => 0); + Xwrite (Seg'Address, Segment_Command_32_Size); + end; + + -- Write section headers. + for I in 1 .. Nbr_Sect loop + Sect := Sects_Info (I).Sect; + declare + Hdr : Section_32 renames Sects_Hdr (I); + Secname_Raw : constant String := Sect.Name.all; + subtype S_Type is String (1 .. Secname_Raw'Length); + Secname : S_Type renames Secname_Raw; + begin + if Secname = ".text" then + Fill_Name (Hdr.Sectname, "__text"); + Fill_Name (Hdr.Segname, "__TEXT"); + elsif Secname = ".rodata" then + Fill_Name (Hdr.Sectname, "__const"); + Fill_Name (Hdr.Segname, "__TEXT"); + elsif (Sect.Flags and Section_Debug) /= 0 then + if Secname'Length > 7 + and then Secname (1 .. 7) = ".debug_" + then + Fill_Name (Hdr.Sectname, + "__debug_" & Secname (8 .. Secname'Last)); + else + Fill_Name (Hdr.Sectname, Sect.Name.all); + end if; + Fill_Name (Hdr.Segname, "__DWARF"); + else + Fill_Name (Hdr.Sectname, Secname); + Fill_Name (Hdr.Segname, ""); + end if; + Hdr.Addr := Unsigned_32 (Sect.Vaddr); + Hdr.Size := Unsigned_32 (Sect.Pc); + Hdr.Align := Unsigned_32 (Sect.Align); + Hdr.Reloff := 0; + Hdr.Nreloc := 0; + Hdr.Flags := 0; + Hdr.Reserved1 := 0; + Hdr.Reserved2 := 0; + Xwrite (Hdr'Address, Section_32_Size); + end; + end loop; + + -- Write symtab command + declare + Lc : Load_Command; + Symtab : Symtab_Command; + begin + Lc := (Cmd => Lc_Symtab, + Cmdsize => Unsigned_32 (Lc_Size + Symtab_Command_Size)); + Xwrite (Lc'Address, Lc_Size); + Symtab := (Symoff => Unsigned_32 (Symtab_Offset), + Nsyms => Unsigned_32 (Nbr_Symbols), + Stroff => Unsigned_32 (Strtab_Offset), + Strsize => Unsigned_32 (Str_Size)); + Xwrite (Symtab'Address, Symtab_Command_Size); + end; + + -- Write sections content. + for I in 1 .. Nbr_Sect loop + Sect := Sects_Info (I).Sect; + if Sect.Data /= null then + Xwrite (Sect.Data (0)'Address, Natural (Sect.Pc)); + end if; + end loop; + + -- FIXME: write relocs. + + -- Write symbols. + declare + Str_Offset : Natural; + + generic + with procedure Handle (S : Symbol); + procedure Foreach_Symbol; + + procedure Foreach_Symbol is + begin + -- First, the local and private symbols. + for I in Symbols.First .. Symbols.Last loop + case Get_Scope (I) is + when Sym_Local => + if not Flag_Discard_Local then + Handle (I); + end if; + when Sym_Private => + Handle (I); + when Sym_Global + | Sym_Undef => + null; + end case; + end loop; + + -- Then global symbols + for I in Symbols.First .. Symbols.Last loop + case Get_Scope (I) is + when Sym_Local + | Sym_Private => + null; + when Sym_Global => + Handle (I); + when Sym_Undef => + null; + end case; + end loop; + -- Then undef symbols. + for I in Symbols.First .. Symbols.Last loop + case Get_Scope (I) is + when Sym_Local + | Sym_Private => + null; + when Sym_Global => + null; + when Sym_Undef => + if Get_Used (I) then + Handle (I); + end if; + end case; + end loop; + end Foreach_Symbol; + + procedure Write_Symbol (S : Symbol) + is + Sym : Nlist_32; + begin + Sym := (N_Strx => Unsigned_32 (Str_Offset), + N_Type => 0, + N_Sect => 0, + N_Desc => 0, + N_Value => Unsigned_32 (Get_Symbol_Value (S))); + Str_Offset := Str_Offset + Get_Symbol_Name_Length (S) + 1; + if Get_Scope (S) = Sym_Undef then + Sym.N_Type := N_Undf; + else + if Get_Scope (S) = Sym_Global then + Sym.N_Type := N_Sect + N_Ext; + else + Sym.N_Type := N_Sect; + end if; + Sym.N_Sect := Unsigned_8 (Get_Section (S).Number); + Sym.N_Value := + Sym.N_Value + Unsigned_32 (Get_Section (S).Vaddr); + end if; + Xwrite (Sym'Address, Nlist_32_Size); + end Write_Symbol; + + procedure Write_String (Sym : Symbol) + is + Str : constant String := Get_Symbol_Name (Sym) & ASCII.NUL; + begin + Xwrite (Str'Address, Str'Length); + end Write_String; + + procedure Write_All_Symbols is new + Foreach_Symbol (Write_Symbol); + procedure Write_All_Strings is new + Foreach_Symbol (Write_String); + begin + Str_Offset := 0; + + Write_All_Symbols; + Write_All_Strings; + end; + end Write; + +end Binary_File.Macho; |