gcc/ada/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 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  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;