ortho/mcode: handle x86-64 coff image dump (WIP)

3 files changed, 31 insertions, 24 deletions

diff --git a/src/ortho/mcode/binary_file-coff.adb b/src/ortho/mcode/binary_file-coff.adb
index 7ac96e76a..4c8f946aa 100644
--- a/src/ortho/mcode/binary_file-coff.adb
+++ b/src/ortho/mcode/binary_file-coff.adb
@@ -181,7 +181,11 @@ package body Binary_File.Coff is
       declare
          Hdr : Filehdr;
       begin
-         Hdr.F_Magic := I386magic;
+         if Arch = Arch_X86_64 then
+            Hdr.F_Magic := X8664magic;
+         else
+            Hdr.F_Magic := I386magic;
+         end if;
          Hdr.F_Nscns := Unsigned_16 (Nbr_Sect);
          Hdr.F_Timdat := 0;
          Hdr.F_Symptr := Unsigned_32 (Symtab_Offset);
@@ -207,6 +211,7 @@ package body Binary_File.Coff is
                   Hdr.S_Flags := 0;
                   L := Sections (I).Sect.Name'Length;
                   if L > Hdr.S_Name'Length then
+                     --  Truncate long sectio names
                      Hdr.S_Name := Sections (I).Sect.Name
                        (Sections (I).Sect.Name'First ..
                         Sections (I).Sect.Name'First + Hdr.S_Name'Length - 1);
@@ -324,7 +329,8 @@ package body Binary_File.Coff is
             Sym : Syment;
          begin
             Sym := (E => Gen_String (Get_Symbol_Name (S)),
-                    E_Value => Unsigned_32 (Get_Symbol_Value (S)),
+                    E_Value => Unsigned_32
+                       (Get_Symbol_Value (S) and 16#ffff_ffff#),
                     E_Scnum => 0,
                     E_Type => 0,
                     E_Sclass => C_EXT,
diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads
index 423f6b153..c3f829d70 100644
--- a/src/ortho/mcode/binary_file.ads
+++ b/src/ortho/mcode/binary_file.ads
@@ -67,7 +67,7 @@ package Binary_File is
    --  Set the current section.
    procedure Set_Current_Section (Sect : Section_Acc);
 
-   --  Create an undefined local (anonymous) symbol in the  current section.
+   --  Create an undefined local (anonymous) symbol in the current section.
    function Create_Local_Symbol return Symbol;
    function Create_Symbol (Name : O_Ident; Code : Boolean) return Symbol;
 
diff --git a/src/ortho/mcode/coff.ads b/src/ortho/mcode/coff.ads
index 41755f242..e2696b603 100644
--- a/src/ortho/mcode/coff.ads
+++ b/src/ortho/mcode/coff.ads
@@ -18,20 +18,21 @@ with System; use System;
 
 package Coff is
    type Filehdr is record
-      F_Magic : Unsigned_16;    --  Magic number.
-      F_Nscns : Unsigned_16;    --  Number of sections.
-      F_Timdat : Unsigned_32;   --  Time and date stamp.
-      F_Symptr : Unsigned_32;   --  File pointer to symtab.
-      F_Nsyms : Unsigned_32;    --  Number of symtab entries.
-      F_Opthdr : Unsigned_16;   --  Size of optionnal header.
-      F_Flags : Unsigned_16;    --  Flags;
+      F_Magic  : Unsigned_16;    --  Magic number.
+      F_Nscns  : Unsigned_16;    --  Number of sections.
+      F_Timdat : Unsigned_32;    --  Time and date stamp.
+      F_Symptr : Unsigned_32;    --  File pointer to symtab.
+      F_Nsyms  : Unsigned_32;    --  Number of symtab entries.
+      F_Opthdr : Unsigned_16;    --  Size of optionnal header.
+      F_Flags  : Unsigned_16;    --  Flags;
    end record;
 
    --  Size of Filehdr.
    Filehdr_Size : constant Natural := Filehdr'Size / Storage_Unit;
 
    --  Magic numbers.
-   I386magic : constant Unsigned_16 := 16#014c#;
+   I386magic  : constant Unsigned_16 := 16#014c#;
+   X8664magic : constant Unsigned_16 := 16#8664#;
 
    --  Flags of file header.
    --  Relocation info stripped from file.
@@ -47,16 +48,16 @@ package Coff is
    F_Lsyms : constant Unsigned_16 := 16#0008#;
 
    type Scnhdr is record
-      S_Name : String (1 .. 8); --  Section name.
-      S_Paddr : Unsigned_32;    --  Physical address.
-      S_Vaddr : Unsigned_32;    --  Virtual address.
-      S_Size : Unsigned_32;     --  Section size.
-      S_Scnptr : Unsigned_32;   --  File pointer to raw section data.
-      S_Relptr : Unsigned_32;   --  File pointer to relocation data.
+      S_Name    : String (1 .. 8); --  Section name.
+      S_Paddr   : Unsigned_32;    --  Physical address.
+      S_Vaddr   : Unsigned_32;    --  Virtual address.
+      S_Size    : Unsigned_32;     --  Section size.
+      S_Scnptr  : Unsigned_32;   --  File pointer to raw section data.
+      S_Relptr  : Unsigned_32;   --  File pointer to relocation data.
       S_Lnnoptr : Unsigned_32;  --  File pointer to line number data.
-      S_Nreloc : Unsigned_16;   --  Number of relocation entries.
-      S_Nlnno : Unsigned_16;    --  Number of line number entries.
-      S_Flags : Unsigned_32;    --  Flags.
+      S_Nreloc  : Unsigned_16;   --  Number of relocation entries.
+      S_Nlnno   : Unsigned_16;    --  Number of line number entries.
+      S_Flags   : Unsigned_32;    --  Flags.
    end record;
    Scnhdr_Size : constant Natural := Scnhdr'Size / Storage_Unit;
 
@@ -84,10 +85,10 @@ package Coff is
    for Sym_Name'Size use 64;
 
    type Syment is record
-      E : Sym_Name;             --  Name of the symbol
-      E_Value : Unsigned_32;    --  Value
-      E_Scnum : Unsigned_16;    --  Section
-      E_Type : Unsigned_16;
+      E        : Sym_Name;       --  Name of the symbol
+      E_Value  : Unsigned_32;    --  Value
+      E_Scnum  : Unsigned_16;    --  Section
+      E_Type   : Unsigned_16;
       E_Sclass : Unsigned_8;
       E_Numaux : Unsigned_8;
    end record;