+ "CExtended" type that is the same as "extended", but conforming to the

    properties/behaviour of the equivalent of Extended in C (i.e., to
    "long double" on i386 and x86_64 platforms that support a 10 byte
    long double, and to "double" elsewhere)

git-svn-id: trunk@14912 -

.gitattributes

@@ -8487,6 +8487,7 @@ tests/test/cg/taddr1.pp svneol=native#text/plain
 tests/test/cg/taddr2.pp svneol=native#text/plain
 tests/test/cg/taddreal1.pp svneol=native#text/plain
 tests/test/cg/taddreal2.pp svneol=native#text/plain
+tests/test/cg/taddreal3.pp svneol=native#text/plain
 tests/test/cg/taddset.pp svneol=native#text/plain
 tests/test/cg/taddset2.pp svneol=native#text/plain
 tests/test/cg/taddset3.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -465,7 +465,8 @@ interface
        { Generates an extended float (80 bit real) }
        tai_real_80bit = class(tai)
           value : ts80real;
-          constructor Create(_value : ts80real);
+          savesize : byte;
+          constructor Create(_value : ts80real; _savesize: byte);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
@@ -1376,12 +1377,13 @@ implementation
                                TAI_real_80bit
  ****************************************************************************}
 
-    constructor tai_real_80bit.Create(_value : ts80real);
+    constructor tai_real_80bit.Create(_value : ts80real; _savesize: byte);
 
       begin
          inherited Create;
          typ:=ait_real_80bit;
          value:=_value;
+         savesize:=_savesize;
       end;
 
 
@@ -1389,6 +1391,7 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         value:=ppufile.getreal;
+        savesize:=ppufile.getbyte;
       end;
 
 
@@ -1396,6 +1399,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putreal(value);
+        ppufile.putbyte(savesize);
       end;
 
 

compiler/aggas.pas

@@ -913,6 +913,8 @@ implementation
                    AsmWrite(',');
                   AsmWrite(tostr(t80bitarray(e)[i]));
                 end;
+               for i:=11 to tai_real_80bit(hp).savesize do
+                 AsmWrite(',0');
                AsmLn;
              end;
 {$endif cpuextended}

compiler/assemble.pas

@@ -990,7 +990,7 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.alloc(10);
+               ObjData.alloc(tai_real_80bit(hp).savesize);
              ait_real_64bit :
                ObjData.alloc(8);
              ait_real_32bit :
@@ -1113,7 +1113,7 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.alloc(10);
+               ObjData.alloc(tai_real_80bit(hp).savesize);
              ait_real_64bit :
                ObjData.alloc(8);
              ait_real_32bit :
@@ -1232,7 +1232,10 @@ Implementation
                    end;
                end;
              ait_real_80bit :
-               ObjData.writebytes(Tai_real_80bit(hp).value,10);
+               begin
+                 ObjData.writebytes(Tai_real_80bit(hp).value,10);
+                 ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
+               end;
              ait_real_64bit :
                ObjData.writebytes(Tai_real_64bit(hp).value,8);
              ait_real_32bit :

compiler/cgbase.pas

@@ -268,7 +268,7 @@ interface
          1,2,4,8,16,1,2,4,8,16);
 
        tfloat2tcgsize: array[tfloattype] of tcgsize =
-         (OS_F32,OS_F64,OS_F80,OS_C64,OS_C64,OS_F128);
+         (OS_F32,OS_F64,OS_F80,OS_F80,OS_C64,OS_C64,OS_F128);
 
        tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
          (s32real,s64real,s80real,s64comp);

compiler/dbgdwarf.pas

@@ -1265,13 +1265,27 @@ implementation
         case def.floattype of
           s32real,
           s64real,
-          s80real:
+          s80real,
+          sc80real:
             if assigned(def.typesym) then
