1
2package body Unc_Memops is
3
4   use type System.Address;
5
6   type Addr_Array_T is array (1 .. 20) of Addr_T;
7
8   type Addr_Stack_T is record
9      Store : Addr_Array_T;
10      Size  : Integer := 0;
11   end record;
12
13   procedure Push (Addr : Addr_T; As : access addr_stack_t) is
14   begin
15      As.Size := As.Size + 1;
16      As.Store (As.Size) := Addr;
17   end;
18
19   function Pop (As : access Addr_Stack_T) return Addr_T is
20      Addr : Addr_T := As.Store (As.Size);
21   begin
22      As.Size := As.Size - 1;
23      return Addr;
24   end;
25
26   --
27
28   Addr_Stack : aliased Addr_Stack_T;
29   Symetry_Expected : Boolean := False;
30
31   procedure Expect_Symetry (Status : Boolean) is
32   begin
33      Symetry_Expected := Status;
34   end;
35
36   function  Alloc (Size : size_t) return Addr_T is
37      function malloc (Size : Size_T) return Addr_T;
38      pragma Import (C, Malloc, "malloc");
39
40      Ptr : Addr_T := malloc (Size);
41   begin
42      if Symetry_Expected then
43         Push (Ptr, Addr_Stack'Access);
44      end if;
45      return Ptr;
46   end;
47
48   procedure Free (Ptr : addr_t) is
49   begin
50      if Symetry_Expected
51        and then Ptr /= Pop (Addr_Stack'Access)
52      then
53         raise Program_Error;
54      end if;
55   end;
56
57   function  Realloc (Ptr  : addr_t; Size : size_t) return Addr_T is
58   begin
59      raise Program_Error;
60      return System.Null_Address;
61   end;
62
63end;
64