Category:Action! Real Math

REALMATH.ACT

The following module has been prepared for RosettaCode to provide basic functions and procedures related to floating point numbers which are missing or incorrectly implemented in module REAL.ACT. It is required to run MathInit before using Sqrt procedure or variables half or rzero.

<lang Action!>; The user should call MathInit

before first using of Sqrt procedure

MODULE

INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

REAL half,rzero

BYTE FUNC RealEqual(REAL POINTER a,b)

 BYTE ARRAY x,y

 x=a y=b
 IF x(0)=y(0) AND x(1)=y(1) AND x(2)=y(2) THEN
   RETURN (1)
 FI

RETURN (0)

BYTE FUNC RealGreaterOrEqual(REAL POINTER left,right)

 REAL diff
 BYTE ARRAY x

 RealSub(left,right,diff)
 x=diff

 IF (x(0)&$80)=$00 THEN
   RETURN (1)
 FI

RETURN (0)

BYTE FUNC RealGreater(REAL POINTER left,right)

 IF RealGreaterOrEqual(left,right)=1 AND
    RealEqual(left,right)=0 THEN
   RETURN (0)
 FI

RETURN (0)

BYTE FUNC RealLessOrEqual(REAL POINTER left,right)

 REAL diff
 BYTE ARRAY x

 RealSub(right,left,diff)
 x=diff

 IF (x(0)&$80)=$00 THEN
   RETURN (1)
 FI

RETURN (0)

BYTE FUNC RealLess(REAL POINTER left,right)

 IF RealEqual(left,right) THEN
   RETURN (0)
 ELSEIF RealLessOrEqual(left,right) THEN
   RETURN (1)
 FI

RETURN (0)

INT FUNC Round(REAL POINTER r)

 BYTE ARRAY x
 REAL tmp
 INT i

 x=r
 IF (x(0)&$80)=0 THEN
   i=RealToInt(r)
 ELSE
   RealAssign(r,tmp)
   x=tmp
   x(0)==&$7F
   i=-RealToInt(tmp)
 FI

RETURN (i)

PROC IntToRealForNeg(INT a REAL POINTER r)

 BYTE ARRAY x

 IF a>=0 THEN
   IntToReal(a,r)
 ELSE
   IntToReal(-a,r)
   x=r
   x(0)==%$80
 FI

RETURN

BYTE FUNC IsNegative(REAL POINTER r)

 BYTE ARRAY x

 x=r
 IF (x(0)&$80)=$80 THEN
   RETURN (1)
 FI

RETURN (0)

INT FUNC Floor(REAL POINTER x)

 REAL tmp

 IF RealEqual(x,rzero) THEN
   RETURN (0)
 FI
 RealSub(x,half,tmp)

RETURN (Round(tmp))

INT FUNC Ceiling(REAL POINTER x)

 REAL tmp

 IF RealEqual(x,rzero) THEN
   RETURN (0)
 FI
 RealAdd(x,half,tmp)

RETURN (Round(tmp))

PROC Trunc(REAL POINTER x,res)

 BYTE ARRAY b
 BYTE exp

 RealAssign(x,res)
 b=res
 exp=b(0)&$7F
 IF exp<=67 THEN
   b(5)=0
   IF exp<=66 THEN b(4)=0 FI
   IF exp<=65 THEN b(3)=0 FI
   IF exp<=64 THEN b(2)=0 FI
   IF exp<=63 THEN b(0)=0 b(1)=0 FI
 FI

RETURN

PROC Frac(REAL POINTER x,res)

 REAL t

 Trunc(x,t)
 RealSub(x,t,res)

RETURN

PROC RealDivInt(REAL POINTER x,n,res)

 REAL r

 RealDiv(x,n,r)
 Trunc(r,res)

RETURN

PROC RealMod(REAL POINTER x,n,res)

 RealDivInt(x,n,res)
 RealMult(res,n,res)
 RealSub(x,res,res)

RETURN

PROC Sqrt(REAL POINTER a,b)

 IF RealEqual(a,rzero) THEN
   RealAssign(rzero,b)
 ELSE
   Power(a,half,b)
 FI

RETURN

PROC RealAbs(REAL POINTER a,b)

 BYTE ARRAY x

 RealAssign(a,b)
 x=b
 x(0)=x(0) & $7F

RETURN

PROC RealAbsDiff(Real POINTER a,b,diff)

 BYTE ARRAY x
 
 RealSub(a,b,diff)
 x=diff
 x(0)=x(0) & $7F

RETURN

PROC MathInit()

 IntToReal(0,rzero)
 ValR("0.5",half)

RETURN

MODULE</lang>