* some fpu emulation code from arm to generic code generator moved

* several m68k fixes

git-svn-id: trunk@5218 -

compiler/arm/narmcnv.pas

@@ -77,74 +77,7 @@ implementation
         fname: string[19];
       begin
         if cs_fp_emulation in current_settings.moduleswitches then
-          begin
-            if target_info.system in system_wince then
-              begin
-                { converting a 64bit integer to a float requires a helper }
-                if is_64bitint(left.resultdef) or
-                  is_currency(left.resultdef) then
-                  begin
-                    { hack to avoid double division by 10000, as it's
-                      already done by typecheckpass.resultdef_int_to_real }
-                    if is_currency(left.resultdef) then
-                      left.resultdef := s64inttype;
-                    if is_signed(left.resultdef) then
-                      fname:='I64TOD'
-                    else
-                      fname:='UI64TOD';
-                  end
-                else
-                  { other integers are supposed to be 32 bit }
-                  begin
-                    if is_signed(left.resultdef) then
-                      fname:='ITOD'
-                    else
-                      fname:='UTOD';
-                    firstpass(left);
-                  end;
-                result:=ccallnode.createintern(fname,ccallparanode.create(
-                  left,nil));
-                left:=nil;
-                firstpass(result);
-                exit;
-              end
-            else
-              begin
-                { converting a 64bit integer to a float requires a helper }
-                if is_64bitint(left.resultdef) or
-                  is_currency(left.resultdef) then
-                  begin
-                    { hack to avoid double division by 10000, as it's
-                      already done by typecheckpass.resultdef_int_to_real }
-                    if is_currency(left.resultdef) then
-                      left.resultdef := s64inttype;
-                    if is_signed(left.resultdef) then
-                      fname:='int64_to_'
-                    else
-                      { we can't do better currently }
-                      fname:='int64_to_';
-                  end
-                else
-                  { other integers are supposed to be 32 bit }
-                  begin
-                    if is_signed(left.resultdef) then
-                      fname:='int32_to_'
-                    else
-                      { we can't do better currently }
-                      fname:='int32_to_';
-                    firstpass(left);
-                  end;
-                if tfloatdef(resultdef).floattype=s64real then
-                  fname:=fname+'float64'
-                else
-                  fname:=fname+'float32';
-                result:=ctypeconvnode.create_internal(ccallnode.createintern(fname,ccallparanode.create(
-                  left,nil)),resultdef);
-                left:=nil;
-                firstpass(result);
-                exit;
-              end;
-          end
+          result:=inherited first_int_to_real
         else
           begin
             { converting a 64bit integer to a float requires a helper }

compiler/m68k/aasmcpu.pas

@@ -112,8 +112,8 @@ type
       gas_op2str:op2strtable=
     {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
        { 68000 only opcodes }
-       ('abcd',
-         'add','adda','addi','addq','addx','and','andi',
+       ( '',
+         'abcd','add','adda','addi','addq','addx','and','andi',
          'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
          'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
          'bchg','bclr','bra','bset','bsr','btst','chk',
@@ -159,7 +159,7 @@ type
          { (this may include 68040 mmu instructions)          }
          'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
          { useful for assembly language output }
-         'label','none','db','s','b','fb');
+         'label','db','s','b','fb');
 
 
 {*****************************************************************************
@@ -543,7 +543,7 @@ type
             // no need to handle sizes here
             result:=taicpu.op_ref_reg(A_FMOVE,S_FS,ref,r);
           else
-            internalerror(200602011);            
+            internalerror(200602011);
         end;
       end;
 

compiler/m68k/ag68kgas.pas

@@ -44,8 +44,8 @@ interface
       gas_op2str:op2strtable=
     {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
        { 68000 only opcodes }
-       ('abcd',
-         'add','adda','addi','addq','addx','and','andi',
+       ( '',
+         'abcd','add','adda','addi','addq','addx','and','andi',
          'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
          'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
          'bchg','bclr','bra','bset','bsr','btst','chk',
@@ -91,7 +91,7 @@ interface
          { (this may include 68040 mmu instructions)          }
          'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
          { useful for assembly language output }
-         'label','none','db','s','b','fb');
+         'label','db','s','b','fb');
 
 
      gas_opsize2str : array[topsize] of string[2] =
@@ -114,7 +114,7 @@ interface
       cgbase,cgutils,
       verbose,itcpugas;
 
-     
+
  {****************************************************************************}
  {                         GNU m68k Assembler writer                          }
  {****************************************************************************}

compiler/m68k/cgcpu.pas

@@ -1358,13 +1358,13 @@ unit cgcpu;
          end;
       OP_AND :
           begin
-            { should already be optimized out }
-            internalerror(2002081801);
+            list.concat(taicpu.op_const_reg(A_AND,S_L,lowvalue,regdst.reglo));
+            list.concat(taicpu.op_const_reg(A_AND,S_L,highvalue,regdst.reglo));
           end;
       OP_OR :
           begin
-            { should already be optimized out }
-            internalerror(2002081802);
+            list.concat(taicpu.op_const_reg(A_OR,S_L,lowvalue,regdst.reglo));
+            list.concat(taicpu.op_const_reg(A_OR,S_L,highvalue,regdst.reglo));
           end;
       { this is handled in 1st pass for 32-bit cpu's (helper call) }
       OP_IDIV,OP_DIV,

compiler/m68k/cpubase.pas

@@ -38,8 +38,8 @@ unit cpubase;
     type
     {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
        { 68000 only opcodes }
-       tasmop = (a_abcd,
-         a_add,a_adda,a_addi,a_addq,a_addx,a_and,a_andi,
+       tasmop = (a_none,
+         a_abcd,a_add,a_adda,a_addi,a_addq,a_addx,a_and,a_andi,
          a_asl,a_asr,a_bcc,a_bcs,a_beq,a_bge,a_bgt,a_bhi,
          a_ble,a_bls,a_blt,a_bmi,a_bne,a_bpl,a_bvc,a_bvs,
          a_bchg,a_bclr,a_bra,a_bset,a_bsr,a_btst,a_chk,
@@ -85,7 +85,7 @@ unit cpubase;
          { (this may include 68040 mmu instructions)          }
          a_frestore,a_fsave,a_pflush,a_pflusha,a_pload,a_pmove,a_ptest,
          { useful for assembly language output }
-         a_label,a_none,a_dbxx,a_sxx,a_bxx,a_fbxx);
+         a_label,a_dbxx,a_sxx,a_bxx,a_fbxx);
 
       {# This should define the array of instructions as string }
       op2strtable=array[tasmop] of string[11];

compiler/m68k/itcpugas.pas

@@ -32,8 +32,8 @@ interface
       gas_op2str : op2strtable=
        {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
        { 68000 only opcodes }
-       ('abcd',
-         'add','adda','addi','addq','addx','and','andi',
+       ( '',
+         'abcd','add','adda','addi','addq','addx','and','andi',
          'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
          'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
          'bchg','bclr','bra','bset','bsr','btst','chk',
@@ -79,7 +79,7 @@ interface
          { (this may include 68040 mmu instructions)          }
          'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
          { useful for assembly language output }
-         'label','none','db','s','b','fb');
+         'label','db','s','b','fb');
 
     function gas_regnum_search(const s:string):Tregister;
     function gas_regname(r:Tregister):string;

compiler/m68k/ra68kmot.pas

@@ -1764,9 +1764,9 @@ const
                 begin
                   instr:=TM68kInstruction.Create(tm68koperand);
                   BuildOpcode(instr);
-{                    instr.AddReferenceSizes;}
-{                    instr.SetInstructionOpsize;}
-{                    instr.CheckOperandSizes;}
+//                  instr.AddReferenceSizes;
+//                  instr.SetInstructionOpsize;
+//                  instr.CheckOperandSizes;
                   if instr.labeled then
                      instr.ConcatLabeledInstr(curlist)
                   else begin

compiler/ncnv.pas

@@ -1934,37 +1934,69 @@ implementation
     function ttypeconvnode.first_int_to_real: tnode;
       var
         fname: string[32];
-        typname : string[12];
-      begin
-        { Get the type name  }
-        {  Normally the typename should be one of the following:
-            single, double - carl
-        }
-        typname := lower(pbestrealtype^.GetTypeName);
-        { converting a 64bit integer to a float requires a helper }
-        if is_64bit(left.resultdef) then
+      begin
+        if target_info.system in system_wince then
           begin
-            if is_signed(left.resultdef) then
-              fname := 'fpc_int64_to_'+typname
+            { converting a 64bit integer to a float requires a helper }
+            if is_64bitint(left.resultdef) or
+              is_currency(left.resultdef) then
+              begin
+                { hack to avoid double division by 10000, as it's
+                  already done by typecheckpass.resultdef_int_to_real }
+                if is_currency(left.resultdef) then
+                  left.resultdef := s64inttype;
+                if is_signed(left.resultdef) then
+                  fname:='I64TOD'
+                else
+                  fname:='UI64TOD';
+              end
             else
-{$warning generic conversion from int to float does not support unsigned integers}
-              fname := 'fpc_int64_to_'+typname;
-            result := ccallnode.createintern(fname,ccallparanode.create(
+              { other integers are supposed to be 32 bit }
+              begin
+                if is_signed(left.resultdef) then
+                  fname:='ITOD'
+                else
+                  fname:='UTOD';
+                firstpass(left);
+              end;
+            result:=ccallnode.createintern(fname,ccallparanode.create(
               left,nil));
             left:=nil;
             firstpass(result);
             exit;
           end
         else
-          { other integers are supposed to be 32 bit }
           begin
-{$warning generic conversion from int to float does not support unsigned integers}
-            if is_signed(left.resultdef) then
-              fname := 'fpc_longint_to_'+typname
+            { converting a 64bit integer to a float requires a helper }
+            if is_64bitint(left.resultdef) or
+              is_currency(left.resultdef) then
+              begin
+                { hack to avoid double division by 10000, as it's
+                  already done by typecheckpass.resultdef_int_to_real }
+                if is_currency(left.resultdef) then
+                  left.resultdef := s64inttype;
+                if is_signed(left.resultdef) then
+                  fname:='int64_to_'
+                else
+                  { we can't do better currently }
+                  fname:='int64_to_';
+              end
             else
-              fname := 'fpc_longint_to_'+typname;
-            result := ccallnode.createintern(fname,ccallparanode.create(
-              left,nil));
+              { other integers are supposed to be 32 bit }
+              begin
+                if is_signed(left.resultdef) then
+                  fname:='int32_to_'
+                else
+                  { we can't do better currently }
+                  fname:='int32_to_';
+                firstpass(left);
+              end;
+            if tfloatdef(resultdef).floattype=s64real then
+              fname:=fname+'float64'
+            else
+              fname:=fname+'float32';
+            result:=ctypeconvnode.create_internal(ccallnode.createintern(fname,ccallparanode.create(
+              left,nil)),resultdef);
             left:=nil;
             firstpass(result);
             exit;

compiler/options.pas

@@ -1899,6 +1899,9 @@ begin
   def_system_macro('CPU68K');
   def_system_macro('CPUM68K');
   def_system_macro('CPU32');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
 {$endif}
@@ -2179,7 +2182,7 @@ begin
     exclude(init_settings.globalswitches,cs_link_strip);
 
   { force fpu emulation on arm/wince and arm/gba }
-  if target_info.system in [system_arm_wince,system_arm_gba] then
+  if target_info.system in [system_arm_wince,system_arm_gba,system_m68k_amiga] then
     include(init_settings.moduleswitches,cs_fp_emulation);
 
   { Section smartlinking conflicts with import sections on Windows }

compiler/systems/t_amiga.pas

@@ -242,12 +242,12 @@ end;
 *****************************************************************************}
 
 initialization
-{$ifdef cpu68}
+{$ifdef m68k}
 {$warning No executable creation support for m68k yet!}
   RegisterTarget(system_m68k_Amiga_info);
-{$endif cpu68}
-{$ifdef cpupowerpc}
+{$endif m68k}
+{$ifdef powerpc}
   RegisterExternalLinker(system_powerpc_Amiga_info,TLinkerAmiga);
   RegisterTarget(system_powerpc_Amiga_info);
-{$endif cpupowerpc}
+{$endif powerpc}
 end.

rtl/amiga/system.pp

@@ -24,6 +24,12 @@ interface
 
 {$I systemh.inc}
 
+{$ifdef cpum68k}
+{$define fpc_softfpu_interface}
+{$i softfpu.pp}
+{$undef fpc_softfpu_interface}
+{$endif cpum68k}
+
 const
   LineEnding = #10;
   LFNSupport = True;
@@ -32,7 +38,7 @@ const
   PathSeparator = ';';
   maxExitCode = 255;
   MaxPathLen = 256;
-  
+
 const
   UnusedHandle    : LongInt = -1;
   StdInputHandle  : LongInt = 0;
@@ -74,6 +80,25 @@ var
 
 implementation
 
+{$ifdef cpum68k}
+{$define fpc_softfpu_implementation}
+{$i softfpu.pp}
+{$undef fpc_softfpu_implementation}
+
+{ we get these functions and types from the softfpu code }
+{$define FPC_SYSTEM_HAS_float64}
+{$define FPC_SYSTEM_HAS_float32}
+{$define FPC_SYSTEM_HAS_flag}
+{$define FPC_SYSTEM_HAS_extractFloat64Frac0}
+{$define FPC_SYSTEM_HAS_extractFloat64Frac1}
+{$define FPC_SYSTEM_HAS_extractFloat64Exp}
+{$define FPC_SYSTEM_HAS_extractFloat64Frac}
+{$define FPC_SYSTEM_HAS_extractFloat64Sign}
+{$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
+{$define FPC_SYSTEM_HAS_extractFloat32Exp}
+{$define FPC_SYSTEM_HAS_extractFloat32Sign}
+{$endif cpum68k}
+
 {$I system.inc}
 
 {$IFDEF MOSFPC_FILEDEBUG}
@@ -164,7 +189,7 @@ begin
       argc:=0;
       exit;
     end;
-        
+
   { Handle the other args }
   count:=0;
   { first index is one }
@@ -182,7 +207,7 @@ begin
           inc(localindex);
         end;
     end;
-  argc:=localindex;  
+  argc:=localindex;
 end;
 
 function GetProgDir: String;
@@ -214,7 +239,7 @@ var
 begin
   GetProgramName:='';
   FillChar(s1,255,#0);
-  
+
   if GetProgramName(@s1[1],255) then begin
     { now check out and assign the length of the string }
     counter := 1;
@@ -292,7 +317,7 @@ begin
   iDOS := GetInterface(AOS_DOSBase,'main',1,nil);
   iUtility := GetInterface(AOS_UtilityBase,'main',1,nil);
 {$ENDIF}
- 
+
   { Creating the memory pool for growing heap }
   AOS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
   if AOS_heapPool=nil then Halt(1);
@@ -318,7 +343,7 @@ begin
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
 
   { * AmigaOS doesn't have a separate stderr * }
- 
+
   StdErrorHandle:=StdOutputHandle;
   //OpenStdIO(StdErr,fmOutput,StdErrorHandle);
   //OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);

rtl/inc/softfpu.pp

@@ -1560,9 +1560,9 @@ function float64_is_nan(a: float64): flag;
 *----------------------------------------------------------------------------*)
 function float64_is_signaling_nan( a:float64): flag;
  begin
-    float64_is_signaling_nan := flag
+    float64_is_signaling_nan := flag(
            ( ( ( a.high shr 19 ) and $FFF ) = $FFE )
-        and ( (a.low<>0) or ( boolean(( a.high and $0007FFFF )<>0)) );
+        and ( (a.low<>0) or ( ( a.high and $0007FFFF )<>0) ));
 
  end;
 

rtl/inc/systemh.inc

@@ -110,15 +110,8 @@ Type
   ValReal = Real;
 
   {$define SUPPORT_SINGLE}
-  {$IFDEF Unix}
-    { Linux FPU emulator will be used }
-    {$define SUPPORT_DOUBLE}
-  {$ENDIF}
-  {$IFOPT E-}
-    { If not compiling with emulation }
-    { then support double type.       }
-    {$define SUPPORT_DOUBLE}
-  {$ENDIF}
+  {$define SUPPORT_DOUBLE}
+
   { Comp type does not exist on fpu }
   Comp    = int64;
   PComp = ^Comp;