1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . C O M M A N D _ L I N E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2009, 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-- 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 32pragma Compiler_Unit; 33 34with System; use System; 35 36package body Ada.Command_Line is 37 38 function Arg_Count return Natural; 39 pragma Import (C, Arg_Count, "__gnat_arg_count"); 40 41 procedure Fill_Arg (A : System.Address; Arg_Num : Integer); 42 pragma Import (C, Fill_Arg, "__gnat_fill_arg"); 43 44 function Len_Arg (Arg_Num : Integer) return Integer; 45 pragma Import (C, Len_Arg, "__gnat_len_arg"); 46 47 ----------------------- 48 -- Local Subprograms -- 49 ----------------------- 50 51 function Initialized return Boolean; 52 -- Checks to ensure that gnat_argc and gnat_argv have been properly 53 -- initialized. Returns false if not, or if argv / argc are 54 -- unsupported on the target (e.g. VxWorks). 55 56 -------------- 57 -- Argument -- 58 -------------- 59 60 function Argument (Number : Positive) return String is 61 Num : Positive; 62 63 begin 64 if Number > Argument_Count then 65 raise Constraint_Error; 66 end if; 67 68 if Remove_Args = null then 69 Num := Number; 70 else 71 Num := Remove_Args (Number); 72 end if; 73 74 declare 75 Arg : aliased String (1 .. Len_Arg (Num)); 76 begin 77 Fill_Arg (Arg'Address, Num); 78 return Arg; 79 end; 80 end Argument; 81 82 -------------------- 83 -- Argument_Count -- 84 -------------------- 85 86 function Argument_Count return Natural is 87 begin 88 if not Initialized then 89 -- RM A.15 (11) 90 return 0; 91 end if; 92 93 if Remove_Args = null then 94 return Arg_Count - 1; 95 else 96 return Remove_Count; 97 end if; 98 end Argument_Count; 99 100 ----------------- 101 -- Initialized -- 102 ----------------- 103 104 function Initialized return Boolean is 105 gnat_argv : System.Address; 106 pragma Import (C, gnat_argv, "gnat_argv"); 107 108 begin 109 return gnat_argv /= System.Null_Address; 110 end Initialized; 111 112 ------------------ 113 -- Command_Name -- 114 ------------------ 115 116 function Command_Name return String is 117 begin 118 if not Initialized then 119 return ""; 120 end if; 121 122 declare 123 Arg : aliased String (1 .. Len_Arg (0)); 124 125 begin 126 Fill_Arg (Arg'Address, 0); 127 return Arg; 128 end; 129 end Command_Name; 130 131end Ada.Command_Line; 132