+ support for specifying the minimal precision for floating point

constants. The default is currently 32 bits/single, which corresponds
    to the old behaviour (constants which cannot be exactly represented
    in the default/chosen precision will also still be automatically
    upgraded to higher precision). Supported constructs:
   * Command line switch -CF<x>
   * Compiler directive {$MINFPCONSTPREC <x>}
  whereby in both cases <x> can be default, 32 or 64. 80 is not supported
  because there is no generic way to figure out whether the current target
  actually supports 80 bit precision floating point calculations while
  parsing the command line switches (pbestreal can still change in case of
  win64 or -Cfsse2)

git-svn-id: trunk@8349 -

.gitattributes

@@ -8343,6 +8343,8 @@ tests/webtbs/tw8633.pp svneol=native#text/plain
 tests/webtbs/tw8660.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/tw8677.pp svneol=native#text/plain
+tests/webtbs/tw8678.pp svneol=native#text/plain
+tests/webtbs/tw8678a.pp svneol=native#text/plain
 tests/webtbs/tw8685.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/tw8777f.pp svneol=native#text/plain

compiler/globals.pas

@@ -125,6 +125,8 @@ interface
 
          packrecords     : shortint;
          maxfpuregisters : shortint;
+
+         minfpconstprec  : tfloattype;
        end;
 
     const
@@ -334,6 +336,7 @@ interface
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
     function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
     function IncludeFeature(const s : string) : boolean;
+    function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
 
     {# Routine to get the required alignment for size of data, which will
        be placed in bss segment, according to the current alignment requirements }
@@ -983,6 +986,32 @@ implementation
       end;
 
 
+    function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
+      var
+        value, error: longint;
+      begin
+        if (upper(s)='DEFAULT') then
+          begin
+            a:=s32real;
+            result:=true;
+            exit;
+          end;
+        result:=false;
+        val(s,value,error);
+        if (error<>0) then
+          exit;
+        case value of
+          32: a:=s32real;
+          64: a:=s64real;
+          { adding support for 80 bit here is tricky, since we can't really }
+          { check whether the target cpu+OS actually supports it            }
+          else
+            exit;
+        end;
+        result:=true;
+      end;
+
+
     function var_align(siz: longint): shortint;
       begin
         siz := size_2_align(siz);
@@ -1145,6 +1174,7 @@ implementation
         init_settings.packenum:=4;
         init_settings.setalloc:=0;
         fillchar(init_settings.alignment,sizeof(talignmentinfo),0);
+        init_settings.minfpconstprec:=s32real;
         { might be overridden later }
         init_settings.asmmode:=asmmode_standard;
         init_settings.cputype:=cpu_none;

compiler/globtype.pas

@@ -325,6 +325,13 @@ interface
        );
        tprocinfoflags=set of tprocinfoflag;
 
+    type
+      { float types }
+      tfloattype = (
+        s32real,s64real,s80real,
+        s64comp,s64currency,s128real
+      );
+
     type
        TIDString = string[maxidlen];
 
@@ -360,7 +367,7 @@ interface
     const
        { link options }
        link_none    = $0;
-       link_always = $1;
+       link_always  = $1;
        link_static  = $2;
        link_smart   = $4;
        link_shared  = $8;

compiler/msg/errore.msg

@@ -352,6 +352,8 @@ scan_w_unsupported_switch_by_target=02082_W_The switch "$1" is not supported by
 % Some compiler switches like \$E are not supported by all targets.
 scan_w_frameworks_darwin_only=02084_W_Framework-related options are only supported for Darwin/Mac OS X
 % Frameworks are not a known concept, or at least not supported by FPC, on operating systems other than Darwin/Mac OS X.
+scan_e_illegal_minfpconstprec=02085_E_Illegal minimal floating point constant precision "$1"
+% Valid minimal precisions for floating point constants are default, 32 and 64, which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision.
 % \end{description}
 #
 # Parser
@@ -2497,6 +2499,7 @@ S*2Aas_Assemble using GNU AS
 **2CD_Create also dynamic library (not supported)
 **2Ce_Compilation with emulated floating point opcodes
 **2Cf<x>_Select fpu instruction set to use, see fpc -i for possible values
