Category:Action! Real Math
From Rosetta Code
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
Pages in category "Action! Real Math"
The following 33 pages are in this category, out of 33 total.