-              append_entry(DW_TAG_base_type,false,[
-                DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
-                DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
-                DW_AT_byte_size,DW_FORM_data1,def.size
-                ])
+              begin
+                append_entry(DW_TAG_base_type,false,[
+                  DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
+                  DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
+                  DW_AT_byte_size,DW_FORM_data1,def.size
+                  ]);
+                if (def.floattype in [s80real,sc80real]) and
+                   (def.size<>10) then
+                  begin
+                    append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]);
+                    { "The bit offset attribute describes the offset in bits
+                        of the high order bit of a value of the given type
+                        from the high order bit of the storage unit used to
+                        contain that value." }
+                    if target_info.endian=endian_little then
+                      append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]);
+                  end;
+              end
             else
               append_entry(DW_TAG_base_type,false,[
                 DW_AT_encoding,DW_FORM_data1,DW_ATE_float,
@@ -2392,10 +2406,11 @@ implementation
                     current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
                     current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pdouble(sym.value.valueptr)^));
                   end;
-                s80real:
+                s80real,
+                sc80real:
                   begin
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(10));
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^));
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^,sym.constdef.size));
                   end;
                 else
                   internalerror(200601291);

compiler/dbgstabs.pas

@@ -662,7 +662,8 @@ implementation
         case def.floattype of
           s32real,
           s64real,
-          s80real:
+          s80real,
+          sc80real:
             ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]);
           s64currency,
           s64comp:

compiler/defutil.pas

@@ -301,7 +301,7 @@ implementation
     function is_extended(def : tdef) : boolean;
       begin
         result:=(def.typ=floatdef) and
-          (tfloatdef(def).floattype=s80real);
+          (tfloatdef(def).floattype in [s80real,sc80real]);
       end;
 
 

compiler/globtype.pas

@@ -426,9 +426,10 @@ interface
        tprocinfoflags=set of tprocinfoflag;
 
     type
-      { float types }
+      { float types -- warning, this enum/order is used internally by the RTL
+        as well in rtl/inc/real2str.inc }
       tfloattype = (
-        s32real,s64real,s80real,
+        s32real,s64real,s80real,sc80real { the C "long double" type on x86 },
         s64comp,s64currency,s128real
       );
 

compiler/htypechk.pas

@@ -2288,7 +2288,7 @@ implementation
            tve_chari64,tve_chari64,tve_dblcurrency);
 { TODO: fixme for 128 bit floats }
         variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
-          (tve_single,tve_dblcurrency,tve_extended,
+          (tve_single,tve_dblcurrency,tve_extended,tve_extended,
            tve_dblcurrency,tve_dblcurrency,tve_extended);
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
           (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring);

compiler/i386/ag386nsm.pas

@@ -732,6 +732,8 @@ interface
                    AsmWrite(',');
                   AsmWrite(tostr(t80bitarray(e)[i]));
                 end;
+                for i:=11 to tai_real_80bit(hp).savesize do
+                  AsmWrite(',0');
                AsmLn;
              end;
 {$else cpuextended}

compiler/nadd.pas

@@ -116,7 +116,7 @@ implementation
     function getbestreal(t1,t2 : tdef) : tdef;
       const
         floatweight : array[tfloattype] of byte =
-          (2,3,4,0,1,5);
+          (2,3,4,5,0,1,6);
       begin
         if t1.typ=floatdef then
           begin

compiler/ncgcon.pas

@@ -108,7 +108,7 @@ implementation
       { constants are actually supported by the target processor? (JM) }
       const
         floattype2ait:array[tfloattype] of taitype=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
+          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
       var
          hp1 : tai;
          lastlabel : tasmlabel;
@@ -145,7 +145,7 @@ implementation
                                  ((tai_real_64bit(hp1).formatoptions=fo_hiloswapped)=hiloswapped) and
 {$endif ARM}
                                  (tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_64bit(hp1).value))) or
-                               ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
+                               ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and (tai_real_80bit(hp1).savesize=resultdef.size) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
 {$ifdef cpufloat128}
                                ((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_128bit(hp1).value))) or
 {$endif cpufloat128}
@@ -196,7 +196,7 @@ implementation
 
                     ait_real_80bit :
                       begin
-                        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real));
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real,resultdef.size));
 
                         { range checking? }
                         if floating_point_range_check_error and

compiler/ncgrtti.pas

@@ -535,9 +535,9 @@ implementation
 
         procedure floatdef_rtti(def:tfloatdef);
         const
-          {tfloattype = (s32real,s64real,s80real,s64bit,s128bit);}
+          {tfloattype = (s32real,s64real,s80real,sc80real,s64bit,s128bit);}
           translate : array[tfloattype] of byte =
