I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

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)
REAL tmp1,tmp2
INT t
 
IF RealEqual(x,rzero) THEN
RealAssign(x,res)
ELSEIF IsNegative(x) THEN
RealAdd(x,half,tmp1)
ELSE
RealSub(x,half,tmp1)
FI
t=Round(tmp1)
IntToRealForNeg(t,res)
RETURN
 
PROC Frac(REAL POINTER x,res)
REAL t
 
Trunc(x,t)
RealSub(x,t,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