mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-26 16:33:45 +01:00 
			
		
		
		
	- removed empty ppc-specific frac()
+ added correct generic frac() implementation for doubles (translated
    from glibc code)
			
			
This commit is contained in:
		
							parent
							
								
									53152499c5
								
							
						
					
					
						commit
						c59fb8e28a
					
				| @ -78,9 +78,8 @@ const sincof : TabCoef = ( | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| {$ifndef FPC_SYSTEM_HAS_TRUNC} | ||||
| { also necessary for Int() on systems with 64bit floats (JM) } | ||||
| type | ||||
|   float32 = longint; | ||||
| {$ifdef ENDIAN_LITTLE} | ||||
|   float64 = packed record | ||||
|     low: longint; | ||||
| @ -92,6 +91,10 @@ type | ||||
|     low: longint; | ||||
|   end; | ||||
| {$endif} | ||||
| 
 | ||||
| {$ifndef FPC_SYSTEM_HAS_TRUNC} | ||||
| type | ||||
|   float32 = longint; | ||||
|   flag = byte; | ||||
| 
 | ||||
|   Function extractFloat64Frac0(a: float64): longint; | ||||
| @ -258,12 +261,60 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint; | ||||
| 
 | ||||
| 
 | ||||
| {$ifndef FPC_SYSTEM_HAS_INT} | ||||
| 
 | ||||
| {$ifdef SUPPORT_DOUBLE} | ||||
| 
 | ||||
|     { straight Pascal translation of the code for __trunc() in } | ||||
|     { the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM)    } | ||||
|     function int(d: double): double;[internconst:in_const_int]; | ||||
|       var | ||||
|         i0, j0: longint; | ||||
|         i1: cardinal; | ||||
|         sx: longint; | ||||
|       begin | ||||
|         i0 := float64(d).high; | ||||
|         i1 := cardinal(float64(d).low); | ||||
|         sx := i0 and $80000000; | ||||
|         j0 := ((i0 shr 20) and $7ff) - $3ff; | ||||
|         if (j0 < 20) then | ||||
|           begin | ||||
|             if (j0 < 0) then | ||||
|               begin | ||||
|                 { the magnitude of the number is < 1 so the result is +-0. } | ||||
|                 float64(d).high := sx; | ||||
|                 float64(d).low := 0; | ||||
|               end | ||||
|             else | ||||
|               begin | ||||
|                 float64(d).high := sx or (i0 and not($fffff shr j0)); | ||||
|                 float64(d).low := 0; | ||||
|               end | ||||
|           end | ||||
|         else if (j0 > 51) then | ||||
|           begin | ||||
|             if (j0 = $400) then | ||||
|               { d is inf or NaN } | ||||
|               exit(d + d); { don't know why they do this (JM) } | ||||
|           end | ||||
|         else | ||||
|           begin | ||||
|             float64(d).high := i0; | ||||
|             float64(d).low := longint(i1 and not(cardinal($ffffffff) shr (j0 - 20))); | ||||
|           end; | ||||
|         result := d; | ||||
|       end; | ||||
| 
 | ||||
| {$else SUPPORT_DOUBLE} | ||||
| 
 | ||||
| 
 | ||||
|     function int(d : real) : real;[internconst:in_const_int]; | ||||
|       begin | ||||
|         { this will be correct since real = single in the case of } | ||||
|         { the motorola version of the compiler...                 } | ||||
|         int:=real(trunc(d)); | ||||
|       end; | ||||
| {$endif SUPPORT_DOUBLE} | ||||
| 
 | ||||
| {$endif} | ||||
| 
 | ||||
| 
 | ||||
| @ -1030,7 +1081,12 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint; | ||||
| 
 | ||||
| { | ||||
|   $Log$ | ||||
|   Revision 1.11  2003-04-23 21:28:21  peter | ||||
|   Revision 1.12  2003-05-02 15:12:19  jonas | ||||
|     - removed empty ppc-specific frac() | ||||
|     + added correct generic frac() implementation for doubles (translated | ||||
|       from glibc code) | ||||
| 
 | ||||
|   Revision 1.11  2003/04/23 21:28:21  peter | ||||
|     * fpc_round added, needed for int64 currency | ||||
| 
 | ||||
|   Revision 1.10  2003/01/15 00:45:17  peter | ||||
|  | ||||
| @ -64,21 +64,7 @@ const | ||||
|         runerror(207); | ||||
|       end; | ||||
| 
 | ||||
| 
 | ||||
|     function frac(d : extended) : extended;[internconst:in_const_frac]; | ||||
|       begin | ||||
|         runerror(207); | ||||
|       end; | ||||
| 
 | ||||
| 
 | ||||
|     } | ||||
|     {$define FPC_SYSTEM_HAS_INT} | ||||
|     {$warning FIX ME} | ||||
|     function int(d : extended) : extended;[internconst:in_const_int]; | ||||
|       begin | ||||
|         runerror(207); | ||||
|       end; | ||||
| 
 | ||||
| 
 | ||||
|       const | ||||
|         factor: double = double(int64(1) shl 32); | ||||
| @ -370,7 +356,12 @@ end ['R0','R3','F0','F1','F2','F3']; | ||||
| 
 | ||||
| { | ||||
|   $Log$ | ||||
|   Revision 1.19  2003-04-26 20:36:24  jonas | ||||
|   Revision 1.20  2003-05-02 15:12:19  jonas | ||||
|     - removed empty ppc-specific frac() | ||||
|     + added correct generic frac() implementation for doubles (translated | ||||
|       from glibc code) | ||||
| 
 | ||||
|   Revision 1.19  2003/04/26 20:36:24  jonas | ||||
|     * trunc now also supports int64 (no NaN's etc though) | ||||
| 
 | ||||
|   Revision 1.18  2003/04/26 17:20:16  florian | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 Jonas Maebe
						Jonas Maebe