File : g-binenv.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
   4 --                                                                          --
   5 --                  G N A T . B I N D _ E N V I R O N M E N T               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 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 -- GNARL was developed by the GNARL team at Florida State University.       --
  28 -- Extensive contributions were provided by AdaCore.                        --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 with System;
  33 
  34 package body GNAT.Bind_Environment is
  35 
  36    ---------
  37    -- Get --
  38    ---------
  39 
  40    function Get (Key : String) return String is
  41       use type System.Address;
  42 
  43       Bind_Env_Addr : System.Address;
  44       pragma Import (C, Bind_Env_Addr, "__gl_bind_env_addr");
  45       --  Variable provided by init.c/s-init.ads, and initialized by
  46       --  the binder generated file.
  47 
  48       Bind_Env : String (Positive);
  49       for Bind_Env'Address use Bind_Env_Addr;
  50       pragma Import (Ada, Bind_Env);
  51       --  Import Bind_Env string from binder file. Note that we import
  52       --  it here as a string with maximum boundaries. The "real" end
  53       --  of the string is indicated by a NUL byte.
  54 
  55       Index, KLen, VLen : Integer;
  56 
  57    begin
  58       if Bind_Env_Addr = System.Null_Address then
  59          return "";
  60       end if;
  61 
  62       Index := Bind_Env'First;
  63       loop
  64          --  Index points to key length
  65 
  66          VLen := 0;
  67          KLen := Character'Pos (Bind_Env (Index));
  68          exit when KLen = 0;
  69 
  70          Index := Index + KLen + 1;
  71 
  72          --  Index points to value length
  73 
  74          VLen := Character'Pos (Bind_Env (Index));
  75          exit when Bind_Env (Index - KLen .. Index - 1) = Key;
  76 
  77          Index := Index + VLen + 1;
  78       end loop;
  79 
  80       return Bind_Env (Index + 1 .. Index + VLen);
  81    end Get;
  82 
  83 end GNAT.Bind_Environment;