File : s-memory-pikeos.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                         S Y S T E M . M E M O R Y                        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2015, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  This is the PikeOS-specific version of this package.
  33 
  34 with System.Storage_Elements;
  35 with Unchecked_Conversion;
  36 
  37 package body System.Memory is
  38 
  39    package SSE renames System.Storage_Elements;
  40 
  41    Default_Size : constant := 20 * 1_024;
  42 
  43    type Mark_Id is new SSE.Integer_Address;
  44 
  45    type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
  46    for Memory'Alignment use Standard'Maximum_Alignment;
  47 
  48    Mem : Memory (1 .. Default_Size);
  49 
  50    Top : Mark_Id := Mem'First;
  51 
  52    function To_Mark_Id is new Unchecked_Conversion
  53      (size_t, Mark_Id);
  54 
  55    ----------------
  56    -- For C code --
  57    ----------------
  58 
  59    function Malloc (Size : size_t) return System.Address;
  60    pragma Export (C, Malloc, "malloc");
  61 
  62    function Calloc (N_Elem : size_t; Elem_Size : size_t) return System.Address;
  63    pragma Export (C, Calloc, "calloc");
  64 
  65    procedure C_Free (Ptr : System.Address);
  66    pragma Export (C, C_Free, "free");
  67 
  68    procedure Free (Ptr : System.Address) renames C_Free;
  69 
  70    -----------
  71    -- Alloc --
  72    -----------
  73 
  74    function Alloc (Size : size_t) return System.Address is
  75       Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
  76       Max_Size  : Mark_Id :=
  77                     ((To_Mark_Id (Size) + Max_Align - 1) / Max_Align) *
  78                                                                 Max_Align;
  79       Location  : constant Mark_Id := Top;
  80 
  81    begin
  82       if Max_Size = 0 then
  83          Max_Size := Max_Align;
  84       end if;
  85 
  86       if Size = size_t'Last then
  87          raise Storage_Error;
  88       end if;
  89 
  90       Top := Top + Max_Size;
  91 
  92       if Top > Default_Size then
  93          raise Storage_Error;
  94       end if;
  95 
  96       return Mem (Location)'Address;
  97    end Alloc;
  98 
  99    ------------
 100    -- Malloc --
 101    ------------
 102 
 103    function Malloc (Size : size_t) return System.Address is
 104    begin
 105       return Alloc (Size);
 106    end Malloc;
 107 
 108    ------------
 109    -- Calloc --
 110    ------------
 111 
 112    function Calloc
 113      (N_Elem : size_t; Elem_Size : size_t) return System.Address
 114    is
 115    begin
 116       return Malloc (N_Elem * Elem_Size);
 117    end Calloc;
 118 
 119    ------------
 120    -- C_Free --
 121    ------------
 122 
 123    procedure C_Free (Ptr : System.Address) is
 124       pragma Unreferenced (Ptr);
 125    begin
 126       null;
 127    end C_Free;
 128 
 129    -------------
 130    -- Realloc --
 131    -------------
 132 
 133    function Realloc
 134      (Ptr  : System.Address;
 135       Size : size_t) return System.Address is
 136    begin
 137       Free (Ptr);
 138       return Malloc (Size);
 139    end Realloc;
 140 
 141 end System.Memory;