------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S W I T C H - B -- -- -- -- B o d y -- -- -- -- Copyright (C) 2001-2024, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Bindgen; with Debug; use Debug; with Osint; use Osint; with Opt; use Opt; with System.OS_Lib; use System.OS_Lib; with System.WCh_Con; use System.WCh_Con; package body Switch.B is -------------------------- -- Scan_Binder_Switches -- -------------------------- procedure Scan_Binder_Switches (Switch_Chars : String) is Max : constant Integer := Switch_Chars'Last; Ptr : Integer := Switch_Chars'First; C : Character := ' '; function Get_Optional_Filename return String_Ptr; -- If current character is '=', return a newly allocated string that -- contains the remainder of the current switch (after the '='), else -- return null. function Get_Stack_Size (S : Character) return Int; -- Used for -d and -D to scan stack size including handling k/m. S is -- set to 'd' or 'D' to indicate the switch being scanned. procedure Scan_Debug_Switches; -- Scan out debug switches --------------------------- -- Get_Optional_Filename -- --------------------------- function Get_Optional_Filename return String_Ptr is Result : String_Ptr; begin if Ptr <= Max and then Switch_Chars (Ptr) = '=' then if Ptr = Max then Bad_Switch (Switch_Chars); else Result := new String'(Switch_Chars (Ptr + 1 .. Max)); Ptr := Max + 1; return Result; end if; end if; return null; end Get_Optional_Filename; -------------------- -- Get_Stack_Size -- -------------------- function Get_Stack_Size (S : Character) return Int is Result : Int; begin Scan_Pos (Switch_Chars, Max, Ptr, Result, S); -- In the following code, we enable overflow checking since the -- multiplication by K or M may cause overflow, which is an error. declare pragma Unsuppress (Overflow_Check); begin -- Check for additional character 'k' (for kilobytes) or 'm' (for -- Megabytes), but only if we have not reached the end of the -- switch string. Note that if this appears before the end of the -- string we will get an error when we test to make sure that the -- string is exhausted (at the end of the case). if Ptr <= Max then if Switch_Chars (Ptr) = 'k' then Result := Result * 1024; Ptr := Ptr + 1; elsif Switch_Chars (Ptr) = 'm' then Result := Result * (1024 * 1024); Ptr := Ptr + 1; end if; end if; exception when Constraint_Error => Osint.Fail ("numeric value out of range for switch: " & S); end; return Result; end Get_Stack_Size; ------------------------- -- Scan_Debug_Switches -- ------------------------- procedure Scan_Debug_Switches is Dot : Boolean := False; Underscore : Boolean := False; begin while Ptr <= Max loop C := Switch_Chars (Ptr); -- Binder debug flags come in the following forms: -- -- letter -- . letter -- _ letter -- -- digit -- . digit -- _ digit -- -- Note that the processing of switch -d aleady takes care of the -- case where the first flag is a digit (default stack size). if C in '1' .. '9' or else C in 'a' .. 'z' or else C in 'A' .. 'Z' then -- . letter -- . digit if Dot then Set_Dotted_Debug_Flag (C); Dot := False; -- _ letter -- _ digit elsif Underscore then Set_Underscored_Debug_Flag (C); if Debug_Flag_Underscore_C then Enable_CUDA_Expansion := True; end if; if Debug_Flag_Underscore_D then Enable_CUDA_Device_Expansion := True; end if; if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion then Bad_Switch (Switch_Chars); elsif C = 'c' then -- specify device library name if Ptr >= Max or else Switch_Chars (Ptr + 1) /= '=' then Bad_Switch (Switch_Chars); else CUDA_Device_Library_Name := new String'(Switch_Chars (Ptr + 2 .. Max)); Ptr := Max; end if; end if; Underscore := False; -- letter -- digit else Set_Debug_Flag (C); end if; elsif C = '.' then Dot := True; elsif C = '_' then Underscore := True; else Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; end loop; end Scan_Debug_Switches; -- Start of processing for Scan_Binder_Switches begin -- Skip past the initial character (must be the switch character) if Ptr = Max then Bad_Switch (Switch_Chars); else Ptr := Ptr + 1; end if; -- A little check, "gnat" at the start of a switch is not allowed except -- for the compiler if Max >= Ptr + 3 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat" then Osint.Fail ("invalid switch: """ & Switch_Chars & """" & " (gnat not needed here)"); end if; -- Loop to scan through switches given in switch string Check_Switch : begin C := Switch_Chars (Ptr); case C is -- Processing for a switch when 'a' => Ptr := Ptr + 1; Use_Pragma_Linker_Constructor := True; -- Processing for A switch when 'A' => Ptr := Ptr + 1; Output_ALI_List := True; ALI_List_Filename := Get_Optional_Filename; -- Processing for b switch when 'b' => Ptr := Ptr + 1; Brief_Output := True; -- Processing for c switch when 'c' => Ptr := Ptr + 1; Check_Only := True; -- Processing for d switch when 'd' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; C := Switch_Chars (Ptr); -- Case where character after -d is a digit (default stack size) if C in '0' .. '9' then -- In this case, we process the default primary stack size Default_Stack_Size := Get_Stack_Size ('d'); -- Case where character after -d is not digit (debug flags) else Scan_Debug_Switches; end if; -- Processing for D switch when 'D' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Default_Sec_Stack_Size := Get_Stack_Size ('D'); -- Processing for e switch when 'e' => Ptr := Ptr + 1; Elab_Dependency_Output := True; -- Processing for E switch when 'E' => -- -E is equivalent to -Ea (see below) Exception_Tracebacks := True; Ptr := Ptr + 1; if Ptr <= Max then case Switch_Chars (Ptr) is -- -Ea sets Exception_Tracebacks when 'a' => null; -- -Es sets both Exception_Tracebacks and -- Exception_Tracebacks_Symbolic. when 's' => Exception_Tracebacks_Symbolic := True; when others => Bad_Switch (Switch_Chars); end case; Ptr := Ptr + 1; end if; -- Processing for f switch when 'f' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Force_Elab_Order_File := new String'(Switch_Chars (Ptr + 1 .. Max)); Ptr := Max + 1; if not Is_Regular_File (Force_Elab_Order_File.all) then Osint.Fail (Force_Elab_Order_File.all & ": file not found"); end if; -- Processing for F switch when 'F' => Ptr := Ptr + 1; Force_Checking_Of_Elaboration_Flags := True; -- Processing for g switch when 'g' => Ptr := Ptr + 1; if Ptr <= Max then C := Switch_Chars (Ptr); if C in '0' .. '3' then Debugger_Level := Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0'); Ptr := Ptr + 1; end if; else Debugger_Level := 2; end if; -- Processing for G switch when 'G' => Ptr := Ptr + 1; CCG_Mode := True; -- Processing for h switch when 'h' => Ptr := Ptr + 1; Usage_Requested := True; -- Processing for H switch when 'H' => Ptr := Ptr + 1; Legacy_Elaboration_Order := True; -- Processing for i switch when 'i' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; C := Switch_Chars (Ptr); if C in '1' .. '5' | '9' | 'p' | '8' | 'f' | 'n' | 'w' then Identifier_Character_Set := C; Ptr := Ptr + 1; else Bad_Switch (Switch_Chars); end if; -- Processing for k switch when 'k' => Ptr := Ptr + 1; Check_Elaboration_Flags := False; -- Processing for K switch when 'K' => Ptr := Ptr + 1; Output_Linker_Option_List := True; -- Processing for l switch when 'l' => Ptr := Ptr + 1; Elab_Order_Output := True; -- Processing for m switch when 'm' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C); -- Processing for n switch when 'n' => Ptr := Ptr + 1; Bind_Main_Program := False; -- Note: The -L option of the binder also implies -n, so -- any change here must also be reflected in the processing -- for -L that is found in Gnatbind.Scan_Bind_Arg. -- Processing for o switch when 'o' => Ptr := Ptr + 1; if Output_File_Name_Present then Osint.Fail ("duplicate -o switch"); else Output_File_Name_Present := True; end if; -- Processing for O switch when 'O' => Ptr := Ptr + 1; Output_Object_List := True; Object_List_Filename := Get_Optional_Filename; -- Processing for p switch when 'p' => Ptr := Ptr + 1; Pessimistic_Elab_Order := True; -- Processing for P switch when 'P' => Ptr := Ptr + 1; CodePeer_Mode := True; -- Processing for q switch when 'q' => Ptr := Ptr + 1; Quiet_Output := True; -- Processing for Q switch when 'Q' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Scan_Nat (Switch_Chars, Max, Ptr, Quantity_Of_Default_Size_Sec_Stacks, C); -- Processing for r switch when 'r' => Ptr := Ptr + 1; List_Restrictions := True; -- Processing for R switch when 'R' => Ptr := Ptr + 1; List_Closure := True; if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then Ptr := Ptr + 1; List_Closure_All := True; end if; -- Processing for s switch when 's' => Ptr := Ptr + 1; All_Sources := True; Check_Source_Files := True; -- Processing for t switch when 't' => Ptr := Ptr + 1; Tolerate_Consistency_Errors := True; -- Processing for T switch when 'T' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Time_Slice_Set := True; Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C); Time_Slice_Value := Time_Slice_Value * 1_000; -- Processing for u switch when 'u' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Dynamic_Stack_Measurement := True; Scan_Nat (Switch_Chars, Max, Ptr, Dynamic_Stack_Measurement_Array_Size, C); -- Processing for v switch when 'v' => Ptr := Ptr + 1; Verbose_Mode := True; -- Processing for V switch when 'V' => declare Eq : Integer; begin Ptr := Ptr + 1; Eq := Ptr; while Eq <= Max and then Switch_Chars (Eq) /= '=' loop Eq := Eq + 1; end loop; if Eq = Ptr or else Eq = Max then Bad_Switch (Switch_Chars); end if; Bindgen.Set_Bind_Env (Key => Switch_Chars (Ptr .. Eq - 1), Value => Switch_Chars (Eq + 1 .. Max)); Ptr := Max + 1; end; -- Processing for w switch when 'w' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; -- For the binder we only allow suppress/error cases Ptr := Ptr + 1; case Switch_Chars (Ptr) is when 'e' => Warning_Mode := Treat_As_Error; when 'E' => Warning_Mode := Treat_Run_Time_Warnings_As_Errors; when 's' => Warning_Mode := Suppress; when others => Bad_Switch (Switch_Chars); end case; Ptr := Ptr + 1; -- Processing for W switch when 'W' => Ptr := Ptr + 1; if Ptr > Max then Bad_Switch (Switch_Chars); end if; begin Wide_Character_Encoding_Method := Get_WC_Encoding_Method (Switch_Chars (Ptr)); exception when Constraint_Error => Bad_Switch (Switch_Chars); end; Wide_Character_Encoding_Method_Specified := True; Upper_Half_Encoding := Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method; Ptr := Ptr + 1; -- Processing for x switch when 'x' => Ptr := Ptr + 1; All_Sources := False; Check_Source_Files := False; -- Processing for X switch when 'X' => if Ptr = Max then Bad_Switch (Switch_Chars); end if; Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C); -- Processing for y switch when 'y' => Ptr := Ptr + 1; Leap_Seconds_Support := True; -- Processing for z switch when 'z' => Ptr := Ptr + 1; No_Main_Subprogram := True; -- Processing for Z switch when 'Z' => Ptr := Ptr + 1; Zero_Formatting := True; -- Processing for --RTS when '-' => if Ptr + 4 <= Max and then Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS" then Ptr := Ptr + 4; if Switch_Chars (Ptr) /= '=' or else Ptr = Max then Osint.Fail ("missing path for --RTS"); else -- Valid --RTS switch Opt.No_Stdinc := True; Opt.RTS_Switch := True; declare RTS_Arg_Path : constant String := Switch_Chars (Ptr + 1 .. Max); Src_Path_Name : constant String_Ptr := Get_RTS_Search_Dir (RTS_Arg_Path, Include); Lib_Path_Name : constant String_Ptr := Get_RTS_Search_Dir (RTS_Arg_Path, Objects); begin if Src_Path_Name /= null and then Lib_Path_Name /= null then -- Set the RTS_*_Path_Name variables, so that the -- correct directories will be set when a subsequent -- call Osint.Add_Default_Search_Dirs is made. RTS_Src_Path_Name := Src_Path_Name; RTS_Lib_Path_Name := Lib_Path_Name; Ptr := Max + 1; elsif Src_Path_Name = null and then Lib_Path_Name = null then Osint.Fail ("RTS path """ & RTS_Arg_Path & """ not valid: missing adainclude and " & "adalib directories"); elsif Src_Path_Name = null then Osint.Fail ("RTS path """ & RTS_Arg_Path & """ not valid: missing adainclude directory"); else pragma Assert (Lib_Path_Name = null); Osint.Fail ("RTS path """ & RTS_Arg_Path & """ not valid: missing adalib directory"); end if; end; end if; else Bad_Switch (Switch_Chars); end if; -- Anything else is an error (illegal switch character) when others => Bad_Switch (Switch_Chars); end case; if Ptr <= Max then Bad_Switch (Switch_Chars); end if; end Check_Switch; end Scan_Binder_Switches; end Switch.B;