aboutsummaryrefslogtreecommitdiff
path: root/hereiam/here_i_am.adb
blob: 879e07ea0477e755a786a978f2faa405ba57f5b5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89


--  Programmed by Jedidiah Barber
--  Released into the public domain


with

    Ada.Assertions,
    Interfaces.C.Strings,
    System.Storage_Elements;

use type

    Interfaces.C.int;


package body Here_I_Am is


    package Storage renames System.Storage_Elements;

    Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address);




    function wai_getExecutablePath
           (Buffer : in Interfaces.C.Strings.chars_ptr;
            Length : in Interfaces.C.int;
            Dir    : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, wai_getExecutablePath, "wai_getExecutablePath");
    pragma Inline (wai_getExecutablePath);

    function wai_getModulePath
           (Buffer : in Interfaces.C.Strings.chars_ptr;
            Length : in Interfaces.C.int;
            Dir    : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, wai_getModulePath, "wai_getModulePath");
    pragma Inline (wai_getModulePath);




    function Executable
        return String
    is
        Path_Length : constant Interfaces.C.int :=
            wai_getExecutablePath (Interfaces.C.Strings.Null_Ptr, 0, Null_Pointer);
        Data_Buffer : aliased Interfaces.C.char_array :=
            (1 .. Interfaces.C.size_t (Path_Length) => Interfaces.C.nul);
        Code : constant Interfaces.C.int := wai_getExecutablePath
           (Interfaces.C.Strings.To_Chars_Ptr (Data_Buffer'Unchecked_Access),
            Path_Length,
            Null_Pointer);
    begin
        pragma Assert (Code >= 0);
        return Interfaces.C.To_Ada (Data_Buffer, False);
    exception
    when Ada.Assertions.Assertion_Error => raise Where_Is_Error with
        "wai_getExecutablePath returned int value of " & Interfaces.C.int'Image (Code);
    end Executable;


    function Module
        return String
    is
        Path_Length : constant Interfaces.C.int :=
            wai_getModulePath (Interfaces.C.Strings.Null_Ptr, 0, Null_Pointer);
        Data_Buffer : aliased Interfaces.C.char_array :=
            (1 .. Interfaces.C.size_t (Path_Length) => Interfaces.C.nul);
        Code : constant Interfaces.C.int := wai_getModulePath
           (Interfaces.C.Strings.To_Chars_Ptr (Data_Buffer'Unchecked_Access),
            Path_Length,
            Null_Pointer);
    begin
        pragma Assert (Code >= 0);
        return Interfaces.C.To_Ada (Data_Buffer, False);
    exception
    when Ada.Assertions.Assertion_Error => raise Where_Is_Error with
        "wai_getModulePath returned int value of " & Interfaces.C.int'Image (Code);
    end Module;


end Here_I_Am;