-             (ftSingle,ftDouble,ftExtended,ftComp,ftCurr,ftFloat128);
+             (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
         begin
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
            write_rtti_name(def);

compiler/ninl.pas

@@ -1887,7 +1887,7 @@ implementation
       procedure setfloatresultdef;
         begin
           if (left.resultdef.typ=floatdef) and
-            (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,s128real]) then
+            (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
             resultdef:=left.resultdef
           else
             begin
@@ -2463,7 +2463,7 @@ implementation
                   set_varstate(left,vs_read,[vsf_must_be_valid]);
                   { for direct float rounding, no best real type cast should be necessary }
                   if not((left.resultdef.typ=floatdef) and
-                         (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,s128real])) and
+                         (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
                      { converting an int64 to double on platforms without }
                      { extended can cause precision loss                  }
                      not(left.nodetype in [ordconstn,realconstn]) then

compiler/options.pas

@@ -2413,6 +2413,7 @@ begin
 {$ifdef x86_64}
   def_system_macro('FPC_HAS_RIP_RELATIVE');
 {$endif x86_64}
+  def_system_macro('FPC_HAS_CEXTENDED');
 
 { these cpus have an inline rol/ror implementaion }
 {$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}

compiler/psystem.pas

@@ -129,10 +129,12 @@ implementation
               s32floattype:=tfloatdef.create(s32real);
               s64floattype:=tfloatdef.create(s64real);
               s80floattype:=tfloatdef.create(s80real);
+              sc80floattype:=tfloatdef.create(sc80real);
             end else begin
               s32floattype:=nil;
               s64floattype:=nil;
               s80floattype:=nil;
+              sc80floattype:=nil;
             end;
         end;
 
@@ -206,6 +208,7 @@ implementation
         s32floattype:=tfloatdef.create(s32real);
         s64floattype:=tfloatdef.create(s64real);
         s80floattype:=tfloatdef.create(s80real);
+        sc80floattype:=tfloatdef.create(sc80real);
         s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
 {$endif avr}
 {$ifdef cpu64bitaddr}
@@ -257,6 +260,12 @@ implementation
             addtype('Double',s64floattype);
             { extended size is the best real type for the target }
             addtype('Extended',pbestrealtype^);
+            { CExtended corresponds to the C version of the Extended type
+              (either "long double" or "double") }
+            if tfloatdef(pbestrealtype^).floattype=s80real then
+              addtype('CExtended',sc80floattype)
+            else
+              addtype('CExtended',pbestrealtype^);
           end;
 {$ifdef x86}
         if target_info.system<>system_x86_64_win64 then
@@ -334,6 +343,7 @@ implementation
             addtype('$s32real',s32floattype);
             addtype('$s64real',s64floattype);
             addtype('$s80real',s80floattype);
+            addtype('$sc80real',sc80floattype);
           end;
         addtype('$s64currency',s64currencytype);
         { Add a type for virtual method tables }
@@ -417,6 +427,7 @@ implementation
             loadtype('s32real',s32floattype);
             loadtype('s64real',s64floattype);
             loadtype('s80real',s80floattype);
+            loadtype('sc80real',sc80floattype);
           end;
         loadtype('s64currency',s64currencytype);
         loadtype('boolean',booltype);

compiler/ptconst.pas

@@ -312,7 +312,9 @@ implementation
 {$endif ARM}
                  list.concat(Tai_real_64bit.Create(ts64real(value)));
              s80real :
-               list.concat(Tai_real_80bit.Create(value));
+               list.concat(Tai_real_80bit.Create(value,s80floattype.size));
+             sc80real :
+               list.concat(Tai_real_80bit.Create(value,sc80floattype.size));
              s64comp :
                { the round is necessary for native compilers where comp isn't a float }
                list.concat(Tai_comp_64bit.Create(round(value)));

compiler/raatt.pas

@@ -51,7 +51,7 @@ unit raatt;
         {------------------ Assembler directives --------------------}
         AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
         AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
-        AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,
+        AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,AS_CEXTENDED,
         AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_END,
         {------------------ Assembler Operators  --------------------}
         AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT,
@@ -73,7 +73,7 @@ unit raatt;
         '#','{','}','[',']',
         '.byte','.word','.long','.quad','.globl',
         '.align','.balign','.p2align','.ascii',
-        '.asciz','.lcomm','.comm','.single','.double','.tfloat',
+        '.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat',
         '.data','.text','.init','.fini','END',
         'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','lo','hi');
 
@@ -1034,6 +1034,12 @@ unit raatt;
                BuildRealConstant(s80real);
              end;
 
+           AS_CEXTENDED:
+             Begin
+               Consume(AS_CEXTENDED);
+               BuildRealConstant(sc80real);
+             end;
+
            AS_GLOBAL:
              Begin
                Consume(AS_GLOBAL);

compiler/rautils.pas

@@ -1565,7 +1565,8 @@ end;
            else
 {$endif ARM}
              p.concat(Tai_real_64bit.Create(value));
-          s80real : p.concat(Tai_real_80bit.Create(value));
+          s80real : p.concat(Tai_real_80bit.Create(value,s80floattype.size));
+          sc80real : p.concat(Tai_real_80bit.Create(value,sc80floattype.size));
           s64comp : p.concat(Tai_comp_64bit.Create(trunc(value)));
        end;
     end;

compiler/symdef.pas

@@ -647,9 +647,10 @@ interface
        s32inttype,                { 32-Bit signed integer }
        u64inttype,                { 64-bit unsigned integer }
        s64inttype,                { 64-bit signed integer }
-       s32floattype,              { pointer for realconstn }
-       s64floattype,              { pointer for realconstn }
-       s80floattype,              { pointer to type of temp. floats }
+       s32floattype,              { 32 bit floating point number }
+       s64floattype,              { 64 bit floating point number }
+       s80floattype,              { 80 bit floating point number }
+       sc80floattype,             { 80 bit floating point number but stored like in C }
        s64currencytype,           { pointer to a currency type }
        cshortstringtype,          { pointer to type of short string const   }
        clongstringtype,           { pointer to type of long string const   }
@@ -1717,7 +1718,7 @@ implementation
       begin
         if (target_info.system in [system_i386_darwin,system_arm_darwin]) then
           case floattype of
-            s80real : result:=16;
+            s80real: result:=16;
             s64real,
             s64currency,
             s64comp : result:=4;
@@ -1734,6 +1735,13 @@ implementation
          case floattype of
            s32real : savesize:=4;
            s80real : savesize:=10;
+           sc80real:
+             if target_info.system in [system_i386_darwin,system_x86_64_darwin,
+                  system_x86_64_linux,system_x86_64_freebsd,
+                  system_x86_64_solaris,system_x86_64_embedded] then
+               savesize:=16
+             else
+               savesize:=12;
            s64real,
            s64currency,
            s64comp : savesize:=8;
@@ -1746,7 +1754,7 @@ implementation
     function tfloatdef.getvardef : longint;
       const
         floattype2vardef : array[tfloattype] of longint = (
-          varSingle,varDouble,varUndefined,
+          varSingle,varDouble,varUndefined,varUndefined,
           varUndefined,varCurrency,varUndefined);
       begin
         if (upper(typename)='TDATETIME') and
@@ -1776,7 +1784,7 @@ implementation
     function tfloatdef.GetTypeName : string;
       const
         names : array[tfloattype] of string[20] = (
-          'Single','Double','Extended','Comp','Currency','Float128');
+          'Single','Double','Extended','CExtended','Comp','Currency','Float128');
       begin
          GetTypeName:=names[floattype];
       end;
