From: charlet Date: Tue, 14 Aug 2007 08:36:48 +0000 (+0000) Subject: 2007-08-14 Robert Dewar X-Git-Tag: upstream/4.9.2~46981 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=65297ca971f11afebfb1d420d32bc4c769bbbdf5;p=platform%2Fupstream%2Flinaro-gcc.git 2007-08-14 Robert Dewar * uintp.adb, a-ztedit.adb, s-wchcon.adb, xnmake.adb, s-wchcon.adb, par-ch5.adb, par-ch10.adb, get_targ.adb, a-wtedit.adb, a-teioed.adb, s-osinte-solaris.adb, s-osinte-solaris.ads, s-osinte-freebsd.ads, s-osinte-freebsd.adb: Minor reformatting. * styleg.adb, styleg.ads, stylesw.adb, stylesw.ads: implement style switch -gnatyS. Enable -gnatyS in GNAT style check mode git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127409 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/a-teioed.adb b/gcc/ada/a-teioed.adb index 5f84c72..a288752 100644 --- a/gcc/ada/a-teioed.adb +++ b/gcc/ada/a-teioed.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -933,7 +933,9 @@ package body Ada.Text_IO.Editing is Pic.Contents.Picture.Expanded; begin for J in Temp'Range loop - if Temp (J) = 'b' then Temp (J) := 'B'; end if; + if Temp (J) = 'b' then + Temp (J) := 'B'; + end if; end loop; return Temp; @@ -2448,9 +2450,10 @@ package body Ada.Text_IO.Editing is procedure Set_State (L : Legality) is begin - if Debug then Ada.Text_IO.Put_Line - (" Set state from " & Legality'Image (State) & - " to " & Legality'Image (L)); + if Debug then + Ada.Text_IO.Put_Line + (" Set state from " & Legality'Image (State) + & " to " & Legality'Image (L)); end if; State := L; @@ -2462,8 +2465,8 @@ package body Ada.Text_IO.Editing is procedure Skip is begin - if Debug then Ada.Text_IO.Put_Line - (" Skip " & Pic.Picture.Expanded (Index)); + if Debug then + Ada.Text_IO.Put_Line (" Skip " & Pic.Picture.Expanded (Index)); end if; Index := Index + 1; diff --git a/gcc/ada/a-wtedit.adb b/gcc/ada/a-wtedit.adb index ce2380a..eb72f81 100644 --- a/gcc/ada/a-wtedit.adb +++ b/gcc/ada/a-wtedit.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -1100,7 +1100,9 @@ package body Ada.Wide_Text_IO.Editing is Pic.Contents.Picture.Expanded; begin for J in Temp'Range loop - if Temp (J) = 'b' then Temp (J) := 'B'; end if; + if Temp (J) = 'b' then + Temp (J) := 'B'; + end if; end loop; return Temp; diff --git a/gcc/ada/a-ztedit.adb b/gcc/ada/a-ztedit.adb index 4720750..f7838d0 100644 --- a/gcc/ada/a-ztedit.adb +++ b/gcc/ada/a-ztedit.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -1102,7 +1102,9 @@ package body Ada.Wide_Wide_Text_IO.Editing is Pic.Contents.Picture.Expanded; begin for J in Temp'Range loop - if Temp (J) = 'b' then Temp (J) := 'B'; end if; + if Temp (J) = 'b' then + Temp (J) := 'B'; + end if; end loop; return Temp; diff --git a/gcc/ada/get_targ.adb b/gcc/ada/get_targ.adb index fb2b226..ddf30d7 100644 --- a/gcc/ada/get_targ.adb +++ b/gcc/ada/get_targ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -32,11 +32,16 @@ package body Get_Targ is function Digits_From_Size (Size : Pos) return Pos is begin - if Size = 32 then return 6; - elsif Size = 48 then return 9; - elsif Size = 64 then return 15; - elsif Size = 96 then return 18; - elsif Size = 128 then return 18; + if Size = 32 then + return 6; + elsif Size = 48 then + return 9; + elsif Size = 64 then + return 15; + elsif Size = 96 then + return 18; + elsif Size = 128 then + return 18; else raise Program_Error; end if; @@ -57,10 +62,14 @@ package body Get_Targ is function Width_From_Size (Size : Pos) return Pos is begin - if Size = 8 then return 4; - elsif Size = 16 then return 6; - elsif Size = 32 then return 11; - elsif Size = 64 then return 21; + if Size = 8 then + return 4; + elsif Size = 16 then + return 6; + elsif Size = 32 then + return 11; + elsif Size = 64 then + return 21; else raise Program_Error; end if; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index f013cf1..8a71edf 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -244,7 +244,9 @@ package body Ch10 is if Token = Tok_Private then Private_Sloc := Token_Ptr; Set_Keyword_Casing (Current_Source_File, Determine_Token_Casing); - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; Save_Scan_State (Scan_State); -- at PRIVATE Scan; -- past PRIVATE @@ -320,7 +322,9 @@ package body Ch10 is -- it hasn't already been done on seeing a WITH or PRIVATE. Set_Keyword_Casing (Current_Source_File, Determine_Token_Casing); - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; -- Remaining processing depends on particular type of compilation unit @@ -807,7 +811,9 @@ package body Ch10 is -- Loop through context items loop - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; -- Gather any pragmas appearing in the context clause diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index bab2637..0073528 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -210,7 +210,9 @@ package body Ch5 is end loop; begin - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; -- Deal with reserved identifier (in assignment or call) @@ -1121,7 +1123,10 @@ package body Ch5 is begin if Token_Is_At_Start_Of_Line and then Token = Tok_Then then Check_If_Column; - if Style_Check then Style.Check_Then (Loc); end if; + + if Style_Check then + Style.Check_Then (Loc); + end if; end if; end Check_Then_Column; @@ -1397,7 +1402,10 @@ package body Ch5 is Case_Alt_Node : Node_Id; begin - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; + Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr); T_When; -- past WHEN (or give error in OTHERS case) Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List); @@ -2069,7 +2077,9 @@ package body Ch5 is Set_Declarations (Parent, Decls); if Token = Tok_Begin then - if Style_Check then Style.Check_Indentation; end if; + if Style_Check then + Style.Check_Indentation; + end if; Error_Msg_Col := Scope.Table (Scope.Last).Ecol; diff --git a/gcc/ada/s-osinte-freebsd.adb b/gcc/ada/s-osinte-freebsd.adb index 33daa45..fbc12c1 100644 --- a/gcc/ada/s-osinte-freebsd.adb +++ b/gcc/ada/s-osinte-freebsd.adb @@ -38,21 +38,34 @@ with Interfaces.C; use Interfaces.C; package body System.OS_Interface is + ----------- + -- Errno -- + ----------- + function Errno return int is type int_ptr is access all int; function internal_errno return int_ptr; pragma Import (C, internal_errno, "__error"); + begin return (internal_errno.all); end Errno; + -------------------- + -- Get_Stack_Base -- + -------------------- + function Get_Stack_Base (thread : pthread_t) return Address is pragma Unreferenced (thread); begin return (0); end Get_Stack_Base; + ------------------ + -- pthread_init -- + ------------------ + procedure pthread_init is begin null; @@ -85,15 +98,20 @@ package body System.OS_Interface is function To_Timespec (D : Duration) return timespec is S : time_t; F : Duration; + begin S := time_t (Long_Long_Integer (D)); F := D - Duration (S); -- If F has negative value due to a round-up, adjust for positive F - -- value. - if F < 0.0 then S := S - 1; F := F + 1.0; end if; + + if F < 0.0 then + S := S - 1; + F := F + 1.0; + end if; + return timespec'(ts_sec => S, - ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); + ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); end To_Timespec; end System.OS_Interface; diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index 8b3530c..48a4f90 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/gcc/ada/s-osinte-freebsd.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -235,7 +235,7 @@ package System.OS_Interface is function To_Target_Priority (Prio : System.Any_Priority) return Interfaces.C.int; - -- Maps System.Any_Priority to a POSIX priority. + -- Maps System.Any_Priority to a POSIX priority ------------- -- Process -- diff --git a/gcc/ada/s-osinte-solaris.adb b/gcc/ada/s-osinte-solaris.adb index c27309c..b9997bf 100644 --- a/gcc/ada/s-osinte-solaris.adb +++ b/gcc/ada/s-osinte-solaris.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1995-2007, AdaCore -- -- -- -- GNARL 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- -- @@ -32,7 +32,7 @@ -- -- ------------------------------------------------------------------------------ --- This is a Solaris version of this package. +-- This is a Solaris version of this package -- This package encapsulates all direct interfaces to OS services -- that are needed by children of System. @@ -42,6 +42,7 @@ pragma Polling (Off); -- tasking operations. It causes infinite loops and other problems. with Interfaces.C; use Interfaces.C; + package body System.OS_Interface is ----------------- @@ -60,38 +61,60 @@ package body System.OS_Interface is function To_Timespec (D : Duration) return timespec is S : time_t; F : Duration; + begin S := time_t (Long_Long_Integer (D)); F := D - Duration (S); -- If F has negative value due to a round-up, adjust for positive F - -- value. - if F < 0.0 then S := S - 1; F := F + 1.0; end if; + + if F < 0.0 then + S := S - 1; + F := F + 1.0; + end if; + return timespec'(tv_sec => S, tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); end To_Timespec; + ----------------- + -- To_Duration -- + ----------------- + function To_Duration (TV : struct_timeval) return Duration is begin return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; end To_Duration; + ---------------- + -- To_Timeval -- + ---------------- + function To_Timeval (D : Duration) return struct_timeval is S : long; F : Duration; + begin S := long (Long_Long_Integer (D)); F := D - Duration (S); -- If F has negative value due to a round-up, adjust for positive F - -- value. - if F < 0.0 then S := S - 1; F := F + 1.0; end if; + + if F < 0.0 then + S := S - 1; + F := F + 1.0; + end if; + return struct_timeval' (tv_sec => S, tv_usec => long (Long_Long_Integer (F * 10#1#E6))); end To_Timeval; + ------------------ + -- pthread_init -- + ------------------ + procedure pthread_init is begin null; diff --git a/gcc/ada/s-osinte-solaris.ads b/gcc/ada/s-osinte-solaris.ads index 0e5bbbd..88b99b7 100644 --- a/gcc/ada/s-osinte-solaris.ads +++ b/gcc/ada/s-osinte-solaris.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -126,7 +126,7 @@ package System.OS_Interface is Unmasked : constant Signal_Set := (SIGTRAP, SIGLWP, SIGPROF); -- Following signals should not be disturbed. - -- See c-posix-signals.c in FLORIST + -- See c-posix-signals.c in FLORIST. Reserved : constant Signal_Set := (SIGKILL, SIGSTOP, SIGWAITING, SIGCANCEL, SIGTRAP, SIGSEGV); @@ -451,7 +451,7 @@ package System.OS_Interface is type id_t is new long; P_MYID : constant := -1; - -- the specified LWP or process is the current one. + -- The specified LWP or process is the current one type struct_pcinfo is record pc_cid : id_t; @@ -485,21 +485,21 @@ package System.OS_Interface is -- Constants for function processor_bind PBIND_QUERY : constant processorid_t := -2; - -- the processor bindings are not changed. + -- The processor bindings are not changed PBIND_NONE : constant processorid_t := -1; - -- the processor bindings of the specified LWPs are cleared. + -- The processor bindings of the specified LWPs are cleared -- Flags for function p_online PR_OFFLINE : constant int := 1; - -- processor is offline, as quiet as possible + -- Processor is offline, as quiet as possible PR_ONLINE : constant int := 2; - -- processor online + -- Processor online PR_STATUS : constant int := 3; - -- value passed to p_online to request status + -- Value passed to p_online to request status function p_online (processorid : processorid_t; flag : int) return int; pragma Import (C, p_online, "p_online"); @@ -512,7 +512,7 @@ package System.OS_Interface is pragma Import (C, processor_bind, "processor_bind"); procedure pthread_init; - -- dummy procedure to share s-intman.adb with other Solaris targets. + -- Dummy procedure to share s-intman.adb with other Solaris targets private diff --git a/gcc/ada/s-wchcon.adb b/gcc/ada/s-wchcon.adb index 9cbea7f..5a05dd1 100755 --- a/gcc/ada/s-wchcon.adb +++ b/gcc/ada/s-wchcon.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2005-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2007, 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- -- @@ -50,12 +50,18 @@ package body System.WCh_Con is function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method is begin - if S = "hex" then return WCEM_Hex; - elsif S = "upper" then return WCEM_Upper; - elsif S = "shift_jis" then return WCEM_Shift_JIS; - elsif S = "euc" then return WCEM_EUC; - elsif S = "utf8" then return WCEM_UTF8; - elsif S = "brackets" then return WCEM_Brackets; + if S = "hex" then + return WCEM_Hex; + elsif S = "upper" then + return WCEM_Upper; + elsif S = "shift_jis" then + return WCEM_Shift_JIS; + elsif S = "euc" then + return WCEM_EUC; + elsif S = "utf8" then + return WCEM_UTF8; + elsif S = "brackets" then + return WCEM_Brackets; else raise Constraint_Error; end if; diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index 381b39d..fb8409b 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -63,7 +63,11 @@ package body Styleg is -- Check that token is first token on line, or else is not preceded -- by white space. Signal error of space not allowed if not. + procedure Check_Separate_Stmt_Lines_Cont; + -- Non-inlined continuation of Check_Separate_Stmt_Lines + function Determine_Token_Casing return Casing_Type; + -- Determine casing of current token procedure Error_Space_Not_Allowed (S : Source_Ptr); -- Posts an error message indicating that a space is not allowed @@ -699,6 +703,82 @@ package body Styleg is end if; end Check_Semicolon; + ------------------------------- + -- Check_Separate_Stmt_Lines -- + ------------------------------- + + procedure Check_Separate_Stmt_Lines is + begin + if Style_Check_Separate_Stmt_Lines then + Check_Separate_Stmt_Lines_Cont; + end if; + end Check_Separate_Stmt_Lines; + + ------------------------------------ + -- Check_Separate_Stmt_Lines_Cont -- + ------------------------------------ + + procedure Check_Separate_Stmt_Lines_Cont is + S : Source_Ptr; + + begin + -- Skip past white space + + S := Scan_Ptr; + while Is_White_Space (Source (S)) loop + S := S + 1; + end loop; + + -- Line terminator is OK + + if Source (S) in Line_Terminator then + return; + + -- Comment is OK + + elsif Source (S) = '-' and then Source (S + 1) = '-' then + return; + + -- ABORT keyword is OK after THEN (THEN ABORT case) + + elsif Token = Tok_Then + and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A') + and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B') + and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O') + and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R') + and then (Source (S + 4) = 't' or else Source (S + 4) = 'T') + and then (Source (S + 5) in Line_Terminator + or else Is_White_Space (Source (S + 5))) + then + return; + + -- PRAGMA keyword is OK after ELSE + + elsif Token = Tok_Else + and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P') + and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R') + and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A') + and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G') + and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M') + and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A') + and then (Source (S + 6) in Line_Terminator + or else Is_White_Space (Source (S + 6))) + then + return; + + -- Otherwise we have the style violation we are looking for + + else + if Token = Tok_Then then + Error_Msg + ("(style) no statements may follow THEN on same line", S); + else + Error_Msg + ("(style) no statements may follow ELSE on same line", S); + end if; + end if; + end Check_Separate_Stmt_Lines_Cont; + ---------------- -- Check_Then -- ---------------- diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads index 7a5b312..448755a 100644 --- a/gcc/ada/styleg.ads +++ b/gcc/ada/styleg.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -133,6 +133,13 @@ package Styleg is -- procedure is called only if THEN appears at the start of a line with -- Token_Ptr pointing to the THEN keyword. + procedure Check_Separate_Stmt_Lines; + pragma Inline (Check_Separate_Stmt_Lines); + -- Called after scanning THEN (not preceded by AND) or ELSE (not preceded + -- by OR). Used to check that no tokens follow on the same line (which + -- would intefere with coverage testing). Handles case of THEN ABORT as + -- an exception, as well as PRAGMA after ELSE. + procedure Check_Unary_Plus_Or_Minus; -- Called after scanning a unary plus or minus to check spacing diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index 08a2ef7..5d79978 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -54,6 +54,7 @@ package body Stylesw is Style_Check_Order_Subprograms := False; Style_Check_Pragma_Casing := False; Style_Check_References := False; + Style_Check_Separate_Stmt_Lines := False; Style_Check_Specs := False; Style_Check_Standard := False; Style_Check_Tokens := False; @@ -65,7 +66,7 @@ package body Stylesw is ------------------------------ procedure Save_Style_Check_Options (Options : out Style_Check_Options) is - P : Natural := 0; + P : Natural := 0; procedure Add (C : Character; S : Boolean); -- Add given character C to string if switch S is true @@ -126,6 +127,7 @@ package body Stylesw is Add ('p', Style_Check_Pragma_Casing); Add ('r', Style_Check_References); Add ('s', Style_Check_Specs); + Add ('S', Style_Check_Separate_Stmt_Lines); Add ('t', Style_Check_Tokens); Add ('u', Style_Check_Blank_Lines); Add ('x', Style_Check_Xtra_Parens); @@ -167,7 +169,7 @@ package body Stylesw is procedure Set_GNAT_Style_Check_Options is begin Reset_Style_Check_Options; - Set_Style_Check_Options ("3aAbcdefhiklmnprstux"); + Set_Style_Check_Options ("3aAbcdefhiklmnprsStux"); end Set_GNAT_Style_Check_Options; ----------------------------- @@ -359,6 +361,9 @@ package body Stylesw is when 's' => Style_Check_Specs := True; + when 'S' => + Style_Check_Separate_Stmt_Lines := True; + when 't' => Style_Check_Tokens := True; diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads index 284b59d..9b2294f 100644 --- a/gcc/ada/stylesw.ads +++ b/gcc/ada/stylesw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -38,14 +38,15 @@ package Stylesw is -------------------------- -- These flags are used to control the details of the style checking - -- options. The default values shown here correspond to no style - -- checking. If any of these values is set to a non-default value, - -- then Opt.Style_Check is set True to active calls to this package. + -- options. The default values shown here correspond to no style checking. - -- The actual mechanism for setting these switches to other than - -- default values is via the Set_Style_Check_Option procedure or - -- through a call to Set_Default_Style_Check_Options. They should - -- not be set directly in any other manner. + -- If any of these values is set to a non-default value, then + -- Opt.Style_Check is set True to active calls to this package. + + -- The actual mechanism for setting these switches to other than default + -- values is via the Set_Style_Check_Option procedure or through a call to + -- Set_Default_Style_Check_Options. They should not be set directly in any + -- other manner. Style_Check_Array_Attribute_Index : Boolean := False; -- This can be set True by using -gnatg or -gnatyA switches. If it is True @@ -54,31 +55,31 @@ package Stylesw is -- array attribute references. Style_Check_Attribute_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatya switches. If - -- it is True, then attribute names (including keywords such as - -- digits used as attribute names) must be in mixed case. + -- This can be set True by using the -gnatg or -gnatya switches. If it is + -- True, then attribute names (including keywords such as digits used as + -- attribute names) must be in mixed case. Style_Check_Blanks_At_End : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyb switches. If - -- it is True, then spaces at the end of lines are not permitted. + -- This can be set True by using the -gnatg or -gnatyb switches. If it is + -- True, then spaces at the end of lines are not permitted. Style_Check_Blank_Lines : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyu switches. If - -- it is True, then multiple blank lines are not permitted, and there - -- may not be a blank line at the end of the file. + -- This can be set True by using the -gnatg or -gnatyu switches. If it is + -- True, then multiple blank lines are not permitted, and there may not be + -- a blank line at the end of the file. Style_Check_Comments : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyc switches. If - -- it is True, then comments are style checked as follows: + -- This can be set True by using the -gnatg or -gnatyc switches. If it is + -- True, then comments are style checked as follows: -- - -- All comments must be at the start of the line, or the first - -- minus must be preceded by at least one space. + -- All comments must be at the start of the line, or the first minus must + -- be preceded by at least one space. -- - -- For a comment that is not at the start of a line, the only - -- requirement is that a space follow the comment characters. + -- For a comment that is not at the start of a line, the only requirement + -- is that a space follow the comment characters. -- - -- For a coment that is at the start of the line, one of the - -- following conditions must hold: + -- For a coment that is at the start of the line, one of the following + -- conditions must hold: -- -- The comment characters are the only non-blank characters on the line -- @@ -89,40 +90,39 @@ package Stylesw is -- -- The line consists entirely of minus signs -- - -- The comment characters are followed by a single space, and the - -- last two characters on the line are also comment characters. + -- The comment characters are followed by a single space, and the last + -- two characters on the line are also comment characters. -- -- Note: the reason for the last two conditions is to allow "boxed" -- comments where only a single space separates the comment characters. Style_Check_DOS_Line_Terminator : Boolean := False; - -- This can be set true by using the -gnatg or -gnatyd switches. If - -- it is True, then the line terminator must be a single LF, without an + -- This can be set true by using the -gnatg or -gnatyd switches. If it + -- is True, then the line terminator must be a single LF, without an -- associated CR (e.g. DOS line terminator sequence CR/LF not allowed). Style_Check_End_Labels : Boolean := False; - -- This can be set True by using the -gnatg or -gnatye switches. If - -- it is True, then optional END labels must always be present. + -- This can be set True by using the -gnatg or -gnatye switches. If it is + -- True, then optional END labels must always be present. Style_Check_Form_Feeds : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyf switches. If - -- it is True, then form feeds and vertical tabs are not allowed in - -- the source text. + -- This can be set True by using the -gnatg or -gnatyf switches. If it is + -- True, then form feeds and vertical tabs are not allowed in the source + -- text. Style_Check_Horizontal_Tabs : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyh switches. If - -- it is True, then horizontal tabs are not allowed in source text. + -- This can be set True by using the -gnatg or -gnatyh switches. If it is + -- True, then horizontal tabs are not allowed in source text. Style_Check_If_Then_Layout : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyi switches. If - -- it is True, then a THEN keyword may not appear on the line that - -- immediately follows the line containing the corresponding IF. + -- This can be set True by using the -gnatg or -gnatyi switches. If it is + -- True, then a THEN keyword may not appear on the line that immediately + -- follows the line containing the corresponding IF. -- - -- This permits one of two styles for IF-THEN layout. Either the - -- IF and THEN keywords are on the same line, where the condition - -- is short enough, or the conditions are continued over to the - -- lines following the IF and the THEN stands on its own. For - -- example: + -- This permits one of two styles for IF-THEN layout. Either the IF and + -- THEN keywords are on the same line, where the condition is short enough, + -- or the conditions are continued over to the lines following the IF and + -- the THEN stands on its own. For example: -- -- if X > Y then -- @@ -139,69 +139,76 @@ package Stylesw is Style_Check_Indentation : Column_Number range 0 .. 9 := 0; -- This can be set non-zero by using the -gnatg or -gnatyn (n a digit) - -- switches. If it is non-zero it activates indentation checking with - -- the indicated indentation value. A value of zero turns off checking. - -- The requirement is that any new statement, line comment, declaration - -- or keyword such as END, start on a column that is a multiple of the + -- switches. If it is non-zero it activates indentation checking with the + -- indicated indentation value. A value of zero turns off checking. The + -- requirement is that any new statement, line comment, declaration or + -- keyword such as END, start on a column that is a multiple of the -- indentiation value. Style_Check_Keyword_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyk switches. If - -- it is True, then keywords are required to be in all lower case. - -- This rule does not apply to keywords such as digits appearing as - -- an attribute name. + -- This can be set True by using the -gnatg or -gnatyk switches. If it is + -- True, then keywords are required to be in all lower case. This rule does + -- not apply to keywords such as digits appearing as an attribute name. + + Style_Check_Layout : Boolean := False; + -- This can be set True by using the -gnatg or -gnatyl switches. If it is + -- True, it activates checks that constructs are indented as suggested by + -- the examples in the RM syntax, e.g. that the ELSE keyword must line up + -- with the IF keyword. Style_Check_Max_Line_Length : Boolean := False; - -- This can be set True by using the -gnatg or -gnatym/M switches. - -- If it is True, it activates checking for a maximum line length of + -- This can be set True by using the -gnatg or -gnatym/M switches. If + -- it is True, it activates checking for a maximum line length of -- Style_Max_Line_Length characters. Style_Check_Max_Nesting_Level : Boolean := False; - -- This can be set True by using -gnatyLnnn with a value other than - -- zero (a value of zero resets it to False). If True, it activates - -- checking the maximum nesting level against Style_Max_Nesting_Level. + -- This can be set True by using -gnatyLnnn with a value other than zero + -- (a value of zero resets it to False). If True, it activates checking + -- the maximum nesting level against Style_Max_Nesting_Level. Style_Check_Mode_In : Boolean := False; -- This can be set True by using -gnatyI. If True, it activates checking -- that mode IN is not used on its own (since it is the default). Style_Check_Order_Subprograms : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyo switch. If it - -- is True, then names of subprogram bodies must be in alphabetical - -- order (not taking casing into account). + -- This can be set True by using the -gnatg or -gnatyo switch. If it is + -- True, then names of subprogram bodies must be in alphabetical order + -- (not taking casing into account). Style_Check_Pragma_Casing : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyp switches. If - -- it is True, then pragma names must use mixed case. - - Style_Check_Layout : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyl switches. If - -- it is True, it activates checks that constructs are indented as - -- suggested by the examples in the RM syntax, e.g. that the ELSE - -- keyword must line up with the IF keyword. + -- This can be set True by using the -gnatg or -gnatyp switches. If it is + -- True, then pragma names must use mixed case. Style_Check_References : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyr switches. If - -- it is True, then all references to declared identifiers are - -- checked. The requirement is that casing of the reference be the - -- same as the casing of the corresponding declaration. + -- This can be set True by using the -gnatg or -gnatyr switches. If it is + -- True, then all references to declared identifiers are checked. The + -- requirement is that casing of the reference be the same as the casing + -- of the corresponding declaration. + + Style_Check_Separate_Stmt_Lines : Boolean := False; + -- This can be set True by using the -gnatg or -gnatyS switches. If it is + -- TRUE, then for the case of keywords THEN (not preceded by AND) or ELSE + -- (not preceded by OR) which introduce a conditionally executed statement + -- sequence, there must be no tokens on the same line as the keyword, so + -- that coverage testing can clearly identify execution of the statement + -- sequence. A comment is permitted, as is THEN ABORT or a PRAGMA keyword + -- after ELSE (a common style to specify the condition for the ELSE). Style_Check_Specs : Boolean := False; - -- This can be set True by using the -gnatg or -gnatys switches. If - -- it is True, then separate specs are required to be present for - -- all procedures except parameterless library level procedures. - -- The exception means that typical main programs do not require - -- separate specs. + -- This can be set True by using the -gnatg or -gnatys switches. If it is + -- True, then separate specs are required to be present for all procedures + -- except parameterless library level procedures. The exception means that + -- typical main programs do not require separate specs. Style_Check_Standard : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyn switches. If - -- it is True, then any references to names in Standard have to be - -- in mixed case mode (e.g. Integer, Boolean). + -- This can be set True by using the -gnatg or -gnatyn switches. If it is + -- True, then any references to names in Standard have to be in mixed case + -- mode (e.g. Integer, Boolean). Style_Check_Tokens : Boolean := False; - -- This can be set True by using the -gnatg or -gnatyt switches. If - -- it is True, then the style check that requires canonical spacing - -- between various punctuation tokens as follows: + -- This can be set True by using the -gnatg or -gnatyt switches. If it is + -- True, then the style check that requires canonical spacing between + -- various punctuation tokens as follows: -- -- ABS and NOT must be followed by a space -- @@ -210,6 +217,7 @@ package Stylesw is -- <> must be preceded by a space or left paren -- -- Binary operators other than ** must be surrounded by spaces. + -- -- There is no restriction on the layout of the ** binary operator. -- -- Colon must be surrounded by spaces @@ -220,36 +228,36 @@ package Stylesw is -- immediately preceded by a non-blank character, and must be followed -- by a blank. -- - -- A space must precede a left paren following a digit or letter, - -- and a right paren must not be followed by a space (it can be - -- at the end of the line). + -- A space must precede a left paren following a digit or letter, and a + -- right paren must not be followed by a space (it can be at the end of + -- the line). -- - -- A right paren must either be the first non-blank character on - -- a line, or it must be preceded by a non-blank character. + -- A right paren must either be the first non-blank character on a line, + -- or it must be preceded by a non-blank character. -- - -- A semicolon must not be preceded by a blank, and must not be - -- followed by a non-blank character. + -- A semicolon must not be preceded by a blank, and must not be followed + -- by a non-blank character. -- -- A unary plus or minus may not be followed by a space -- -- A vertical bar must be surrounded by spaces -- - -- Note that a requirement that a token be preceded by a space is - -- met by placing the token at the start of the line, and similarly - -- a requirement that a token be followed by a space is met by - -- placing the token at the end of the line. Note that in the case - -- where horizontal tabs are permitted, a horizontal tab is acceptable - -- for meeting the requirement for a space. + -- Note that a requirement that a token be preceded by a space is met by + -- placing the token at the start of the line, and similarly a requirement + -- that a token be followed by a space is met by placing the token at + -- the end of the line. Note that in the case where horizontal tabs are + -- permitted, a horizontal tab is acceptable for meeting the requirement + -- for a space. Style_Check_Xtra_Parens : Boolean := False; -- This can be set True by using the -gnatg or -gnatyx switch. If true, - -- then it is not allowed to enclose entire conditional expressions - -- in parentheses (C style). + -- then it is not allowed to enclose entire conditional expressions in + -- parentheses (C style). Style_Max_Line_Length : Int := 0; - -- Value used to check maximum line length. Gets reset as a result of - -- use of -gnatym or -gnatyMnnn switches (or by use of -gnatg). This - -- value is only read if Style_Check_Max_Line_Length is True. + -- Value used to check maximum line length. Gets reset as a result of use + -- of -gnatym or -gnatyMnnn switches (or by use of -gnatg). This value is + -- only read if Style_Check_Max_Line_Length is True. Style_Max_Nesting_Level : Int := 0; -- Value used to check maximum nesting level. Gets reset as a result @@ -261,12 +269,12 @@ package Stylesw is ----------------- procedure Set_Default_Style_Check_Options; - -- This procedure is called to set the default style checking options - -- in response to a -gnaty switch with no suboptions. + -- This procedure is called to set the default style checking options in + -- response to a -gnaty switch with no suboptions. procedure Set_GNAT_Style_Check_Options; - -- This procedure is called to set the default style checking options - -- for GNAT units (as set by -gnatg or -gnatyg). + -- This procedure is called to set the default style checking options for + -- GNAT units (as set by -gnatg or -gnatyg). Style_Msg_Buf : String (1 .. 80); Style_Msg_Len : Natural; @@ -301,8 +309,8 @@ package Stylesw is -- Long enough string to hold all options from Save call below procedure Save_Style_Check_Options (Options : out Style_Check_Options); - -- Sets Options to represent current selection of options. This - -- set can be restored by first calling Reset_Style_Check_Options, - -- and then calling Set_Style_Check_Options with the Options string. + -- Sets Options to represent current selection of options. This set can be + -- restored by first calling Reset_Style_Check_Options, and then calling + -- Set_Style_Check_Options with the Options string. end Stylesw; diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 01d45b3..362d1d0 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -46,8 +46,8 @@ package body Uintp is -- Uint value containing Int'First value, set by Initialize. The initial -- value of Uint_0 is used for an assertion check that ensures that this -- value is not used before it is initialized. This value is used in the - -- UI_Is_In_Int_Range predicate, and it is right that this is a host - -- value, since the issue is host representation of integer values. + -- UI_Is_In_Int_Range predicate, and it is right that this is a host value, + -- since the issue is host representation of integer values. Uint_Int_Last : Uint; -- Uint value containing Int'Last value set by Initialize @@ -70,11 +70,11 @@ package body Uintp is Uints_Min : Uint; Udigits_Min : Int; - -- These values are used to make sure that the mark/release mechanism - -- does not destroy values saved in the U_Power tables or in the hash - -- table used by UI_From_Int. Whenever an entry is made in either of - -- these tabls, Uints_Min and Udigits_Min are updated to protect the - -- entry, and Release never cuts back beyond these minimum values. + -- These values are used to make sure that the mark/release mechanism does + -- not destroy values saved in the U_Power tables or in the hash table used + -- by UI_From_Int. Whenever an entry is made in either of these tabls, + -- Uints_Min and Udigits_Min are updated to protect the entry, and Release + -- never cuts back beyond these minimum values. Int_0 : constant Int := 0; Int_1 : constant Int := 1; @@ -86,9 +86,9 @@ package body Uintp is -- UI_From_Int Hash Table -- ---------------------------- - -- UI_From_Int uses a hash table to avoid duplicating entries and - -- wasting storage. This is particularly important for complex cases - -- of back annotation. + -- UI_From_Int uses a hash table to avoid duplicating entries and wasting + -- storage. This is particularly important for complex cases of back + -- annotation. subtype Hnum is Nat range 0 .. 1022; @@ -112,8 +112,8 @@ package body Uintp is -- Returns True if U is represented directly function Direct_Val (U : Uint) return Int; - -- U is a Uint for is represented directly. The returned result - -- is the value represented. + -- U is a Uint for is represented directly. The returned result is the + -- value represented. function GCD (Jin, Kin : Int) return Int; -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0 @@ -122,28 +122,28 @@ package body Uintp is (Input : Uint; To_Buffer : Boolean; Format : UI_Format); - -- Common processing for UI_Image and UI_Write, To_Buffer is set - -- True for UI_Image, and false for UI_Write, and Format is copied - -- from the Format parameter to UI_Image or UI_Write. + -- Common processing for UI_Image and UI_Write, To_Buffer is set True for + -- UI_Image, and false for UI_Write, and Format is copied from the Format + -- parameter to UI_Image or UI_Write. procedure Init_Operand (UI : Uint; Vec : out UI_Vector); pragma Inline (Init_Operand); -- This procedure puts the value of UI into the vector in canonical - -- multiple precision format. The parameter should be of the correct - -- size as determined by a previous call to N_Digits (UI). The first - -- digit of Vec contains the sign, all other digits are always non- - -- negative. Note that the input may be directly represented, and in - -- this case Vec will contain the corresponding one or two digit value. - -- The low bound of Vec is always 1. + -- multiple precision format. The parameter should be of the correct size + -- as determined by a previous call to N_Digits (UI). The first digit of + -- Vec contains the sign, all other digits are always non- negative. Note + -- that the input may be directly represented, and in this case Vec will + -- contain the corresponding one or two digit value. The low bound of Vec + -- is always 1. function Least_Sig_Digit (Arg : Uint) return Int; pragma Inline (Least_Sig_Digit); - -- Returns the Least Significant Digit of Arg quickly. When the given - -- Uint is less than 2**15, the value returned is the input value, in - -- this case the result may be negative. It is expected that any use - -- will mask off unnecessary bits. This is used for finding Arg mod B - -- where B is a power of two. Hence the actual base is irrelevent as - -- long as it is a power of two. + -- Returns the Least Significant Digit of Arg quickly. When the given Uint + -- is less than 2**15, the value returned is the input value, in this case + -- the result may be negative. It is expected that any use will mask off + -- unnecessary bits. This is used for finding Arg mod B where B is a power + -- of two. Hence the actual base is irrelevent as long as it is a power of + -- two. procedure Most_Sig_2_Digits (Left : Uint; @@ -151,17 +151,17 @@ package body Uintp is Left_Hat : out Int; Right_Hat : out Int); -- Returns leading two significant digits from the given pair of Uint's. - -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K) - -- where K is as small as possible S.T. Right_Hat < Base * Base. - -- It is required that Left > Right for the algorithm to work. + -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K) where + -- K is as small as possible S.T. Right_Hat < Base * Base. It is required + -- that Left > Right for the algorithm to work. function N_Digits (Input : Uint) return Int; pragma Inline (N_Digits); -- Returns number of "digits" in a Uint function Sum_Digits (Left : Uint; Sign : Int) return Int; - -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the - -- total has more then one digit then return Sum_Digits of total. + -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the total + -- has more then one digit then return Sum_Digits of total. function Sum_Double_Digits (Left : Uint; Sign : Int) return Int; -- Same as above but work in New_Base = Base * Base @@ -174,24 +174,25 @@ package body Uintp is Discard_Remainder : Boolean); -- Compute euclidian division of Left by Right, and return Quotient and -- signed Remainder (Left rem Right). - -- If Discard_Quotient is True, Quotient is left unchanged. - -- If Discard_Remainder is True, Remainder is left unchanged. + -- + -- If Discard_Quotient is True, Quotient is left unchanged. + -- If Discard_Remainder is True, Remainder is left unchanged. function Vector_To_Uint (In_Vec : UI_Vector; Negative : Boolean) return Uint; - -- Functions that calculate values in UI_Vectors, call this function - -- to create and return the Uint value. In_Vec contains the multiple - -- precision (Base) representation of a non-negative value. Leading - -- zeroes are permitted. Negative is set if the desired result is - -- the negative of the given value. The result will be either the - -- appropriate directly represented value, or a table entry in the - -- proper canonical format is created and returned. + -- Functions that calculate values in UI_Vectors, call this function to + -- create and return the Uint value. In_Vec contains the multiple precision + -- (Base) representation of a non-negative value. Leading zeroes are + -- permitted. Negative is set if the desired result is the negative of the + -- given value. The result will be either the appropriate directly + -- represented value, or a table entry in the proper canonical format is + -- created and returned. -- - -- Note that Init_Operand puts a signed value in the result vector, - -- but Vector_To_Uint is always presented with a non-negative value. - -- The processing of signs is something that is done by the caller - -- before calling Vector_To_Uint. + -- Note that Init_Operand puts a signed value in the result vector, but + -- Vector_To_Uint is always presented with a non-negative value. The + -- processing of signs is something that is done by the caller before + -- calling Vector_To_Uint. ------------ -- Direct -- @@ -225,7 +226,6 @@ package body Uintp is J := Jin; K := Kin; - while K /= Uint_0 loop Tmp := J mod K; J := K; @@ -276,8 +276,8 @@ package body Uintp is -- Internal procedure to output one character procedure Image_Exponent (N : Natural); - -- Output non-zero exponent. Note that we only use the exponent - -- form in the buffer case, so we know that To_Buffer is true. + -- Output non-zero exponent. Note that we only use the exponent form in + -- the buffer case, so we know that To_Buffer is true. procedure Image_Uint (U : Uint); -- Internal procedure to output characters of non-negative Uint @@ -1094,12 +1094,15 @@ package body Uintp is X_Bigger := True; else Sum_Length := R_Length + 1; - if R_Length > L_Length then Y_Bigger := True; end if; + + if R_Length > L_Length then + Y_Bigger := True; + end if; end if; - -- Make copies of the absolute values of L_Vec and R_Vec into - -- X and Y both with lengths equal to the maximum possibly - -- needed. This makes looping over the digits much simpler. + -- Make copies of the absolute values of L_Vec and R_Vec into X and Y + -- both with lengths equal to the maximum possibly needed. This makes + -- looping over the digits much simpler. declare X : UI_Vector (1 .. Sum_Length); @@ -1162,9 +1165,9 @@ package body Uintp is end loop; end if; - -- If they have identical magnitude, just return 0, else - -- swap if necessary so that X had the bigger magnitude. - -- Determine if result is negative at this time. + -- If they have identical magnitude, just return 0, else swap + -- if necessary so that X had the bigger magnitude. Determine + -- if result is negative at this time. Result_Neg := False; @@ -1216,10 +1219,10 @@ package body Uintp is function UI_Decimal_Digits_Hi (U : Uint) return Nat is begin - -- The maximum value of a "digit" is 32767, which is 5 decimal - -- digits, so an N_Digit number could take up to 5 times this - -- number of digits. This is certainly too high for large - -- numbers but it is not worth worrying about. + -- The maximum value of a "digit" is 32767, which is 5 decimal digits, + -- so an N_Digit number could take up to 5 times this number of digits. + -- This is certainly too high for large numbers but it is not worth + -- worrying about. return 5 * N_Digits (U); end UI_Decimal_Digits_Hi; @@ -1233,8 +1236,8 @@ package body Uintp is -- The maximum value of a "digit" is 32767, which is more than four -- decimal digits, but not a full five digits. The easily computed -- minimum number of decimal digits is thus 1 + 4 * the number of - -- digits. This is certainly too low for large numbers but it is - -- not worth worrying about. + -- digits. This is certainly too low for large numbers but it is not + -- worth worrying about. return 1 + 4 * (N_Digits (U) - 1); end UI_Decimal_Digits_Lo; @@ -1487,6 +1490,7 @@ package body Uintp is Dividend (J) := Dividend (J) + Carry; -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6) + -- Here there is a slight difference from the book: the last -- carry is always added in above and below (cancelling each -- other). In fact the dividend going negative is used as @@ -1695,14 +1699,14 @@ package body Uintp is if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then return Uint (Dint (Uint_Direct_Bias) + Input); - -- For values of larger magnitude, compute digits into a vector and - -- call Vector_To_Uint. + -- For values of larger magnitude, compute digits into a vector and call + -- Vector_To_Uint. else declare Max_For_Dint : constant := 5; - -- Base is defined so that 5 Uint digits is sufficient - -- to hold the largest possible Dint value. + -- Base is defined so that 5 Uint digits is sufficient to hold the + -- largest possible Dint value. V : UI_Vector (1 .. Max_For_Dint); @@ -1745,13 +1749,13 @@ package body Uintp is return U; end if; - -- For values of larger magnitude, compute digits into a vector and - -- call Vector_To_Uint. + -- For values of larger magnitude, compute digits into a vector and call + -- Vector_To_Uint. declare Max_For_Int : constant := 3; - -- Base is defined so that 3 Uint digits is sufficient - -- to hold the largest possible Int value. + -- Base is defined so that 3 Uint digits is sufficient to hold the + -- largest possible Int value. V : UI_Vector (1 .. Max_For_Int); @@ -1841,8 +1845,8 @@ package body Uintp is exit when Q /= ((U_Hat + B) / Den2); - -- A single precision step Euclid step will give same answer as - -- a multiprecision one. + -- A single precision step Euclid step will give same answer as a + -- multiprecision one. T := A - (Q * C); A := C; @@ -1871,24 +1875,28 @@ package body Uintp is else -- Use prior single precision steps to compute this Euclid step - -- Fixed bug 1415-008 spends 80% of its time working on this - -- step. Perhaps we need a special case Int / Uint dot - -- product to speed things up. ??? + -- For constructs such as: + -- sqrt_2: constant := 1.41421_35623_73095_04880_16887_24209_698; + -- sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2) + -- ** long_float'machine_mantissa; + -- + -- we spend 80% of our time working on this step. Perhaps we need + -- a special case Int / Uint dot product to speed things up. ??? - -- Alternatively we could increase the single precision - -- iterations to handle Uint's of some small size ( <5 - -- digits?). Then we would have more iterations on small Uint. - -- Fixed bug 1415-008 only gets 5 (on average) single - -- precision iterations per large iteration. ??? + -- Alternatively we could increase the single precision iterations + -- to handle Uint's of some small size ( <5 digits?). Then we + -- would have more iterations on small Uint. On the code above, we + -- only get 5 (on average) single precision iterations per large + -- iteration. ??? Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V); V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V); U := Tmp_UI; end if; - -- If the operands are very different in magnitude, the loop - -- will generate large amounts of short-lived data, which it is - -- worth removing periodically. + -- If the operands are very different in magnitude, the loop will + -- generate large amounts of short-lived data, which it is worth + -- removing periodically. if Iterations > 100 then Release_And_Save (Marks, U, V); @@ -2368,18 +2376,17 @@ package body Uintp is function UI_Negate (Right : Uint) return Uint is begin - -- Case where input is directly represented. Note that since the - -- range of Direct values is non-symmetrical, the result may not - -- be directly represented, this is taken care of in UI_From_Int. + -- Case where input is directly represented. Note that since the range + -- of Direct values is non-symmetrical, the result may not be directly + -- represented, this is taken care of in UI_From_Int. if Direct (Right) then return UI_From_Int (-Direct_Val (Right)); - -- Full processing for multi-digit case. Note that we cannot just - -- copy the value to the end of the table negating the first digit, - -- since the range of Direct values is non-symmetrical, so we can - -- have a negative value that is not Direct whose negation can be - -- represented directly. + -- Full processing for multi-digit case. Note that we cannot just copy + -- the value to the end of the table negating the first digit, since the + -- range of Direct values is non-symmetrical, so we can have a negative + -- value that is not Direct whose negation can be represented directly. else declare @@ -2438,19 +2445,18 @@ package body Uintp is Sign := 1; end if; - -- All cases are listed, grouped by mathematical method - -- It is not inefficient to do have this case list out - -- of order since GCC sorts the cases we list. + -- All cases are listed, grouped by mathematical method It is + -- not inefficient to do have this case list out of order since + -- GCC sorts the cases we list. case Int1_12 (abs (Direct_Val (Right))) is when 1 => return Uint_0; - -- Powers of two are simple AND's with LS Left Digit - -- GCC will recognise these constants as powers of 2 - -- and replace the rem with simpler operations where - -- possible. + -- Powers of two are simple AND's with LS Left Digit GCC + -- will recognise these constants as powers of 2 and replace + -- the rem with simpler operations where possible. -- Least_Sig_Digit might return Negative numbers @@ -2484,6 +2490,7 @@ package body Uintp is Sign * (Sum_Digits (Left, 1) rem Int (7))); -- Note: 2^32 mod 5 = -1 + -- Alternating sums might be negative, but rem is always -- positive hence we must use mod here. @@ -2492,6 +2499,7 @@ package body Uintp is return UI_From_Int (Sign * Tmp); -- Note: 2^15 mod 9 = -1 + -- Alternating sums might be negative, but rem is always -- positive hence we must use mod here. @@ -2500,6 +2508,7 @@ package body Uintp is return UI_From_Int (Sign * Tmp); -- Note: 2^15 mod 11 = -1 + -- Alternating sums might be negative, but rem is always -- positive hence we must use mod here. @@ -2507,26 +2516,28 @@ package body Uintp is Tmp := Sum_Digits (Left, -1) mod Int (11); return UI_From_Int (Sign * Tmp); - -- Now resort to Chinese Remainder theorem - -- to reduce 6, 10, 12 to previous special cases + -- Now resort to Chinese Remainder theorem to reduce 6, 10, + -- 12 to previous special cases - -- There is no reason we could not add more cases - -- like these if it proves useful. + -- There is no reason we could not add more cases like these + -- if it proves useful. - -- Perhaps we should go up to 16, however - -- I have no "trick" for 13. + -- Perhaps we should go up to 16, however we have no "trick" + -- for 13. -- To find u mod m we: + -- Pick m1, m2 S.T. -- GCD(m1, m2) = 1 AND m = (m1 * m2). + -- Next we pick (Basis) M1, M2 small S.T. -- (M1 mod m1) = (M2 mod m2) = 1 AND -- (M1 mod m2) = (M2 mod m1) = 0 - -- So u mod m = (u1 * M1 + u2 * M2) mod m - -- Where u1 = (u mod m1) AND u2 = (u mod m2); - -- Under typical circumstances the last mod m - -- can be done with a (possible) single subtraction. + -- So u mod m = (u1 * M1 + u2 * M2) mod m Where u1 = (u mod + -- m1) AND u2 = (u mod m2); Under typical circumstances the + -- last mod m can be done with a (possible) single + -- subtraction. -- m1 = 2; m2 = 3; M1 = 3; M2 = 4; @@ -2655,9 +2666,9 @@ package body Uintp is Init_Operand (Input, In_Vec); Ret_Int := 0; - -- Calculate -|Input| and then negates if value is positive. - -- This handles our current definition of Int (based on - -- 2s complement). Is it secure enough? + -- Calculate -|Input| and then negates if value is positive. This + -- handles our current definition of Int (based on 2s complement). + -- Is it secure enough??? for Idx in In_Vec'Range loop Ret_Int := Ret_Int * Base - abs In_Vec (Idx); @@ -2723,10 +2734,10 @@ package body Uintp is end if; end if; - -- The value is outside the direct representation range and - -- must therefore be stored in the table. Expand the table - -- to contain the count and tigis. The index of the new table - -- entry will be returned as the result. + -- The value is outside the direct representation range and must + -- therefore be stored in the table. Expand the table to contain + -- the count and tigis. The index of the new table entry will be + -- returned as the result. Uints.Increment_Last; Uints.Table (Uints.Last).Length := Size; diff --git a/gcc/ada/xnmake.adb b/gcc/ada/xnmake.adb index ec08692..40bfa12 100644 --- a/gcc/ada/xnmake.adb +++ b/gcc/ada/xnmake.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -372,12 +372,18 @@ begin then Match (Field, Get_Field); - if Field = "Str" then Field := V_String_Id; - elsif Field = "Node" then Field := V_Node_Id; - elsif Field = "Name" then Field := V_Name_Id; - elsif Field = "List" then Field := V_List_Id; - elsif Field = "Elist" then Field := V_Elist_Id; - elsif Field = "Flag" then Field := V_Boolean; + if Field = "Str" then + Field := V_String_Id; + elsif Field = "Node" then + Field := V_Node_Id; + elsif Field = "Name" then + Field := V_Name_Id; + elsif Field = "List" then + Field := V_List_Id; + elsif Field = "Elist" then + Field := V_Elist_Id; + elsif Field = "Flag" then + Field := V_Boolean; end if; if Field = "Boolean" then