Category:Action! Real Math

REALMATH.ACT[edit]

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.

; 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