diff options
| -rw-r--r-- | src/ortho/mcode/binary_file-macho.adb | 345 | ||||
| -rw-r--r-- | src/ortho/mcode/binary_file-macho.ads | 23 | ||||
| -rw-r--r-- | src/ortho/mcode/macho.ads | 103 |
3 files changed, 471 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; diff --git a/src/ortho/mcode/binary_file-macho.ads b/src/ortho/mcode/binary_file-macho.ads new file mode 100644 index 0000000..404327c --- /dev/null +++ b/src/ortho/mcode/binary_file-macho.ads @@ -0,0 +1,23 @@ +-- 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 GNAT.OS_Lib; + +package Binary_File.Macho is + procedure Write (Fd : GNAT.OS_Lib.File_Descriptor); +end Binary_File.Macho; + diff --git a/src/ortho/mcode/macho.ads b/src/ortho/mcode/macho.ads new file mode 100644 index 0000000..e080a43 --- /dev/null +++ b/src/ortho/mcode/macho.ads @@ -0,0 +1,103 @@ +-- Macho definitions. +-- 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 Interfaces; use Interfaces; +with System; use System; + +package Macho is + type Header_32 is record + Magic : Unsigned_32; + Cputype : Unsigned_32; + Cpusubtype : Unsigned_32; + Filetype : Unsigned_32; + Ncmds : Unsigned_32; + Sizeofcmds : Unsigned_32; + Flags : Unsigned_32; + end record; + + -- Size of Filehdr. + Header_32_Size : constant Natural := Header_32'Size / Storage_Unit; + + -- Magic numbers. + Magic : constant Unsigned_32 := 16#feed_face#; + Cputype_I386 : constant Unsigned_32 := 7; + Cpusubtype_I386_All : constant Unsigned_32 := 3; + + Mh_Object : constant Unsigned_32 := 1; + Mh_Execute : constant Unsigned_32 := 2; + + -- Load commands. + type Load_Command is record + Cmd : Unsigned_32; + Cmdsize : Unsigned_32; + end record; + Lc_Size : constant Natural := Load_Command'Size / Storage_Unit; + + Lc_Segment_32 : constant Unsigned_32 := 1; + type Segment_Command_32 is record + Segname : String (1 .. 16); + Vmaddr : Unsigned_32; + Vmsize : Unsigned_32; + Fileoff : Unsigned_32; + Filesize : Unsigned_32; + Maxprot : Unsigned_32; + Initprot : Unsigned_32; + Nsects : Unsigned_32; + Flags : Unsigned_32; + end record; + Segment_Command_32_Size : constant Natural := + Segment_Command_32'Size / Storage_Unit; + + type Section_32 is record + Sectname : String (1 .. 16); + Segname : String (1 .. 16); + Addr : Unsigned_32; + Size : Unsigned_32; + Offset : Unsigned_32; + Align : Unsigned_32; + Reloff : Unsigned_32; + Nreloc : Unsigned_32; + Flags : Unsigned_32; + Reserved1 : Unsigned_32; + Reserved2 : Unsigned_32; + end record; + Section_32_Size : constant Natural := Section_32'Size / Storage_Unit; + + Lc_Symtab : constant Unsigned_32 := 2; + type Symtab_Command is record + Symoff : Unsigned_32; + Nsyms : Unsigned_32; + Stroff : Unsigned_32; + Strsize : Unsigned_32; + end record; + Symtab_Command_Size : constant Natural := + Symtab_Command'Size / Storage_Unit; + + type Nlist_32 is record + N_Strx : Unsigned_32; + N_Type : Unsigned_8; + N_Sect : Unsigned_8; + N_Desc : Unsigned_16; + N_Value : Unsigned_32; + end record; + + Nlist_32_Size : constant Natural := Nlist_32'Size / Storage_Unit; + + N_Undf : constant Unsigned_8 := 16#00#; + N_Ext : constant Unsigned_8 := 16#01#; + N_Sect : constant Unsigned_8 := 16#0e#; +end Macho; |