DataMuseum.dk

top - download

    Length: 5243 (0x147b)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦4c85d69e2⟧ 
                └─⟦this⟧ 

TextFile

with System;
with Unchecked_Conversion;


package body Debug_Tools is

    type Address is new Integer range -2 ** 31 .. 2 ** 31 - 1;

    type Word is range 0 .. 65535;
    for Word'Size use 16;


    Hex_Digits : array (0 .. 15) of Character :=
       ('0', '1', '2', '3', '4', '5', '6', '7',
        '8', '9', 'A', 'B', 'C', 'E', 'E', 'F');

    function Get_Current_Task_Id return Address;

    pragma Suppress (Elaboration_Check, Get_Current_Task_Id);
    pragma Interface (Asm, Get_Current_Task_Id);
    pragma Import_Function (Get_Current_Task_Id, "__GET_CURRENT_TASK_ID");

    function Get_Frame_Pointer return Address;
    pragma Interface (Asm, Get_Frame_Pointer);
    pragma Import_Function (Internal => Get_Frame_Pointer,
                            External => "__GET_FP");


    function Get_Exception_Addr (Task_Name : Address) return Address;
    pragma Interface (Asm, Get_Exception_Addr);
    pragma Import_Function (Internal  => Get_Exception_Addr,
                            External  => "__GET_EXC_ADDR",
                            Mechanism => (Value));


    function Hex_Image (Addr : Address) return String is
        Image : String (1 .. 9) := String'(1 => '#', 2 .. 9 => ' ');
        Digit : Integer;
        Temp  : Integer         := Integer (Addr);
    begin
        for I in reverse 1 .. 8 loop
            Digit         := Temp mod 2 ** 4;
            Temp          := (Temp - Digit) / 2 ** 4;
            Image (I + 1) := Hex_Digits (Digit);
        end loop;  
        return Image;
    end Hex_Image;


    function Read_Address (Source : Address) return Address is

        type Memory_Access is access Address;
        for Memory_Access'Storage_Size use 0;

        function Address_To_Access is
           new Unchecked_Conversion (Source => Address,
                                     Target => Memory_Access);

        Mem : Memory_Access := Address_To_Access (Source);
    begin
        return Mem.all;
    end Read_Address;


    procedure Debug_On is
    begin
        null;
    end Debug_On;

    procedure Debug_Off is
    begin
        null;
    end Debug_Off;

    function Debugging return Boolean is
    begin
        return False;
    end Debugging;

    procedure Message (Info : String) is
    begin
        null;
    end Message;

    procedure User_Break (Info : String) is
    begin
        null;
    end User_Break;

    procedure Set_Task_Name (Name : String) is
    begin
        null;
    end Set_Task_Name;

    function Get_Machine_Location (Frame_Number : Natural) return String is
        Frame_Pointer : Address;
        Pc            : Address;
    begin

        Frame_Pointer := Get_Frame_Pointer;

        for I in 1 .. Frame_Number + 1 loop
            Frame_Pointer := Read_Address (Frame_Pointer);
        end loop;

        Pc := Read_Address (Frame_Pointer + 8);

        return Hex_Image (Pc);
    end Get_Machine_Location;

    function Get_Task_Name return String is
    begin
        return Hex_Image (Get_Current_Task_Id);  
    exception
        when others =>
            return "Internal Error: Debug_Tools.Get_Task_Name";
    end Get_Task_Name;

    function Ada_Location (Frame_Number  : Natural := 0;
                           Fully_Qualify : Boolean := True;
                           Machine_Info  : Boolean := False) return String is
    begin
        return Get_Machine_Location (Frame_Number);  
    exception
        when others =>
            return "Internal Error: Debug_Tools.Ada_Location";
    end Ada_Location;


    function Get_Exception_Image (Exc_Addr : Address) return String is
        type Word_Access is access Word;
        for Word_Access'Storage_Size use 0;

        function Address_To_Access is
           new Unchecked_Conversion (Source => Address, Target => Word_Access);

        Count_Addr : Word_Access := Address_To_Access (Exc_Addr + 6);
        Count      : Natural     := Natural (Count_Addr.all);

        type String_Access is access String (1 .. Count);
        for String_Access'Storage_Size use 0;

        function Address_To_Access is
           new Unchecked_Conversion (Source => Address,
                                     Target => String_Access);

        Exception_Image : String_Access :=
           Address_To_Access (Address (Exc_Addr + 8));

    begin
        return Exception_Image.all;
    end Get_Exception_Image;

    function Get_Exception_Name
                (Fully_Qualify : Boolean := True;
                 Machine_Info  : Boolean := False) return String is
        Task_Id  : Address;
        Exc_Addr : Address;
    begin
        Task_Id := Get_Current_Task_Id;

        Exc_Addr := Get_Exception_Addr (Task_Id);

        if Exc_Addr = 0 then
            return "";
        else
            return Get_Exception_Image (Exc_Addr);
        end if;  
    exception
        when others =>
            return "Internal Error: Debug_Tools.Get_Exception_Name";
    end Get_Exception_Name;

    function Get_Raise_Location
                (Fully_Qualify : Boolean := True;
                 Machine_Info  : Boolean := False) return String is
        Location : Address;
    begin  
        return "Debug_Tools.Get_Raise_Location is not implemented";
    end Get_Raise_Location;
end Debug_Tools;