@@ -3474,7 +3482,7 @@ implementation
              'c','w','x');
 
            floattype2str : array[tfloattype] of string[1] = (
-             'f','d','e',
+             'f','d','e','e',
              'd','d','g');
 {$endif NAMEMANGLING_GCC2}
 

compiler/x86_64/cpupara.pas

@@ -89,7 +89,8 @@ unit cpupara;
            floatdef:
              begin
                case tfloatdef(p).floattype of
-                  s80real:
+                  s80real,
+                  sc80real:
                     loc1:=LOC_REFERENCE;
                   s32real,
                   s64real :
@@ -438,7 +439,8 @@ unit cpupara;
                 end;
               s64currency,
               s64comp,
-              s80real:
+              s80real,
+              sc80real:
                 begin
                   result.loc:=LOC_FPUREGISTER;
                   result.register:=NR_FPU_RESULT_REG;

rtl/inc/ctypes.pp

@@ -95,19 +95,11 @@ type
 {$endif}
 
 {$ifndef FPUNONE}
-{$ifdef longdouble_is_double}
+{$if defined(longdouble_is_double) or not defined(FPC_HAS_CEXTENDED)}
   clongdouble=double;
 {$else}
-  {$if defined(cpui386) or defined(cpux86_64)}
-  {$define longdouble_assignment_overload_real80}
-  clongdouble = packed record
-    value:extended;
-  {$ifdef defined(cpu64) or defined(darwin)}
-    padding:array[0..5] of byte;
-  {$else}
-    padding:array[0..1] of byte;
-  {$endif}
-  end;
+  {$if defined(cpui386) or defined(cpux86_64) or defined(cpuavr)}
+  clongdouble = cextended;
   {$else}
   {$define longdouble_assignment_overload_real128}
   clongdouble = packed array [0..15] of byte;