+**2CF<x>_Minimal floating point constant precision (default, 32, 64)
 **2Cg_Generate PIC code
 **2Ch<n>_<n> bytes heap (between 1023 and 67107840)
 **2Ci_IO-checking

compiler/msgidx.inc

@@ -104,6 +104,7 @@ const
   scan_w_pic_ignored=02081;
   scan_w_unsupported_switch_by_target=02082;
   scan_w_frameworks_darwin_only=02084;
+  scan_e_illegal_minfpconstprec=02085;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -730,9 +731,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 44907;
+  MsgTxtSize = 45039;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,85,237,83,63,49,107,22,135,60,
+    24,86,237,83,63,49,107,22,135,60,
     42,1,1,1,1,1,1,1,1,1
   );

compiler/pexpr.pas

@@ -2414,9 +2414,11 @@ implementation
                 end;
                consume(_REALNUMBER);
 {$ifdef FPC_REAL2REAL_FIXED}
-               if (d = single(d)) then
+               if (current_settings.minfpconstprec=s32real) and
+                  (d = single(d)) then
                  p1:=crealconstnode.create(d,s32floattype)
-               else if (d = double(d)) then
+               else if (current_settings.minfpconstprec=s64real) and
+                       (d = double(d)) then
                  p1:=crealconstnode.create(d,s64floattype)
                else
 {$endif FPC_REAL2REAL_FIXED}

compiler/scandir.pas

@@ -824,6 +824,15 @@ implementation
          end;
       end;
 
+
+    procedure dir_minfpconstprec;
+      begin
+        current_scanner.skipspace;
+        if not SetMinFPConstPrec(current_scanner.readid,current_settings.minfpconstprec) then
+          Message1(scan_e_illegal_minfpconstprec, pattern);
+      end;
+
+
     procedure dir_packrecords;
       var
         hs : string;
@@ -1321,6 +1330,7 @@ implementation
         AddDirective('MEMORY',directive_all, @dir_memory);
         AddDirective('MESSAGE',directive_all, @dir_message);
         AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
+        AddDirective('MINFPCONSTPREC',directive_all, @dir_minfpconstprec);
         AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize);
         AddDirective('MMX',directive_all, @dir_mmx);
         AddDirective('MODE',directive_all, @dir_mode);

compiler/symconst.pas

@@ -181,12 +181,6 @@ type
     uchar,uwidechar,scurrency
   );
 
-  { float types }
-  tfloattype = (
-    s32real,s64real,s80real,
-    s64comp,s64currency,s128real
-  );
-
   { string types }
   tstringtype = (
     st_shortstring,

tests/webtbs/tw8678.pp

@@ -0,0 +1,27 @@
+{ %cpu=powerpc,powerpc64,sparc,arm,x86_64 }
+
+var
+  l: longint;
+  s: single;
+  d: double;
+
+begin
+{$if not defined(cpux86_64) or defined(win64)} // or: using sse unit for math
+  l := maxlongint;
+{$MINFPCONSTPREC default}
+  s:= l / 1.0;
+  d:= l / 1.0;
+  if (s <> d) then
+    halt(1);
+{$MINFPCONSTPREC 32}
+  s:= l / 1.0;
+  d:= l / 1.0;
+  if (s <> d) then
+    halt(2);
+{$MINFPCONSTPREC 64}
+  s:= l / 1.0;
+  d:= l / 1.0;
+  if (s = d) then
+    halt(3);
+{$endif}
+end.

tests/webtbs/tw8678a.pp

@@ -0,0 +1,17 @@
+{ %cpu=powerpc,powerpc64,sparc,arm,x86_64 }
+{ %opt=-CF64 }
+
+var
+  l: longint;
+  s: single;
+  d: double;
+
+begin
+{$if not defined(cpux86_64) or defined(win64)} // or: using sse unit for math
+  l := maxlongint;
+  s:= l / 1.0;
+  d:= l / 1.0;
+  if (s = d) then
+    halt(1);
+{$endif}
+end.