mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 07:43:04 +01:00 
			
		
		
		
	+ added rtl/i8086/mathu*.inc for compiling the math unit
git-svn-id: trunk@24595 -
This commit is contained in:
		
							parent
							
								
									062c0aa5f4
								
							
						
					
					
						commit
						c49e927077
					
				
							
								
								
									
										2
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										2
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -7832,6 +7832,8 @@ rtl/i8086/i8086.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/int64p.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/makefile.cpu svneol=native#text/plain
 | 
			
		||||
rtl/i8086/math.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/mathu.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/mathuh.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/set.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/setjump.inc svneol=native#text/plain
 | 
			
		||||
rtl/i8086/setjumph.inc svneol=native#text/plain
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										185
									
								
								rtl/i8086/mathu.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										185
									
								
								rtl/i8086/mathu.inc
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,185 @@
 | 
			
		||||
{
 | 
			
		||||
    This file is part of the Free Pascal run time library.
 | 
			
		||||
    Copyright (c) 1999-2003 by Florian Klaempfl
 | 
			
		||||
    member of the Free Pascal development team
 | 
			
		||||
 | 
			
		||||
    See the file COPYING.FPC, included in this distribution,
 | 
			
		||||
    for details about the copyright.
 | 
			
		||||
 | 
			
		||||
    This program is distributed in the hope that it will be useful,
 | 
			
		||||
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | 
			
		||||
 | 
			
		||||
**********************************************************************}
 | 
			
		||||
 | 
			
		||||
{$ASMMODE ATT}
 | 
			
		||||
{//$define FPC_MATH_HAS_ARCTAN2}
 | 
			
		||||
{function arctan2(y,x : float) : float;assembler;
 | 
			
		||||
  asm
 | 
			
		||||
     fldt y
 | 
			
		||||
     fldt x
 | 
			
		||||
     fpatan
 | 
			
		||||
     fwait
 | 
			
		||||
  end;}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
{//$define FPC_MATH_HAS_SINCOS}
 | 
			
		||||
{procedure sincos(theta : extended;out sinus,cosinus : extended);assembler;
 | 
			
		||||
  asm
 | 
			
		||||
    fldt theta
 | 
			
		||||
    fsincos
 | 
			
		||||
    fstpt (%edx)
 | 
			
		||||
    fstpt (%eax)
 | 
			
		||||
    fwait
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
procedure sincos(theta : double;out sinus,cosinus : double);assembler;
 | 
			
		||||
  asm
 | 
			
		||||
    fldl theta
 | 
			
		||||
    fsincos
 | 
			
		||||
    fstpl (%edx)
 | 
			
		||||
    fstpl (%eax)
 | 
			
		||||
    fwait
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
procedure sincos(theta : single;out sinus,cosinus : single);assembler;
 | 
			
		||||
  asm
 | 
			
		||||
    flds theta
 | 
			
		||||
    fsincos
 | 
			
		||||
    fstps (%edx)
 | 
			
		||||
    fstps (%eax)
 | 
			
		||||
    fwait
 | 
			
		||||
  end;}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
{//$define FPC_MATH_HAS_TAN}
 | 
			
		||||
{function tan(x : float) : float;assembler;
 | 
			
		||||
  asm
 | 
			
		||||
    fldt X
 | 
			
		||||
    fptan
 | 
			
		||||
    fstp %st
 | 
			
		||||
    fwait
 | 
			
		||||
  end;}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
{//$define FPC_MATH_HAS_COTAN}
 | 
			
		||||
{function cotan(x : float) : float;assembler;
 | 
			
		||||
  asm
 | 
			
		||||
    fldt X
 | 
			
		||||
    fptan
 | 
			
		||||
    fdivp %st,%st(1)
 | 
			
		||||
    fwait
 | 
			
		||||
  end;}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
{//$define FPC_MATH_HAS_DIVMOD}
 | 
			
		||||
{procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);assembler;
 | 
			
		||||
asm
 | 
			
		||||
  pushl  %edi
 | 
			
		||||
  movzwl %dx,%edi
 | 
			
		||||
  cltd
 | 
			
		||||
  idiv   %edi
 | 
			
		||||
  movw   %ax,(%ecx)
 | 
			
		||||
  movl   Remainder,%ecx
 | 
			
		||||
  movw   %dx,(%ecx)
 | 
			
		||||
  popl   %edi
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: SmallInt);assembler;
 | 
			
		||||
asm
 | 
			
		||||
  pushl  %edi
 | 
			
		||||
  movzwl %dx,%edi
 | 
			
		||||
  cltd
 | 
			
		||||
  idiv   %edi
 | 
			
		||||
  movw   %ax,(%ecx)
 | 
			
		||||
  movl   Remainder,%ecx
 | 
			
		||||
  movw   %dx,(%ecx)
 | 
			
		||||
  popl   %edi
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
procedure DivMod(Dividend: DWord; Divisor: DWord; var Result, Remainder: DWord);assembler;
 | 
			
		||||
asm
 | 
			
		||||
  pushl %edi
 | 
			
		||||
  movl %edx,%edi
 | 
			
		||||
  xorl %edx,%edx
 | 
			
		||||
  div  %edi
 | 
			
		||||
  movl %eax,(%ecx)
 | 
			
		||||
  movl Remainder,%ecx
 | 
			
		||||
  movl %edx,(%ecx)
 | 
			
		||||
  popl %edi
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
procedure DivMod(Dividend: Integer; Divisor: Integer; var Result, Remainder: Integer);assembler;
 | 
			
		||||
asm
 | 
			
		||||
  pushl %edi
 | 
			
		||||
  movl %edx,%edi
 | 
			
		||||
  cltd
 | 
			
		||||
  idiv %edi
 | 
			
		||||
  movl %eax,(%ecx)
 | 
			
		||||
  movl Remainder,%ecx
 | 
			
		||||
  movl %edx,(%ecx)
 | 
			
		||||
  popl %edi
 | 
			
		||||
end;}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
function GetRoundMode: TFPURoundingMode;
 | 
			
		||||
begin
 | 
			
		||||
  Result := TFPURoundingMode((Get8087CW shr 10) and 3);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 | 
			
		||||
var
 | 
			
		||||
  CtlWord: Word;
 | 
			
		||||
begin
 | 
			
		||||
  CtlWord := Get8087CW;
 | 
			
		||||
  Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
 | 
			
		||||
{  if has_sse_support then
 | 
			
		||||
    SetSSECSR((GetSSECSR and $ffff9fff) or (dword(RoundMode) shl 13));}
 | 
			
		||||
  Result := TFPURoundingMode((CtlWord shr 10) and 3);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function GetPrecisionMode: TFPUPrecisionMode;
 | 
			
		||||
begin
 | 
			
		||||
  Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
 | 
			
		||||
var
 | 
			
		||||
  CtlWord: Word;
 | 
			
		||||
begin
 | 
			
		||||
  CtlWord := Get8087CW;
 | 
			
		||||
  Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
 | 
			
		||||
  Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function GetExceptionMask: TFPUExceptionMask;
 | 
			
		||||
begin
 | 
			
		||||
  Result := TFPUExceptionMask(Longint(Get8087CW and $3F));
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 | 
			
		||||
var
 | 
			
		||||
  CtlWord: Word;
 | 
			
		||||
begin
 | 
			
		||||
  CtlWord := Get8087CW;
 | 
			
		||||
  Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
 | 
			
		||||
{  if has_sse_support then
 | 
			
		||||
    SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));}
 | 
			
		||||
  softfloat_exception_mask:=dword(Mask);
 | 
			
		||||
  Result := TFPUExceptionMask(Longint(CtlWord and $3F));
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
procedure ClearExceptions(RaisePending: Boolean);assembler;
 | 
			
		||||
asm
 | 
			
		||||
  cmpb $0,RaisePending
 | 
			
		||||
  je .Lclear
 | 
			
		||||
  fwait
 | 
			
		||||
.Lclear:
 | 
			
		||||
  fnclex
 | 
			
		||||
end;
 | 
			
		||||
							
								
								
									
										29
									
								
								rtl/i8086/mathuh.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										29
									
								
								rtl/i8086/mathuh.inc
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,29 @@
 | 
			
		||||
{
 | 
			
		||||
    This file is part of the Free Pascal run time library.
 | 
			
		||||
    Copyright (c) 1999-2003 by Florian Klaempfl
 | 
			
		||||
    member of the Free Pascal development team
 | 
			
		||||
 | 
			
		||||
    See the file COPYING.FPC, included in this distribution,
 | 
			
		||||
    for details about the copyright.
 | 
			
		||||
 | 
			
		||||
    This program is distributed in the hope that it will be useful,
 | 
			
		||||
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
			
		||||
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | 
			
		||||
 | 
			
		||||
 **********************************************************************}
 | 
			
		||||
 | 
			
		||||
{ i386 fpu control word }
 | 
			
		||||
type
 | 
			
		||||
  TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
 | 
			
		||||
  TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
 | 
			
		||||
  TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
 | 
			
		||||
                   exOverflow, exUnderflow, exPrecision);
 | 
			
		||||
  TFPUExceptionMask = set of TFPUException;
 | 
			
		||||
 | 
			
		||||
function GetRoundMode: TFPURoundingMode;
 | 
			
		||||
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 | 
			
		||||
function GetPrecisionMode: TFPUPrecisionMode;
 | 
			
		||||
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
 | 
			
		||||
function GetExceptionMask: TFPUExceptionMask;
 | 
			
		||||
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 | 
			
		||||
procedure ClearExceptions(RaisePending: Boolean =true);
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user