| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- S Y S T E M . W I D T H _ I -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; |
| use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; |
| |
| function System.Width_I (Lo, Hi : Int) return Natural is |
| |
| -- Ghost code, loop invariants and assertions in this unit are meant for |
| -- analysis only, not for run-time checking, as it would be too costly |
| -- otherwise. This is enforced by setting the assertion policy to Ignore. |
| |
| pragma Assertion_Policy (Ghost => Ignore, |
| Loop_Invariant => Ignore, |
| Assert => Ignore); |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| package Signed_Conversion is new Signed_Conversions (Int => Int); |
| |
| function Big (Arg : Int) return Big_Integer renames |
| Signed_Conversion.To_Big_Integer; |
| |
| -- Maximum value of exponent for 10 that fits in Uns'Base |
| function Max_Log10 return Natural is |
| (case Int'Base'Size is |
| when 8 => 2, |
| when 16 => 4, |
| when 32 => 9, |
| when 64 => 19, |
| when 128 => 38, |
| when others => raise Program_Error) |
| with Ghost; |
| |
| ------------------ |
| -- Local Lemmas -- |
| ------------------ |
| |
| procedure Lemma_Lower_Mult (A, B, C : Big_Natural) |
| with |
| Ghost, |
| Pre => A <= B, |
| Post => A * C <= B * C; |
| |
| procedure Lemma_Div_Commutation (X, Y : Int) |
| with |
| Ghost, |
| Pre => X >= 0 and Y > 0, |
| Post => Big (X) / Big (Y) = Big (X / Y); |
| |
| procedure Lemma_Div_Twice (X : Big_Natural; Y, Z : Big_Positive) |
| with |
| Ghost, |
| Post => X / Y / Z = X / (Y * Z); |
| |
| ---------------------- |
| -- Lemma_Lower_Mult -- |
| ---------------------- |
| |
| procedure Lemma_Lower_Mult (A, B, C : Big_Natural) is null; |
| |
| --------------------------- |
| -- Lemma_Div_Commutation -- |
| --------------------------- |
| |
| procedure Lemma_Div_Commutation (X, Y : Int) is null; |
| |
| --------------------- |
| -- Lemma_Div_Twice -- |
| --------------------- |
| |
| procedure Lemma_Div_Twice (X : Big_Natural; Y, Z : Big_Positive) is |
| XY : constant Big_Natural := X / Y; |
| YZ : constant Big_Natural := Y * Z; |
| XYZ : constant Big_Natural := X / Y / Z; |
| R : constant Big_Natural := (XY rem Z) * Y + (X rem Y); |
| begin |
| pragma Assert (X = XY * Y + (X rem Y)); |
| pragma Assert (XY = XY / Z * Z + (XY rem Z)); |
| pragma Assert (X = XYZ * YZ + R); |
| pragma Assert ((XY rem Z) * Y <= (Z - 1) * Y); |
| pragma Assert (R <= YZ - 1); |
| pragma Assert (X / YZ = (XYZ * YZ + R) / YZ); |
| pragma Assert (X / YZ = XYZ + R / YZ); |
| end Lemma_Div_Twice; |
| |
| -- Local variables |
| |
| W : Natural; |
| T : Int; |
| |
| -- Local ghost variables |
| |
| Max_W : constant Natural := Max_Log10 with Ghost; |
| Big_10 : constant Big_Integer := Big (10) with Ghost; |
| |
| Pow : Big_Integer := 1 with Ghost; |
| T_Init : constant Int := |
| Int'Max (abs (Int'Max (Lo, Int'First + 1)), |
| abs (Int'Max (Hi, Int'First + 1))) |
| with Ghost; |
| |
| -- Start of processing for System.Width_I |
| |
| begin |
| if Lo > Hi then |
| return 0; |
| |
| else |
| -- Minimum value is 2, one for sign, one for digit |
| |
| W := 2; |
| |
| -- Get max of absolute values, but avoid bomb if we have the maximum |
| -- negative number (note that First + 1 has same digits as First) |
| |
| T := Int'Max ( |
| abs (Int'Max (Lo, Int'First + 1)), |
| abs (Int'Max (Hi, Int'First + 1))); |
| |
| -- Increase value if more digits required |
| |
| while T >= 10 loop |
| Lemma_Div_Commutation (T, 10); |
| Lemma_Div_Twice (Big (T_Init), Big_10 ** (W - 2), Big_10); |
| |
| T := T / 10; |
| W := W + 1; |
| Pow := Pow * 10; |
| |
| pragma Loop_Invariant (T >= 0); |
| pragma Loop_Invariant (W in 3 .. Max_W + 3); |
| pragma Loop_Invariant (Pow = Big_10 ** (W - 2)); |
| pragma Loop_Invariant (Big (T) = Big (T_Init) / Pow); |
| pragma Loop_Variant (Decreases => T); |
| end loop; |
| |
| declare |
| F : constant Big_Integer := Big_10 ** (W - 2) with Ghost; |
| Q : constant Big_Integer := Big (T_Init) / F with Ghost; |
| R : constant Big_Integer := Big (T_Init) rem F with Ghost; |
| begin |
| pragma Assert (Q < Big_10); |
| pragma Assert (Big (T_Init) = Q * F + R); |
| Lemma_Lower_Mult (Q, Big (9), F); |
| pragma Assert (Big (T_Init) <= Big (9) * F + F - 1); |
| pragma Assert (Big (T_Init) < Big_10 * F); |
| pragma Assert (Big_10 * F = Big_10 ** (W - 1)); |
| end; |
| |
| -- This is an expression of the functional postcondition for Width_I, |
| -- which cannot be expressed readily as a postcondition as this would |
| -- require making the instantiation Signed_Conversion and function Big |
| -- available from the spec. |
| |
| pragma Assert (Big (Int'Max (Lo, Int'First + 1)) < Big_10 ** (W - 1)); |
| pragma Assert (Big (Int'Max (Hi, Int'First + 1)) < Big_10 ** (W - 1)); |
| |
| return W; |
| end if; |
| |
| end System.Width_I; |
