mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 01:19:38 +01:00 
			
		
		
		
	* fixed power() in genmath.inc (code duplication from math.pp for **
support!) * fixed power() in math.pp to give an error from 0^0
This commit is contained in:
		
							parent
							
								
									80606b3569
								
							
						
					
					
						commit
						08da4e9278
					
				@ -1198,7 +1198,30 @@ type
 | 
			
		||||
{$endif}
 | 
			
		||||
 | 
			
		||||
{$ifndef FPC_SYSTEM_HAS_POWER}
 | 
			
		||||
function intpower(base : real;const exponent: longint) : real;
 | 
			
		||||
  var
 | 
			
		||||
     i : longint;
 | 
			
		||||
  begin
 | 
			
		||||
     i:=abs(exponent);
 | 
			
		||||
     intpower:=1.0;
 | 
			
		||||
     while i>0 do
 | 
			
		||||
       begin
 | 
			
		||||
          while (i and 1)=0 do
 | 
			
		||||
            begin
 | 
			
		||||
               i:=i shr 1;
 | 
			
		||||
               base:=sqr(base);
 | 
			
		||||
            end;
 | 
			
		||||
          dec(i);
 | 
			
		||||
          intpower:=intpower*base;
 | 
			
		||||
       end;
 | 
			
		||||
     if exponent<0 then
 | 
			
		||||
       intpower:=1.0/intpower;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
    function power(bas,expo : real) : real;
 | 
			
		||||
     var
 | 
			
		||||
       sign: real;
 | 
			
		||||
     begin
 | 
			
		||||
        if bas=0.0 then
 | 
			
		||||
          begin
 | 
			
		||||
@ -1209,10 +1232,11 @@ type
 | 
			
		||||
          end
 | 
			
		||||
        else if expo=0.0 then
 | 
			
		||||
         power:=1
 | 
			
		||||
        else
 | 
			
		||||
        else if (abs(expo)<=high(longint)) and (frac(expo)=0.0) then
 | 
			
		||||
          power := intpower(bas,trunc(expo))
 | 
			
		||||
        { bas < 0 is not allowed }
 | 
			
		||||
         if bas<0.0 then
 | 
			
		||||
          handleerror(207)
 | 
			
		||||
        else if bas<0.0 then
 | 
			
		||||
          HandleError(207)
 | 
			
		||||
         else
 | 
			
		||||
          power:=exp(ln(bas)*expo);
 | 
			
		||||
     end;
 | 
			
		||||
@ -1307,7 +1331,12 @@ function fpc_int64_to_double(i : int64): double; compilerproc;
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.29  2004-11-21 15:35:23  peter
 | 
			
		||||
  Revision 1.30  2004-12-05 16:43:57  jonas
 | 
			
		||||
    * fixed power() in genmath.inc (code duplication from math.pp for **
 | 
			
		||||
      support!)
 | 
			
		||||
    * fixed power() in math.pp to give an error from 0^0
 | 
			
		||||
 | 
			
		||||
  Revision 1.29  2004/11/21 15:35:23  peter
 | 
			
		||||
    * float routines all use internproc and compilerproc helpers
 | 
			
		||||
 | 
			
		||||
  Revision 1.28  2004/11/20 15:49:21  jonas
 | 
			
		||||
 | 
			
		||||
@ -620,7 +620,10 @@ function power(base,exponent : float) : float;
 | 
			
		||||
 | 
			
		||||
  begin
 | 
			
		||||
    if Exponent=0.0 then
 | 
			
		||||
      result:=1.0
 | 
			
		||||
      if base <> 0.0 then
 | 
			
		||||
        result:=1.0
 | 
			
		||||
      else
 | 
			
		||||
        InvalidArgument
 | 
			
		||||
    else if (base=0.0) and (exponent>0.0) then
 | 
			
		||||
      result:=0.0
 | 
			
		||||
    else if (abs(exponent)<=maxint) and (frac(exponent)=0.0) then
 | 
			
		||||
@ -1339,7 +1342,12 @@ end;
 | 
			
		||||
end.
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.24  2004-12-04 23:38:59  florian
 | 
			
		||||
  Revision 1.25  2004-12-05 16:43:57  jonas
 | 
			
		||||
    * fixed power() in genmath.inc (code duplication from math.pp for **
 | 
			
		||||
      support!)
 | 
			
		||||
    * fixed power() in math.pp to give an error from 0^0
 | 
			
		||||
 | 
			
		||||
  Revision 1.24  2004/12/04 23:38:59  florian
 | 
			
		||||
    * fixed power(float,float) for negative exponents
 | 
			
		||||
 | 
			
		||||
  Revision 1.23  2004/07/25 16:46:08  michael
 | 
			
		||||
@ -1394,4 +1402,4 @@ end.
 | 
			
		||||
  Revision 1.7  2002/09/07 16:01:22  peter
 | 
			
		||||
    * old logs removed and tabs fixed
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user