From patchwork Thu Jul 12 10:49:36 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 170636 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id B37622C020B for ; Thu, 12 Jul 2012 20:50:23 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1342695024; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=rNAJILmFpDBV2aCDfXq9 wlz6Nn4=; b=Mh3Z7xtY96lFEJyTxvSzOtKRnTYGB2/sI9KQllW9UAurUzv8Flxa f4QaYF5c5Xn852pAd9122i+zOi6RWORkqUF/kP825Af5HgzNdB6NX44t6tBjFMXe aQIAzNB2lj4gOCE4ioiDwU0iqoIcrsUSE3H3YD1MvMqQqsXq4V6k4MY= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=tV3+tLvoPJ+L6SUUuul3D4WxwkyBI/2r6TN+eXkcWjPmR9rXhPftqkc7Bu+Ic9 uPEs8BE5K/ayXsT/029Ad1aBKTlTvps9fDm/86gmJ9P2VHjpndaw3rAFTZnvys7c 0MvPfO3tT514/CGPuDOXpRMtIo1iowom3mMsXkjWH4cak=; Received: (qmail 7679 invoked by alias); 12 Jul 2012 10:50:11 -0000 Received: (qmail 7531 invoked by uid 22791); 12 Jul 2012 10:49:59 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 12 Jul 2012 10:49:41 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 949961C7284; Thu, 12 Jul 2012 06:49:36 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id muFwZFkUEc+A; Thu, 12 Jul 2012 06:49:36 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 3F7701C7145; Thu, 12 Jul 2012 06:49:36 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 360153FF09; Thu, 12 Jul 2012 06:49:36 -0400 (EDT) Date: Thu, 12 Jul 2012 06:49:36 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Fix dependency problems from System.Restrictions Message-ID: <20120712104936.GA21474@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch completely changes the way restrictions information is generated in the ALI file. Instead of using a positional notation that is sensitive to the addition of new restrictions, it uses a named notation, that avoids this dependency. If a new restriction is added, and an incompatible version of the binder does not recognize it, then it is simply ignored. In normal operation, this kind of incompatibility should not occur, but in practice certain kinds of builds end up with such incompatibilities, and it is annoying if they bomb out because of mismatching sets of restrictions. This patch avoids that behavior. Note that this patch restores the situation where both the compiler and run-time with System.Restrictions, but the new named notation means that this no longer causes problems. No test, because no functional change (but any tests run will by default use the new named notation for restrictions information. A debug option -gnatd.R forces output of the old style positional information, which the binder will still accept (though of course with the caveat that the set of restrictions must match if the positional form is used). Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-12 Robert Dewar * ali.adb: Add circuitry to read new named form of restrictions lines. * debug.adb: Add doc for new -gnatd.R switch (used positional notation for output of restrictions data in ali file). * lib-writ.adb: Implement new named format for restrictions lines. * lib-writ.ads: Add documentation for new named format for restrictions in ali files. * restrict.adb, restrict.ads, sem_prag.adb: Update comments. * rident.ads: Go back to withing System.Rident * s-rident.ads: Add extensive comment on dealing with consistency checking. Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 189431) +++ lib-writ.adb (working copy) @@ -26,6 +26,7 @@ with ALI; use ALI; with Atree; use Atree; with Casing; use Casing; +with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; with Fname; use Fname; @@ -1140,53 +1141,129 @@ end if; end loop; - -- Output first restrictions line + -- Positional case (only if debug flag -gnatd.R is set) - Write_Info_Initiate ('R'); - Write_Info_Char (' '); + if Debug_Flag_Dot_RR then - -- First the information for the boolean restrictions + -- Output first restrictions line - for R in All_Boolean_Restrictions loop - if Main_Restrictions.Set (R) - and then not Restriction_Warnings (R) - then - Write_Info_Char ('r'); - elsif Main_Restrictions.Violated (R) then - Write_Info_Char ('v'); - else - Write_Info_Char ('n'); - end if; - end loop; + Write_Info_Initiate ('R'); + Write_Info_Char (' '); - -- And now the information for the parameter restrictions + -- First the information for the boolean restrictions - for RP in All_Parameter_Restrictions loop - if Main_Restrictions.Set (RP) - and then not Restriction_Warnings (RP) - then - Write_Info_Char ('r'); - Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); - else - Write_Info_Char ('n'); - end if; + for R in All_Boolean_Restrictions loop + if Main_Restrictions.Set (R) + and then not Restriction_Warnings (R) + then + Write_Info_Char ('r'); + elsif Main_Restrictions.Violated (R) then + Write_Info_Char ('v'); + else + Write_Info_Char ('n'); + end if; + end loop; - if not Main_Restrictions.Violated (RP) - or else RP not in Checked_Parameter_Restrictions - then - Write_Info_Char ('n'); - else - Write_Info_Char ('v'); - Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); + -- And now the information for the parameter restrictions - if Main_Restrictions.Unknown (RP) then - Write_Info_Char ('+'); + for RP in All_Parameter_Restrictions loop + if Main_Restrictions.Set (RP) + and then not Restriction_Warnings (RP) + then + Write_Info_Char ('r'); + Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); + else + Write_Info_Char ('n'); end if; - end if; - end loop; - Write_Info_EOL; + if not Main_Restrictions.Violated (RP) + or else RP not in Checked_Parameter_Restrictions + then + Write_Info_Char ('n'); + else + Write_Info_Char ('v'); + Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); + if Main_Restrictions.Unknown (RP) then + Write_Info_Char ('+'); + end if; + end if; + end loop; + + Write_Info_EOL; + + -- Named case (if debug flag -gnatd.R is not set) + + else + declare + C : Character; + + begin + -- Write RN header line with preceding blank line + + Write_Info_EOL; + Write_Info_Initiate ('R'); + Write_Info_Char ('N'); + Write_Info_EOL; + + -- First the lines for the boolean restrictions + + for R in All_Boolean_Restrictions loop + if Main_Restrictions.Set (R) + and then not Restriction_Warnings (R) + then + C := 'R'; + elsif Main_Restrictions.Violated (R) then + C := 'V'; + else + goto Continue; + end if; + + Write_Info_Initiate ('R'); + Write_Info_Char (C); + Write_Info_Char (' '); + Write_Info_Str (All_Boolean_Restrictions'Image (R)); + Write_Info_EOL; + + <> + null; + end loop; + end; + + -- And now the lines for the parameter restrictions + + for RP in All_Parameter_Restrictions loop + if Main_Restrictions.Set (RP) + and then not Restriction_Warnings (RP) + then + Write_Info_Initiate ('R'); + Write_Info_Str ("R "); + Write_Info_Str (All_Parameter_Restrictions'Image (RP)); + Write_Info_Char ('='); + Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); + Write_Info_EOL; + end if; + + if not Main_Restrictions.Violated (RP) + or else RP not in Checked_Parameter_Restrictions + then + null; + else + Write_Info_Initiate ('R'); + Write_Info_Str ("V "); + Write_Info_Str (All_Parameter_Restrictions'Image (RP)); + Write_Info_Char ('='); + Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); + + if Main_Restrictions.Unknown (RP) then + Write_Info_Char ('+'); + end if; + + Write_Info_EOL; + end if; + end loop; + end if; + -- Output R lines for No_Dependence entries for J in No_Dependences.First .. No_Dependences.Last loop Index: lib-writ.ads =================================================================== --- lib-writ.ads (revision 189431) +++ lib-writ.ads (working copy) @@ -262,6 +262,28 @@ -- -- R Restrictions -- -- --------------------- + -- There are two forms for R lines, positional and named. The positional + -- notation is now considered obsolescent, it is not generated by the most + -- recent versions of the compiler except under control of the debug switch + -- -gnatdR, but is still recognized by the binder. + + -- The recognition by the binder is to ease the transition, and better deal + -- with some cases of inconsistent builds using incompatible versions of + -- the compiler and binder. The named notation is the current preferred + -- approach. + + -- Note that R lines are generated using the information in unit Rident, + -- and intepreted by the binder using the information in System.Rident. + -- Normally these two units should be effectively identical. However in + -- some cases of inconsistent builds, they may be different. This may lead + -- to binder diagnostics, which can be suppressed using the -C switch for + -- the binder, which results in ignoring unrecognized restrictions in the + -- ali files. + + -- --------------------------------------- + -- -- R Restrictions (Positional Form) -- + -- --------------------------------------- + -- The first R line records the status of restrictions generated by pragma -- Restrictions encountered, as well as information on what the compiler -- has been able to determine with respect to restrictions violations. @@ -348,6 +370,74 @@ -- signal a fatal error if it is missing. This means that future -- changes to the ALI file format must retain the R line. + -- ---------------------------------- + -- -- R Restrictions (Named Form) -- + -- ---------------------------------- + + -- The first R line for named form announces that named notation will be + -- used, and also assures that there is at least one R line present, which + -- makes parsing of ali files simpler. A blank line preceds the RN line. + + -- RN + + -- In named notation, the restrictions are given as a series of lines, one + -- per retrictions that is specified or violated (no information is present + -- for restrictions that are not specified or violated). In the following + -- name is the name of the restriction in all upper case. + + -- For boolean restrictions, we have only two possibilities. A restrictions + -- pragma is present, or a violation is detected: + + -- RR name + + -- A restriction pragma is present for the named boolean restriction. + -- No violations were detected by the compiler (or the unit in question + -- would have been found to be illegal). + + -- RV name + + -- No restriction pragma is present for the named boolean restriction. + -- However, the compiler did detect one or more violations of this + -- restriction, which may require a binder consistency check. + + -- For the case of restrictions that take a parameter, we need both the + -- information from pragma if present, and the actual information about + -- what possible violations occur. For example, we can have a unit with + -- a pragma Restrictions (Max_Tasks => 4), where the compiler can detect + -- that there are exactly three tasks declared. Both of these pieces + -- of information must be passed to the binder. The parameter of 4 is + -- important in case the total number of tasks in the partition is greater + -- than 4. The parameter of 3 is important in case some other unit has a + -- restrictions pragma with Max_Tasks=>2. + + -- RR name=N + + -- A restriction pragma is present for the named restriction which is + -- one of the restrictions taking a parameter. The value N (a decimal + -- integer) is the value given in the restriction pragma. + + -- RV name=N + + -- A restriction pragma may or may not be present for the restriction + -- given by name (one of the restrictions taking a parameter). But in + -- either case, the compiler detected possible violations. N (a decimal + -- integer) is the maximum or total count of violations (depending + -- on the checking type) in all the units represented by the ali file). + -- The value here is known to be exact by the compiler and is in the + -- range of Natural. Note that if an RR line is present for the same + -- restriction, then the value in the RV line cannot exceed the value + -- in the RR line (since otherwise the compiler would have detected a + -- violation of the restriction). + + -- RV name=N+ + + -- Similar to the above, but the compiler cannot determine the exact + -- count of violations, but it is at least N. + + -- ------------------------------------------------- + -- -- R Restrictions (No_Dependence Information) -- + -- ------------------------------------------------- + -- Subsequent R lines are present only if pragma Restriction No_Dependence -- is used. There is one such line for each such pragma appearing in the -- extended main unit. The format is: Index: debug.adb =================================================================== --- debug.adb (revision 189431) +++ debug.adb (working copy) @@ -135,7 +135,7 @@ -- d.O Dump internal SCO tables -- d.P Previous (non-optimized) handling of length comparisons -- d.Q - -- d.R + -- d.R Restrictions in ali files in positional form -- d.S Force Optimize_Alignment (Space) -- d.T Force Optimize_Alignment (Time) -- d.U Ignore indirect calls for static elaboration @@ -642,6 +642,11 @@ -- This is there in case we find a situation where the optimization -- malfunctions, to provide a work around. + -- d.R As documented in lib-writ.ads, restrictions in the ali file can + -- have two forms, positional and named. The named notation is the + -- current preferred form, but the use of this debug switch will force + -- the use of the obsolescent positional form. + -- d.S Force Optimize_Alignment (Space) mode as the default -- d.T Force Optimize_Alignment (Time) mode as the default Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 189431) +++ sem_prag.adb (working copy) @@ -6254,7 +6254,7 @@ -- Set Detect_Blocking mode - -- Set required restrictions (see Rident for detailed list) + -- Set required restrictions (see System.Rident for detailed list) -- Set the No_Dependence rules -- No_Dependence => Ada.Asynchronous_Task_Control Index: ali.adb =================================================================== --- ali.adb (revision 189431) +++ ali.adb (working copy) @@ -135,7 +135,7 @@ Ignore_Errors : Boolean := False; Directly_Scanned : Boolean := False) return ALI_Id is - P : Text_Ptr := T'First; + P : Text_Ptr := T'First; Line : Logical_Line_Number := 1; Id : ALI_Id; C : Character; @@ -1154,7 +1154,7 @@ C := Getc; Check_Unknown_Line; - -- Acquire first restrictions line + -- Loop to skip to first restrictions line while C /= 'R' loop if Ignore_Errors then @@ -1169,10 +1169,15 @@ end if; end loop; + -- Ignore all 'R' lines if that is required + if Ignore ('R') then - Skip_Line; + while C = 'R' loop + Skip_Line; + C := Getc; + end loop; - -- Process restrictions line + -- Here we process the restrictions lines (other than unit name cases) else Scan_Restrictions : declare @@ -1182,16 +1187,191 @@ Bad_R_Line : exception; -- Signal bad restrictions line (raised on unexpected character) + Typ : Character; + R : Restriction_Id; + N : Natural; + begin - Checkc (' '); - Skip_Space; + -- Named restriction case - -- Acquire information for boolean restrictions - - for R in All_Boolean_Restrictions loop + if Nextc = 'N' then + Skip_Line; C := Getc; - case C is + -- Loop through RR and RV lines + + while C = 'R' and then Nextc /= ' ' loop + Typ := Getc; + Checkc (' '); + + -- Acquire restriction name + + Name_Len := 0; + while not At_Eol and then Nextc /= '=' loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Getc; + end loop; + + -- Now search list of restrictions to find match + + declare + RN : String renames Name_Buffer (1 .. Name_Len); + + begin + R := Restriction_Id'First; + while R < Not_A_Restriction_Id loop + if Restriction_Id'Image (R) = RN then + goto R_Found; + end if; + + R := Restriction_Id'Succ (R); + end loop; + + -- We don't recognize the restriction. This might be + -- thought of as an error, and it really is, but we + -- want to allow building with inconsistent versions + -- of the binder and ali files (see comments at the + -- start of package System.Rident), so we just ignore + -- this situation. + + goto Done_With_Restriction_Line; + end; + + <> + + case R is + + -- Boolean restriction case + + when All_Boolean_Restrictions => + case Typ is + when 'V' => + ALIs.Table (Id).Restrictions.Violated (R) := + True; + Cumulative_Restrictions.Violated (R) := True; + + when 'R' => + ALIs.Table (Id).Restrictions.Set (R) := True; + Cumulative_Restrictions.Set (R) := True; + + when others => + raise Bad_R_Line; + end case; + + -- Parameter restriction case + + when All_Parameter_Restrictions => + if At_Eol or else Nextc /= '=' then + raise Bad_R_Line; + else + Skipc; + end if; + + N := Natural (Get_Nat); + + case Typ is + + -- Restriction set + + when 'R' => + ALIs.Table (Id).Restrictions.Set (R) := True; + ALIs.Table (Id).Restrictions.Value (R) := N; + + if Cumulative_Restrictions.Set (R) then + Cumulative_Restrictions.Value (R) := + Integer'Min + (Cumulative_Restrictions.Value (R), N); + else + Cumulative_Restrictions.Set (R) := True; + Cumulative_Restrictions.Value (R) := N; + end if; + + -- Restriction violated + + when 'V' => + ALIs.Table (Id).Restrictions.Violated (R) := + True; + Cumulative_Restrictions.Violated (R) := True; + ALIs.Table (Id).Restrictions.Count (R) := N; + + -- Checked Max_Parameter case + + if R in Checked_Max_Parameter_Restrictions then + Cumulative_Restrictions.Count (R) := + Integer'Max + (Cumulative_Restrictions.Count (R), N); + + -- Other checked parameter cases + + else + declare + pragma Unsuppress (Overflow_Check); + + begin + Cumulative_Restrictions.Count (R) := + Cumulative_Restrictions.Count (R) + N; + + exception + when Constraint_Error => + + -- A constraint error comes from the + -- additionh. We reset to the maximum + -- and indicate that the real value is + -- now unknown. + + Cumulative_Restrictions.Value (R) := + Integer'Last; + Cumulative_Restrictions.Unknown (R) := + True; + end; + end if; + + -- Deal with + case + + if Nextc = '+' then + Skipc; + ALIs.Table (Id).Restrictions.Unknown (R) := + True; + Cumulative_Restrictions.Unknown (R) := True; + end if; + + -- Other than 'R' or 'V' + + when others => + raise Bad_R_Line; + end case; + + if not At_Eol then + raise Bad_R_Line; + end if; + + -- Bizarre error case NOT_A_RESTRICTION + + when Not_A_Restriction_Id => + raise Bad_R_Line; + end case; + + if not At_Eol then + raise Bad_R_Line; + end if; + + <> + Skip_Line; + C := Getc; + end loop; + + -- Positional restriction case + + else + Checkc (' '); + Skip_Space; + + -- Acquire information for boolean restrictions + + for R in All_Boolean_Restrictions loop + C := Getc; + + case C is when 'v' => ALIs.Table (Id).Restrictions.Violated (R) := True; Cumulative_Restrictions.Violated (R) := True; @@ -1205,44 +1385,42 @@ when others => raise Bad_R_Line; - end case; - end loop; + end case; + end loop; - -- Acquire information for parameter restrictions + -- Acquire information for parameter restrictions - for RP in All_Parameter_Restrictions loop + for RP in All_Parameter_Restrictions loop + case Getc is + when 'n' => + null; - -- Acquire restrictions pragma information + when 'r' => + ALIs.Table (Id).Restrictions.Set (RP) := True; - case Getc is - when 'n' => - null; + declare + N : constant Integer := Integer (Get_Nat); + begin + ALIs.Table (Id).Restrictions.Value (RP) := N; - when 'r' => - ALIs.Table (Id).Restrictions.Set (RP) := True; + if Cumulative_Restrictions.Set (RP) then + Cumulative_Restrictions.Value (RP) := + Integer'Min + (Cumulative_Restrictions.Value (RP), N); + else + Cumulative_Restrictions.Set (RP) := True; + Cumulative_Restrictions.Value (RP) := N; + end if; + end; - declare - N : constant Integer := Integer (Get_Nat); - begin - ALIs.Table (Id).Restrictions.Value (RP) := N; + when others => + raise Bad_R_Line; + end case; - if Cumulative_Restrictions.Set (RP) then - Cumulative_Restrictions.Value (RP) := - Integer'Min - (Cumulative_Restrictions.Value (RP), N); - else - Cumulative_Restrictions.Set (RP) := True; - Cumulative_Restrictions.Value (RP) := N; - end if; - end; + -- Acquire restrictions violations information - when others => - raise Bad_R_Line; - end case; + case Getc is - -- Acquire restrictions violations information - - case Getc is when 'n' => null; @@ -1252,7 +1430,6 @@ declare N : constant Integer := Integer (Get_Nat); - pragma Unsuppress (Overflow_Check); begin ALIs.Table (Id).Restrictions.Count (RP) := N; @@ -1261,34 +1438,47 @@ Cumulative_Restrictions.Count (RP) := Integer'Max (Cumulative_Restrictions.Count (RP), N); + else - Cumulative_Restrictions.Count (RP) := - Cumulative_Restrictions.Count (RP) + N; - end if; + declare + pragma Unsuppress (Overflow_Check); - exception - when Constraint_Error => + begin + Cumulative_Restrictions.Count (RP) := + Cumulative_Restrictions.Count (RP) + N; - -- A constraint error comes from the addition in - -- the else branch. We reset to the maximum and - -- indicate that the real value is now unknown. + exception + when Constraint_Error => - Cumulative_Restrictions.Value (RP) := Integer'Last; + -- A constraint error comes from the add. We + -- reset to the maximum and indicate that the + -- real value is now unknown. + + Cumulative_Restrictions.Value (RP) := + Integer'Last; + Cumulative_Restrictions.Unknown (RP) := True; + end; + end if; + + if Nextc = '+' then + Skipc; + ALIs.Table (Id).Restrictions.Unknown (RP) := True; Cumulative_Restrictions.Unknown (RP) := True; + end if; end; - if Nextc = '+' then - Skipc; - ALIs.Table (Id).Restrictions.Unknown (RP) := True; - Cumulative_Restrictions.Unknown (RP) := True; - end if; - when others => raise Bad_R_Line; - end case; - end loop; + end case; + end loop; - Skip_Eol; + if not At_Eol then + raise Bad_R_Line; + else + Skip_Line; + C := Getc; + end if; + end if; -- Here if error during scanning of restrictions line @@ -1296,25 +1486,29 @@ when Bad_R_Line => -- In Ignore_Errors mode, undo any changes to restrictions - -- from this unit, and continue on. + -- from this unit, and continue on, skipping remaining R + -- lines for this unit. if Ignore_Errors then Cumulative_Restrictions := Save_R; ALIs.Table (Id).Restrictions := No_Restrictions; - Skip_Eol; + loop + Skip_Eol; + C := Getc; + exit when C /= 'R'; + end loop; + -- In normal mode, this is a fatal error else Fatal_Error; end if; - end Scan_Restrictions; end if; -- Acquire additional restrictions (No_Dependence) lines if present - C := Getc; while C = 'R' loop if Ignore ('R') then Skip_Line; Index: restrict.adb =================================================================== --- restrict.adb (revision 189431) +++ restrict.adb (working copy) @@ -541,10 +541,10 @@ then null; - -- Here if restriction set, check for violation (either this is a - -- Boolean restriction, or a parameter restriction with a value of - -- zero and an unknown count, or a parameter restriction with a - -- known value that exceeds the restriction count). + -- Here if restriction set, check for violation (this is a Boolean + -- restriction, or a parameter restriction with a value of zero and an + -- unknown count, or a parameter restriction with a known value that + -- exceeds the restriction count). elsif R in All_Boolean_Restrictions or else (Restrictions.Unknown (R) @@ -768,7 +768,7 @@ ---------------------------------- -- Note: body of this function must be coordinated with list of - -- renaming declarations in Rident. + -- renaming declarations in System.Rident. function Process_Restriction_Synonyms (N : Node_Id) return Name_Id is Index: restrict.ads =================================================================== --- restrict.ads (revision 189431) +++ restrict.ads (working copy) @@ -332,10 +332,10 @@ -- exception propagation is activated. function Process_Restriction_Synonyms (N : Node_Id) return Name_Id; - -- Id is a node whose Chars field contains the name of a restriction. If it - -- is one of synonyms that we allow for historical purposes (for list see - -- Rident), then the proper official name is returned. Otherwise the Chars - -- field of the argument is returned unchanged. + -- Id is a node whose Chars field contains the name of a restriction. + -- If it is one of synonyms that we allow for historical purposes (for + -- list see System.Rident), then the proper official name is returned. + -- Otherwise the Chars field of the argument is returned unchanged. function Restriction_Active (R : All_Restrictions) return Boolean; pragma Inline (Restriction_Active); Index: s-rident.ads =================================================================== --- s-rident.ads (revision 189432) +++ s-rident.ads (working copy) @@ -30,18 +30,45 @@ ------------------------------------------------------------------------------ -- This package defines the set of restriction identifiers. It is a generic --- package that is instantiated by the binder for output of the restrictions --- structure, and is instantiated in package System.Restrictions for use at --- run-time. +-- package that is instantiated by the compiler/binder in package Rident, and +-- is instantiated in package System.Restrictions for use at run-time. -- The reason that we make this a generic package is so that in the case of --- the instantiation in the binder, we can generate normal image tables for --- the enumeration types, which are needed for diagnostic and informational --- messages as well as for identification of restrictions. At run-time we --- really do not want to waste the space for these image tables, and they are --- not needed, so we can do the instantiation under control of Discard_Names --- to remove the tables. +-- the instantiation in Rident for use at compile time and bind time, we can +-- generate normal image tables for the enumeration types, which are needed +-- for diagnostic and informational messages. At run-time we really do not +-- want to waste the space for these image tables, and they are not needed, +-- so we can do the instantiation under control of Discard_Names to remove +-- the tables. +--------------------------------------------------- +-- Note On Compile/Run-Time Consistency Checking -- +--------------------------------------------------- + +-- This unit is with'ed by the run-time (to make System.Restrictions which is +-- used for run-time access to restriction information), by the compiler (to +-- determine what restrictions are implemented and what their category is) and +-- by the binder (in processing ali files, and generating the information used +-- at run-time to access restriction information). + +-- Normally the version of System.Rident referenced in all three contexts +-- should be the same. However, problems could arise in certain inconsistent +-- builds that used inconsistent versions of the compiler and run-time. This +-- sort of thing is not strictly correct, but it does arise when short-cuts +-- are taken in build procedures. + +-- Previously, this kind of inconsistency could cause a significant problem. +-- If versions of System.Rident accessed by the compiler and binder differed, +-- then the binder could fail to recognize the R (restrictions line) in the +-- ali file, leading to bind errors when restrictions were added or removed. + +-- The latest implementation avoids both this problem by using a named +-- scheme for recording restrictions, rather than a positional scheme which +-- fails completely if restrictions are added or subtracted. Now the worst +-- that happens at bind time in incosistent builds is that unrecognized +-- restrictions are ignored, and the consistency checking for restrictions +-- might be incomplete, which is no big deal. + pragma Compiler_Unit; generic Index: rident.ads =================================================================== --- rident.ads (revision 189431) +++ rident.ads (working copy) @@ -34,416 +34,16 @@ -- it can be used by the binder without dragging in unneeded compiler -- packages. -package Rident is +-- Note: the actual definitions of the types are in package System.Rident, +-- and this package is merely an instantiation of that package. The point +-- of this level of generic indirection is to allow the compile time use +-- to have the image tables available (this package is not compiled with +-- Discard_Names), while at run-time we do not want those image tables. - -- The following enumeration type defines the set of restriction - -- identifiers that are implemented in GNAT. +-- Rather than have clients instantiate System.Rident directly, we have the +-- single instantiation here at the library level, which means that we only +-- have one copy of the image tables - -- To add a new restriction identifier, add an entry with the name to be - -- used in the pragma, and add calls to the Restrict.Check_Restriction - -- routine as appropriate. +with System.Rident; - type Restriction_Id is - - -- The following cases are checked for consistency in the binder. The - -- binder will check that every unit either has the restriction set, or - -- does not violate the restriction. - - (Simple_Barriers, -- GNAT (Ravenscar) - No_Abort_Statements, -- (RM D.7(5), H.4(3)) - No_Access_Subprograms, -- (RM H.4(17)) - No_Allocators, -- (RM H.4(7)) - No_Allocators_After_Elaboration, -- Ada 2012 (RM D.7(19.1/2)) - No_Anonymous_Allocators, -- Ada 2012 (RM H.4(8/1)) - No_Asynchronous_Control, -- (RM D.7(10)) - No_Calendar, -- GNAT - No_Default_Stream_Attributes, -- Ada 2012 (RM 13.12.1(4/2)) - No_Delay, -- (RM H.4(21)) - No_Direct_Boolean_Operators, -- GNAT - No_Dispatch, -- (RM H.4(19)) - No_Dispatching_Calls, -- GNAT - No_Dynamic_Attachment, -- GNAT - No_Dynamic_Priorities, -- (RM D.9(9)) - No_Enumeration_Maps, -- GNAT - No_Entry_Calls_In_Elaboration_Code, -- GNAT - No_Entry_Queue, -- GNAT (Ravenscar) - No_Exception_Handlers, -- GNAT - No_Exception_Propagation, -- GNAT - No_Exception_Registration, -- GNAT - No_Exceptions, -- (RM H.4(12)) - No_Finalization, -- GNAT - No_Fixed_Point, -- (RM H.4(15)) - No_Floating_Point, -- (RM H.4(14)) - No_IO, -- (RM H.4(20)) - No_Implicit_Conditionals, -- GNAT - No_Implicit_Dynamic_Code, -- GNAT - No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3)) - No_Implicit_Loops, -- GNAT - No_Initialize_Scalars, -- GNAT - No_Local_Allocators, -- (RM H.4(8)) - No_Local_Timing_Events, -- (RM D.7(10.2/2)) - No_Local_Protected_Objects, -- GNAT - No_Nested_Finalization, -- (RM D.7(4)) - No_Protected_Type_Allocators, -- GNAT - No_Protected_Types, -- (RM H.4(5)) - No_Recursion, -- (RM H.4(22)) - No_Reentrancy, -- (RM H.4(23)) - No_Relative_Delay, -- GNAT (Ravenscar) - No_Requeue_Statements, -- GNAT - No_Secondary_Stack, -- GNAT - No_Select_Statements, -- GNAT (Ravenscar) - No_Specific_Termination_Handlers, -- (RM D.7(10.7/2)) - No_Standard_Storage_Pools, -- GNAT - No_Stream_Optimizations, -- GNAT - No_Streams, -- GNAT - No_Task_Allocators, -- (RM D.7(7)) - No_Task_Attributes_Package, -- GNAT - No_Task_Hierarchy, -- (RM D.7(3), H.4(3)) - No_Task_Termination, -- GNAT (Ravenscar) - No_Tasking, -- GNAT - No_Terminate_Alternatives, -- (RM D.7(6)) - No_Unchecked_Access, -- (RM H.4(18)) - No_Unchecked_Conversion, -- (RM H.4(16)) - No_Unchecked_Deallocation, -- (RM H.4(9)) - Static_Priorities, -- GNAT - Static_Storage_Size, -- GNAT - - -- The following require consistency checking with special rules. See - -- individual routines in unit Bcheck for details of what is required. - - No_Default_Initialization, -- GNAT - - -- The following cases do not require consistency checking and if used - -- as a configuration pragma within a specific unit, apply only to that - -- unit (e.g. if used in the package spec, do not apply to the body) - - -- Note: No_Elaboration_Code is handled specially. Like the other - -- non-partition-wide restrictions, it can only be set in a unit that - -- is part of the extended main source unit (body/spec/subunits). But - -- it is sticky, in that if it is found anywhere within any of these - -- units, it applies to all units in this extended main source. - - Immediate_Reclamation, -- (RM H.4(10)) - No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241 - No_Implementation_Attributes, -- Ada 2005 AI-257 - No_Implementation_Identifiers, -- Ada 2012 AI-246 - No_Implementation_Pragmas, -- Ada 2005 AI-257 - No_Implementation_Restrictions, -- GNAT - No_Implementation_Units, -- Ada 2012 AI-242 - No_Implicit_Aliasing, -- GNAT - No_Elaboration_Code, -- GNAT - No_Obsolescent_Features, -- Ada 2005 AI-368 - No_Wide_Characters, -- GNAT - SPARK, -- GNAT - - -- The following cases require a parameter value - - -- The following entries are fully checked at compile/bind time, which - -- means that the compiler can in general tell the minimum value which - -- could be used with a restrictions pragma. The binder can deduce the - -- appropriate minimum value for the partition by taking the maximum - -- value required by any unit. - - Max_Protected_Entries, -- (RM D.7(14)) - Max_Select_Alternatives, -- (RM D.7(12)) - Max_Task_Entries, -- (RM D.7(13), H.4(3)) - - -- The following entries are also fully checked at compile/bind time, - -- and the compiler can also at least in some cases tell the minimum - -- value which could be used with a restriction pragma. The difference - -- is that the contributions are additive, so the binder deduces this - -- value by adding the unit contributions. - - Max_Tasks, -- (RM D.7(19), H.4(3)) - - -- The following entries are checked at compile time only for zero/ - -- nonzero entries. This means that the compiler can tell at compile - -- time if a restriction value of zero is (would be) violated, but that - -- the compiler cannot distinguish between different non-zero values. - - Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3)) - Max_Entry_Queue_Length, -- GNAT - - -- The remaining entries are not checked at compile/bind time - - Max_Storage_At_Blocking, -- (RM D.7(17)) - - Not_A_Restriction_Id); - - -- Synonyms permitted for historical purposes of compatibility. - -- Must be coordinated with Restrict.Process_Restriction_Synonym. - - Boolean_Entry_Barriers : Restriction_Id renames Simple_Barriers; - Max_Entry_Queue_Depth : Restriction_Id renames Max_Entry_Queue_Length; - No_Dynamic_Interrupts : Restriction_Id renames No_Dynamic_Attachment; - No_Requeue : Restriction_Id renames No_Requeue_Statements; - No_Task_Attributes : Restriction_Id renames No_Task_Attributes_Package; - - subtype All_Restrictions is Restriction_Id range - Simple_Barriers .. Max_Storage_At_Blocking; - -- All restrictions (excluding only Not_A_Restriction_Id) - - subtype All_Boolean_Restrictions is Restriction_Id range - Simple_Barriers .. SPARK; - -- All restrictions which do not take a parameter - - subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range - Simple_Barriers .. Static_Storage_Size; - -- Boolean restrictions that are checked for partition consistency. - -- Note that all parameter restrictions are checked for partition - -- consistency by default, so this distinction is only needed in the - -- case of Boolean restrictions. - - subtype Cunit_Boolean_Restrictions is All_Boolean_Restrictions range - Immediate_Reclamation .. SPARK; - -- Boolean restrictions that are not checked for partition consistency - -- and that thus apply only to the current unit. Note that for these - -- restrictions, the compiler does not apply restrictions found in - -- with'ed units, parent specs etc. to the main unit, and vice versa. - - subtype All_Parameter_Restrictions is - Restriction_Id range - Max_Protected_Entries .. Max_Storage_At_Blocking; - -- All restrictions that take a parameter - - subtype Checked_Parameter_Restrictions is - All_Parameter_Restrictions range - Max_Protected_Entries .. Max_Entry_Queue_Length; - -- These are the parameter restrictions that can be at least partially - -- checked at compile/binder time. Minimally, the compiler can detect - -- violations of a restriction pragma with a value of zero reliably. - - subtype Checked_Max_Parameter_Restrictions is - Checked_Parameter_Restrictions range - Max_Protected_Entries .. Max_Task_Entries; - -- Restrictions with parameters that can be checked in some cases by - -- maximizing among statically detected instances where the compiler - -- can determine the count. - - subtype Checked_Add_Parameter_Restrictions is - Checked_Parameter_Restrictions range - Max_Tasks .. Max_Tasks; - -- Restrictions with parameters that can be checked in some cases by - -- summing the statically detected instances where the compiler can - -- determine the count. - - subtype Checked_Val_Parameter_Restrictions is - Checked_Parameter_Restrictions range - Max_Protected_Entries .. Max_Tasks; - -- Restrictions with parameter where the count is known at least in some - -- cases by the compiler/binder. - - subtype Checked_Zero_Parameter_Restrictions is - Checked_Parameter_Restrictions range - Max_Asynchronous_Select_Nesting .. Max_Entry_Queue_Length; - -- Restrictions with parameters where the compiler can detect the use of - -- the feature, and hence violations of a restriction specifying a value - -- of zero, but cannot detect specific values other than zero/nonzero. - - subtype Unchecked_Parameter_Restrictions is - All_Parameter_Restrictions range - Max_Storage_At_Blocking .. Max_Storage_At_Blocking; - -- Restrictions with parameters where the compiler cannot ever detect - -- corresponding compile time usage, so the binder and compiler never - -- detect violations of any restriction. - - ------------------------------------- - -- Restriction Status Declarations -- - ------------------------------------- - - -- The following declarations are used to record the current status or - -- restrictions (for the current unit, or related units, at compile time, - -- and for all units in a partition at bind time or run time). - - type Restriction_Flags is array (All_Restrictions) of Boolean; - type Restriction_Values is array (All_Parameter_Restrictions) of Natural; - type Parameter_Flags is array (All_Parameter_Restrictions) of Boolean; - - type Restrictions_Info is record - Set : Restriction_Flags; - -- An entry is True in the Set array if a restrictions pragma has been - -- encountered for the given restriction. If the value is True for a - -- parameter restriction, then the corresponding entry in the Value - -- array gives the minimum value encountered for any such restriction. - - Value : Restriction_Values; - -- If the entry for a parameter restriction in Set is True (i.e. a - -- restrictions pragma for the restriction has been encountered), then - -- the corresponding entry in the Value array is the minimum value - -- specified by any such restrictions pragma. Note that a restrictions - -- pragma specifying a value greater than Int'Last is simply ignored. - - Violated : Restriction_Flags; - -- An entry is True in the violations array if the compiler has detected - -- a violation of the restriction. For a parameter restriction, the - -- Count and Unknown arrays have additional information. - - Count : Restriction_Values; - -- If an entry for a parameter restriction is True in Violated, the - -- corresponding entry in the Count array may record additional - -- information. If the actual minimum count is known (by taking - -- maximums, or sums, depending on the restriction), it will be - -- recorded in this array. If not, then the value will remain zero. - -- The value is also zero for a non-violated restriction. - - Unknown : Parameter_Flags; - -- If an entry for a parameter restriction is True in Violated, the - -- corresponding entry in the Unknown array may record additional - -- information. If the actual count is not known by the compiler (but - -- is known to be non-zero), then the entry in Unknown will be True. - -- This indicates that the value in Count is not known to be exact, - -- and the actual violation count may be higher. - - -- Note: If Violated (K) is True, then either Count (K) > 0 or - -- Unknown (K) = True. It is possible for both these to be set. - -- For example, if Count (K) = 3 and Unknown (K) is True, it means - -- that the actual violation count is at least 3 but might be higher. - end record; - - No_Restrictions : constant Restrictions_Info := - (Set => (others => False), - Value => (others => 0), - Violated => (others => False), - Count => (others => 0), - Unknown => (others => False)); - -- Used to initialize Restrictions_Info variables - - ---------------------------------- - -- Profile Definitions and Data -- - ---------------------------------- - - -- Note: to add a profile, modify the following declarations appropriately, - -- add Name_xxx to Snames, and add a branch to the conditions for pragmas - -- Profile and Profile_Warnings in the body of Sem_Prag. - - type Profile_Name is - (No_Profile, - No_Implementation_Extensions, - Ravenscar, - Restricted); - -- Names of recognized profiles. No_Profile is used to indicate that a - -- restriction came from pragma Restrictions[_Warning], as opposed to - -- pragma Profile[_Warning]. - - subtype Profile_Name_Actual is Profile_Name - range No_Implementation_Extensions .. Restricted; - -- Actual used profile names - - type Profile_Data is record - Set : Restriction_Flags; - -- Set to True if given restriction must be set for the profile, and - -- False if it need not be set (False does not mean that it must not be - -- set, just that it need not be set). If the flag is True for a - -- parameter restriction, then the Value array gives the maximum value - -- permitted by the profile. - - Value : Restriction_Values; - -- An entry in this array is meaningful only if the corresponding flag - -- in Set is True. In that case, the value in this array is the maximum - -- value of the parameter permitted by the profile. - end record; - - Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := - - (No_Implementation_Extensions => - -- Restrictions for Restricted profile - - (Set => - (No_Implementation_Aspect_Specifications => True, - No_Implementation_Attributes => True, - No_Implementation_Identifiers => True, - No_Implementation_Pragmas => True, - No_Implementation_Units => True, - others => False), - - -- Value settings for Restricted profile (none - - Value => - (others => 0)), - - -- Restricted Profile - - Restricted => - - -- Restrictions for Restricted profile - - (Set => - (No_Abort_Statements => True, - No_Asynchronous_Control => True, - No_Dynamic_Attachment => True, - No_Dynamic_Priorities => True, - No_Entry_Queue => True, - No_Local_Protected_Objects => True, - No_Protected_Type_Allocators => True, - No_Requeue_Statements => True, - No_Task_Allocators => True, - No_Task_Attributes_Package => True, - No_Task_Hierarchy => True, - No_Terminate_Alternatives => True, - Max_Asynchronous_Select_Nesting => True, - Max_Protected_Entries => True, - Max_Select_Alternatives => True, - Max_Task_Entries => True, - others => False), - - -- Value settings for Restricted profile - - Value => - (Max_Asynchronous_Select_Nesting => 0, - Max_Protected_Entries => 1, - Max_Select_Alternatives => 0, - Max_Task_Entries => 0, - others => 0)), - - -- Ravenscar Profile - - -- Note: the table entries here only represent the - -- required restriction profile for Ravenscar. The - -- full Ravenscar profile also requires: - - -- pragma Dispatching_Policy (FIFO_Within_Priorities); - -- pragma Locking_Policy (Ceiling_Locking); - -- pragma Detect_Blocking - - Ravenscar => - - -- Restrictions for Ravenscar = Restricted profile .. - - (Set => - (No_Abort_Statements => True, - No_Asynchronous_Control => True, - No_Dynamic_Attachment => True, - No_Dynamic_Priorities => True, - No_Entry_Queue => True, - No_Local_Protected_Objects => True, - No_Protected_Type_Allocators => True, - No_Requeue_Statements => True, - No_Task_Allocators => True, - No_Task_Attributes_Package => True, - No_Task_Hierarchy => True, - No_Terminate_Alternatives => True, - Max_Asynchronous_Select_Nesting => True, - Max_Protected_Entries => True, - Max_Select_Alternatives => True, - Max_Task_Entries => True, - - -- plus these additional restrictions: - - No_Calendar => True, - No_Implicit_Heap_Allocations => True, - No_Relative_Delay => True, - No_Select_Statements => True, - No_Task_Termination => True, - Simple_Barriers => True, - others => False), - - -- Value settings for Ravenscar (same as Restricted) - - Value => - (Max_Asynchronous_Select_Nesting => 0, - Max_Protected_Entries => 1, - Max_Select_Alternatives => 0, - Max_Task_Entries => 0, - others => 0))); - -end Rident; +package Rident is new System.Rident;