@@ -115,29 +107,6 @@ type
 {$endif}
   Pclongdouble=^clongdouble;
 
-{$ifdef longdouble_assignment_overload_real80}
-operator := (const v:clongdouble) r:extended;inline;
-operator := (const v:extended) r:clongdouble;inline;
-operator +(const e:Extended;const c:clongdouble) r:extended;inline;
-operator +(const c:clongdouble;const e:Extended) r:extended;inline;
-operator -(const e:Extended;const c:clongdouble) r:extended;inline;
-operator -(const c:clongdouble;const e:Extended) r:extended;inline;
-operator *(const e:Extended;const c:clongdouble) r:extended;inline;
-operator *(const c:clongdouble;const e:Extended) r:extended;inline;
-operator /(const e:Extended;const c:clongdouble) r:extended;inline;
-operator /(const c:clongdouble;const e:Extended) r:extended;inline;
-operator =(const e:Extended;const c:clongdouble) r:boolean;inline;
-operator =(const c:clongdouble;const e:Extended) r:boolean;inline;
-operator <(const e:Extended;const c:clongdouble) r:boolean;inline;
-operator <(const c:clongdouble;const e:Extended) r:boolean;inline;
-operator >(const e:Extended;const c:clongdouble) r:boolean;inline;
-operator >(const c:clongdouble;const e:Extended) r:boolean;inline;
-operator >=(const e:Extended;const c:clongdouble) r:boolean;inline;
-operator >=(const c:clongdouble;const e:Extended) r:boolean;inline;
-operator <=(const e:Extended;const c:clongdouble) r:boolean;inline;
-operator <=(const c:clongdouble;const e:Extended) r:boolean;inline;
-{$endif}
-
 {$ifdef longdouble_assignment_overload_real128}
 {Non-x86 typically doesn't have extended. To be fixed once this changes.}
 operator := (const v:clongdouble) r:double;inline;
@@ -168,109 +137,6 @@ operator <=(const c:clongdouble;const e:Double) r:boolean;inline;
 implementation
 
 {$ifndef FPUNONE}
-{$ifdef longdouble_assignment_overload_real80}
-operator := (const v:clongdouble) r:extended;
-
-begin
-  r:=v.value;
-end;
-
-operator := (const v:extended) r:clongdouble;
-
-begin
-  r.value:=v;
-end;
-
-operator +(const e:Extended;const c:clongdouble) r:extended;inline;
-begin
-  r:=e+c.value;
-end;
-
-operator +(const c:clongdouble;const e:Extended) r:extended;inline;
-begin
-  r:=c.value+e;
-end;
-
-operator -(const e:Extended;const c:clongdouble) r:extended;inline;
-begin
-  r:=e-c.value;
-end;
-
-operator -(const c:clongdouble;const e:Extended) r:extended;inline;
-begin
-  r:=c.value-e;
-end;
-
-operator *(const e:Extended;const c:clongdouble) r:extended;inline;
-begin
-  r:=e*c.value;
-end;
-
-operator *(const c:clongdouble;const e:Extended) r:extended;inline;
-begin
-  r:=c.value*e;
-end;
-
-operator /(const e:Extended;const c:clongdouble) r:extended;inline;
-begin
-  r:=e/c.value;
-end;
-
-operator /(const c:clongdouble;const e:Extended) r:extended;inline;
-begin
-  r:=c.value/e;
-end;
-
-operator =(const e:Extended;const c:clongdouble) r:boolean;inline;
-begin
-  r:=e=c.value;
-end;
-
-operator =(const c:clongdouble;const e:Extended) r:boolean;inline;
-begin
-  r:=c.value=e;
-end;
-
-operator <(const e:Extended;const c:clongdouble) r:boolean;inline;
-begin
-  r:=e<c.value;
-end;
-
-operator <(const c:clongdouble;const e:Extended) r:boolean;inline;
-begin
-  r:=c.value<e;
-end;
-
-operator >(const e:Extended;const c:clongdouble) r:boolean;inline;
-begin
-  r:=e>c.value;
-end;
-
-operator >(const c:clongdouble;const e:Extended) r:boolean;inline;
-begin
-  r:=c.value>e;
-end;
-
-operator >=(const e:Extended;const c:clongdouble) r:boolean;inline;
-begin
-  r:=e>=c.value;
-end;
-
-operator >=(const c:clongdouble;const e:Extended) r:boolean;inline;
-begin
-  r:=c.value>=e;
-end;
-
-operator <=(const e:Extended;const c:clongdouble) r:boolean;inline;
-begin
-  r:=e<=c.value;
-end;
-
-operator <=(const c:clongdouble;const e:Extended) r:boolean;inline;
-begin
-  r:=c.value<=e;
-end;
-{$endif}
 
 {$ifdef longdouble_assignment_overload_real128}
 

rtl/inc/real2str.inc

@@ -15,7 +15,7 @@
 type
   { See symconst.pas tfloattype }
   treal_type = (
-    rt_s32real,rt_s64real,rt_s80real,
+    rt_s32real,rt_s64real,rt_s80real,rt_sc80real,
     rt_c64bit,rt_currency,rt_s128real
   );
   { corresponding to single   double   extended   fixed      comp for i386 }
@@ -199,7 +199,8 @@ begin
          minlen:=9;
          explen:=5;
       end;
-    rt_s80real :
+    rt_s80real,
+    rt_sc80real:
       begin
          { Different in TP help, but this way the output is the same (JM) }
          maxlen:=25;

tests/test/cg/taddreal3.pp

@@ -0,0 +1,263 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondadd() FPU cextended type code              }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS:                                                       }
+{                                                                }
+{                                                                }
+{                                                                }
+{****************************************************************}
+
+{ Result is either LOC_FPU or LOC_REFERENCE                     }
+{ LEFT NODE (operand) (left operator)                           }
+{  LOC_REFERENCE / LOC_MEM                                      }
+{  LOC_FPU                                                      }
+{ RIGHT NODE (operand)                                          }
+{  LOC_FPU                                                      }
+{  LOC_REFERENCE / LOC_MEM                                      }
+procedure fail;
+begin
+  WriteLn('Failed!');
+  halt(1);
+end;
+
+
+ Procedure RealTestSub;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ Begin
+  Write('cextended - cextended test...');
+  result := true;
+  i:=99.9;
+  j:=10.0;
+  i:=i-j;
+  if trunc(i) <> trunc(89.9) then
+    result := false;
+  WriteLn('Result (89.9) :',i);
+  i:=j-i;
+  if trunc(i) <> trunc(-79.9) then
+    result := false;
+  WriteLn('Result (-79.9) :',i);
+  j:=j-10.0;
+  if j <> 0.0 then
+    result := false;
+  WriteLn('Result (0.0) :',j);
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+ procedure RealTestAdd;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ Begin
+   WriteLn('cextended + cextended test...');
+   result := true;
+   i:= 9;
+   i:=i+1.5;
+   if trunc(i) <> trunc(10.5) then
+     result := false;
+   WriteLn('Result (10.5) :',i);
+   i := 0.0;
+   j := 100.0;
+   i := i + j + j + 12.5;
+   if trunc(i) <> trunc(212.5) then
+     result := false;
+   WriteLn('Result (212.5) :',i);
+   if not result then
+    Fail
+   else
+    WriteLn('Success.');
+ end;
+
+
+ procedure realtestmul;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ begin
+  WriteLn('cextended * cextended test...');
+  result := true;
+  i:= 0;
+  j:= 0;
+  i := i * j * i;
+  if trunc(i) <> trunc(0.0) then
+    result := false;
+  WriteLn('Result (0.0) :',i);
+  i := 10.0;
+  j := -12.0;
+  i := i * j * 10.0;
+  if trunc(i) <> trunc(-1200.0) then
+    result := false;
+  WriteLn('Result (-1200.0) :',i);
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+
+
+ Procedure RealTestDiv;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ Begin
+  result := true;
+  WriteLn('cextended / cextended test...');
+  i:=-99.9;
+  j:=10.0;
+  i:=i / j;
+  if trunc(i) <> trunc(-9.9) then
+    result := false;
+  WriteLn('Result (-9.9) :',i);
+  i:=j / i;
+  if trunc(i) <> trunc(-1.01) then
+    result := false;
+  WriteLN('Result (-1.01) :',i);
+  j:=i / 10.0;
+  if trunc(j) <> trunc(-0.1001) then
+    result := false;
+  WriteLn('Result (-0.1001) :',j);
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+
+
+{ Procedure RealTestComplex;
+ var
+  i : cextended;
+ Begin
+   Write('RESULT SHOULD BE 2.09 :');
+   i := 4.4;
+   WriteLn(Sqrt(i));
+   Write('RESULT SHOULD BE PI :');
+   WriteLn(Pi);
+   Write('RESULT SHOULD BE 4.0 :');
+   WriteLn(Round(3.6));
+ end;}
+
+
+ procedure realtestequal;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ begin
+  result := true;
+  Write('cextended = cextended test...');
+  i := 1000.0;
+  j := 1000.0;
+  if not (trunc(i) = trunc(j)) then
+    result := false;
+  if not (trunc(i) = trunc(1000.0)) then
+    result := false;
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+ procedure realtestnotequal;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ begin
+  result := true;
+  Write('cextended <> cextended test...');
+  i := 1000.0;
+  j := 1000.0;
+  if (trunc(i) <> trunc(j)) then
+    result := false;
+  if (trunc(i) <> trunc(1000.0)) then
+    result := false;
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+
+ procedure realtestle;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ begin
+  result := true;
+  Write('cextended <= cextended test...');
+  i := 1000.0;
+  j := 1000.0;
+  if not (trunc(i) <= trunc(j)) then
+    result := false;
+  if not (trunc(i) <= trunc(1000.0)) then
+    result := false;
+  i := 10000.0;
+  j := 999.0;
+  if trunc(i) < trunc(j) then
+    result := false;
+  if trunc(i) < trunc(999.0) then
+    result := false;
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+ procedure realtestge;
+ var
+  i : cextended;
+  j : cextended;
+  result : boolean;
+ begin
+  result := true;
+  Write('cextended >= cextended test...');
+  i := 1000.0;
+  j := 1000.0;
+  if not (trunc(i) >= trunc(j)) then
+    result := false;
+  if not (trunc(i) >= trunc(1000.0)) then
+    result := false;
+  i := 999.0;
+  j := 1000.0;
+  if trunc(i) > trunc(j) then
+    result := false;
+  if trunc(i) > trunc(999.0) then
+    result := false;
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+ end;
+
+
+Begin
+ RealTestEqual;
+ RealTestNotEqual;
+ RealTestLE;
+ RealTestGE;
+ RealTestSub;
+ RealTestAdd;
+ RealTestDiv;
+ RealTestMul;
+{ RealTestComplex;}
+end.

tests/test/cg/tcalext.pp

@@ -25,7 +25,7 @@ uses strings,ctypes;
 {$endif USE_PASCAL_OBJECT}
 
 {$ifdef FPC_HAS_TYPE_EXTENDED}
-{define test_longdouble}
+{$define test_longdouble}
 {$endif}
 
 { Use C alignment of records }
@@ -407,17 +407,8 @@ begin
   array_long_double[1] := RESULT_LONGDOUBLE;
   test_array_param_longdouble(array_long_double);
   if trunc(global_long_double) <> trunc(RESULT_LONGDOUBLE) then
-    begin
-{$ifdef cpui386}
-      if sizeof(global_long_double)=10 then
-        begin
-          { Known issue, ignore tcalext2 contains that test }
-        end
-      else
-{$endif cpui386}
-        failed := true;
-    end;
-{$endif}
+    failed := true;
+{$endif test_longdouble}
 
   If failed then
    fail