home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / s-valrea.adb < prev    next >
Text File  |  1996-09-28  |  10KB  |  309 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                      S Y S T E M . V A L _ R E A L                       --
  6. --                                                                          --
  7. --                                 S p e c                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.8 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with System.Powten_Table; use System.Powten_Table;
  27. with System.Val_Util;     use System.Val_Util;
  28.  
  29. package body System.Val_Real is
  30.  
  31.    ---------------
  32.    -- Scan_Real --
  33.    ---------------
  34.  
  35.    function Scan_Real
  36.      (Str  : String;
  37.       Ptr  : access Positive'Base;
  38.       Max  : Positive'Base)
  39.       return Long_Long_Float
  40.    is
  41.       P : Positive'Base;
  42.       --  Local copy of string pointer
  43.  
  44.       Base   : Long_Long_Float;
  45.       --  Base value
  46.  
  47.       Uval : Long_Long_Float;
  48.       --  Accumulated float result
  49.  
  50.       subtype Digs is Character range '0' .. '9';
  51.       --  Used to check for decimal digit
  52.  
  53.       Scale : Integer := 0;
  54.       --  Power of Base to multiply result by
  55.  
  56.       Start : Positive;
  57.       --  Position of starting non-blank character
  58.  
  59.       Minus : Boolean;
  60.       --  Set to True if minus sign is present, otherwise to False
  61.  
  62.       Bad_Base : Boolean := False;
  63.       --  Set True if Base out of range or if out of range digit
  64.  
  65.       After_Point : Natural := 0;
  66.       --  Set to 1 after the point
  67.  
  68.       procedure Scanf;
  69.       --  Scans integer literal value starting at current character position.
  70.       --  For each digit encountered, Uval is multiplied by 10.0, and the new
  71.       --  digit value is incremented. In addition Scale is decremented for each
  72.       --  digit encountered if we are after the point (After_Point = 1). The
  73.       --  longest possible syntactically valid numeral is scanned out, and on
  74.       --  return P points past the last character. On entry, the current
  75.       --  character is known to be a digit, so a numeral is definitely present.
  76.  
  77.       procedure Scanf is
  78.          Digit : Natural;
  79.  
  80.       begin
  81.          loop
  82.             Digit := Character'Pos (Str (P)) - Character'Pos ('0');
  83.             Uval := Uval * 10.0 + Long_Long_Float (Digit);
  84.             P := P + 1;
  85.             Scale := Scale - After_Point;
  86.  
  87.             --  Done if end of input field
  88.  
  89.             if P > Max then
  90.                return;
  91.  
  92.             --  Check next character
  93.  
  94.             elsif Str (P) not in Digs then
  95.                if Str (P) = '_' then
  96.                   Scan_Underscore (Str, P, Ptr, Max, False);
  97.                else
  98.                   return;
  99.                end if;
  100.             end if;
  101.          end loop;
  102.       end Scanf;
  103.  
  104.    --  Start of processing for System.Scan_Real
  105.  
  106.    begin
  107.       Scan_Sign (Str, Ptr, Max, Minus, Start);
  108.       P := Ptr.all;
  109.       Ptr.all := Start;
  110.  
  111.       --  If digit, scan numeral before point
  112.  
  113.       if Str (P) in Digs then
  114.          Uval := 0.0;
  115.          Scanf;
  116.  
  117.       --  Initial point, allowed only if followed by digit (RM 3.5(47))
  118.  
  119.       elsif Str (P) = '.'
  120.         and then P < Max
  121.         and then Str (P + 1) in Digs
  122.       then
  123.          Uval := 0.0;
  124.  
  125.       --  Any other initial character is an error
  126.  
  127.       else
  128.          raise Constraint_Error;
  129.       end if;
  130.  
  131.       --  Deal with based case
  132.  
  133.       if P < Max and then (Str (P) = ':' or else Str (P) = '#') then
  134.          declare
  135.             Base_Char : constant Character := Str (P);
  136.             Digit     : Natural;
  137.             Fdigit    : Long_Long_Float;
  138.  
  139.          begin
  140.             if Uval < 2.0 or else Uval > 16.0 then
  141.                Bad_Base := True;
  142.             end if;
  143.  
  144.             Base := Uval;
  145.             Uval := 0.0;
  146.             P := P + 1;
  147.  
  148.             --  Special check to allow initial point (RM 3.5(49))
  149.  
  150.             if Str (P) = '.' then
  151.                After_Point := 1;
  152.                P := P + 1;
  153.             end if;
  154.  
  155.             --  Loop to scan digits of based number. On entry to the loop we
  156.             --  must have a valid digit. If we don't, then we have an illegal
  157.             --  floating-point value, and we raise Constraint_Error, note that
  158.             --  Ptr at this stage was reset to the proper (Start) value.
  159.  
  160.             loop
  161.                if P > Max then
  162.                   raise Constraint_Error;
  163.  
  164.                elsif Str (P) in Digs then
  165.                   Digit := Character'Pos (Str (P)) - Character'Pos ('0');
  166.  
  167.                elsif Str (P) in 'A' .. 'F' then
  168.                   Digit :=
  169.                     Character'Pos (Str (P)) - (Character'Pos ('A') - 10);
  170.  
  171.                elsif Str (P) in 'a' .. 'f' then
  172.                   Digit :=
  173.                     Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
  174.  
  175.                else
  176.                   raise Constraint_Error;
  177.                end if;
  178.  
  179.                P := P + 1;
  180.                Fdigit := Long_Long_Float (Digit);
  181.  
  182.                if Fdigit >= Base then
  183.                   Bad_Base := True;
  184.                else
  185.                   Scale := Scale - After_Point;
  186.                   Uval := Uval * Base + Fdigit;
  187.                end if;
  188.  
  189.                if P > Max then
  190.                   raise Constraint_Error;
  191.  
  192.                elsif Str (P) = '_' then
  193.                   Scan_Underscore (Str, P, Ptr, Max, True);
  194.  
  195.                else
  196.                   --  Skip past period after digit. Note that the processing
  197.                   --  here will permit either a digit after the period, or the
  198.                   --  terminating base character, as allowed in (RM 3.5(48))
  199.  
  200.                   if Str (P) = '.' and then After_Point = 0 then
  201.                      P := P + 1;
  202.                      After_Point := 1;
  203.  
  204.                      if P > Max then
  205.                         raise Constraint_Error;
  206.                      end if;
  207.                   end if;
  208.  
  209.                   --  Terminating base character is recognized only if it
  210.                   --  appears after a point, otherwise it is illegal
  211.  
  212.                   exit when Str (P) = Base_Char and then After_Point = 1;
  213.                end if;
  214.             end loop;
  215.  
  216.             --  Based number successfully scanned out (point was found)
  217.  
  218.             Ptr.all := P + 1;
  219.          end;
  220.  
  221.       --  Non-based case, check for being at decimal point now. Note that
  222.       --  in Ada 95, we do not insist on a decimal point being present
  223.  
  224.       else
  225.          Base := 10.0;
  226.          After_Point := 1;
  227.  
  228.          if Str (P) = '.' then
  229.             P := P + 1;
  230.  
  231.             --  Scan digits after point if any are present (RM 3.5(46))
  232.  
  233.             if P <= Max and then Str (P) in Digs then
  234.                Scanf;
  235.             end if;
  236.          end if;
  237.  
  238.          Ptr.all := P;
  239.       end if;
  240.  
  241.       --  At this point, we have Uval containing the digits of the value as
  242.       --  an integer, and Scale indicates the negative of the number of digits
  243.       --  after the point. Base contains the base value (an integral value in
  244.       --  the range 2.0 .. 16.0). Test for exponent, must be at least one
  245.       --  character after the E for the exponent to be valid.
  246.  
  247.       Scale := Scale + Scan_Exponent (Str, Ptr, Max, Real => True);
  248.  
  249.       --  At this point the exponent has been scanned if one is present and
  250.       --  Scale is adjusted to include the exponent value. Uval contains the
  251.       --  the integral value which is to be multiplied by Base ** Scale.
  252.  
  253.       --  If base is not 10, use exponentiation for scaling
  254.  
  255.       if Base /= 10.0 then
  256.          Uval := Uval * Base ** Scale;
  257.  
  258.       --  For base 10, use power of ten table if in range
  259.  
  260.       elsif Scale > 0 then
  261.          if Scale > Powten'Length then
  262.             Uval := Uval * 10.0 ** Scale;
  263.          else
  264.             Uval := Uval * Powten (Scale);
  265.          end if;
  266.  
  267.       elsif Scale < 0 then
  268.          if (-Scale) > Powten'Length then
  269.             Uval := Uval * 10.0 ** Scale;
  270.          else
  271.             Uval := Uval / Powten (-Scale);
  272.          end if;
  273.       end if;
  274.  
  275.       --  Here is where we check for a bad based number
  276.  
  277.       if Bad_Base then
  278.          raise Constraint_Error;
  279.  
  280.       --  If OK, then deal with initial minus sign, note that this processing
  281.       --  is done even if Uval is zero, so that -0.0 is correctly interpreted.
  282.  
  283.       else
  284.          if Minus then
  285.             return -Uval;
  286.          else
  287.             return Uval;
  288.          end if;
  289.       end if;
  290.  
  291.    end Scan_Real;
  292.  
  293.    ----------------
  294.    -- Value_Real --
  295.    ----------------
  296.  
  297.    function Value_Real (Str : String) return Long_Long_Float is
  298.       V : Long_Long_Float;
  299.       P : aliased Natural := Str'First;
  300.  
  301.    begin
  302.       V := Scan_Real (Str, P'Access, Str'Last);
  303.       Scan_Trailing_Blanks (Str, P);
  304.       return V;
  305.  
  306.    end Value_Real;
  307.  
  308. end System.Val_Real;
  309.