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