Liczby rzeczywiste w Action!
Artykuł Wojciecha Zientary o liczbach rzeczywistych w Action! opublikowany został w Bajtku nr 11 z 1988 roku na stronie 10.
Poniższy listing przedstawia bibliotekę z zestawem procedur i funkcji operujących na liczbach zmiennoprzecinkowych wykorzystującą pakiet matematyczny zawarty w ROM Atari XE/XL. Prędkość wykonywania operacji matematycznych większości użytkowników jest znana – z takich procedur korzysta między innymi wbudowany Atari BASIC. Do większości prostych zastosowań w zupełności wystarczy, natomiast tam gdzie potrzebna jest wyższa wydajność może przyjść z pomocą biblioteka twórcy Action! – firmy OSS.
;Liczby rzeczywiste w Action!
;Wojciech Zientara
;Copyright (c) 1988 Bajtek
MODULE
TYPE REAL=[CARD r1,r2,r3]
REAL fr0=$D4, fr1=$E0
INT fr0int=$D4
CARD inbuff=$F3
BYTE ARRAY lbuff=$580
PROC AFP=$D800()
PROC FASC=$D8E6()
PROC IFP=$D9AA()
PROC FPI=$D9D2()
PROC FSUB=$DA60()
PROC FADD=$DA66()
PROC FMULT=$DADB()
PROC FDIV=$DB28()
PROC FEXP=$DDC0()
PROC FEXP10=$DDCC()
PROC FLOG=$DECD()
PROC FLOG10=$DED1()
;procedura przypisania: LET a=b
PROC RAssign(REAL POINTER a,b)
b.r1=a.r1
b.r2=a.r2
b.r3=a.r3
RETURN
;zamiana REAL na INT
INT FUNC RtI(REAL POINTER r)
RAssign(r,fr0)
FPI()
RETURN(fr0int)
;procedura pusta
PROC Dummy()
RETURN
;zamiana INT na REAL
PROC ItR(INT i REAL POINTER r)
fr0int=i
Dummy=IFP
Dummy()
RAssign(fr0,r)
RETURN
;zamiana REAL na tekst ASCII
PROC StrR(REAL POINTER r BYTE ARRAY s)
BYTE i,c
BYTE POINTER pnt
RAssign(r,fr0)
FASC()
pnt=inbuff
WHILE pnt^=’0
DO
pnt==+1
OD
i=0
DO
c=pnt(i)
i==+1
s(i)=c&$7F
UNTIL c&$80
OD
s(0)=i
RETURN
;zamiana tekstu na REAL
PROC ValR(BYTE ARRAY s REAL POINTER r)
BYTE i,cix=$F2
FOR i=1 TO s(0)
DO
lbuff(i-1)=s(i)
OD
lbuff(i-1)=0
inbuff=lbuff
cix=0
AFP()
RAssign(fr0,r)
RETURN
;dodawanie c=a+b
PROC RAdd(REAL POINTER a,b,c)
RAssign(a,fr0)
RAssign(b,fr1)
FADD()
RAssign(fr0,c)
RETURN
;odejmowanie: c=a-b
PROC RSub(REAL POINTER a,b,c)
RAssign(a,fr0)
RAssign(b,fr1)
FSUB()
RAssign(fr0,c)
RETURN
;mnozenie: c=a*b
PROC RMul(REAL POINTER a,b,c)
RAssign(a,fr0)
RAssign(b,fr1)
FMULT()
RAssign(fr0,c)
RETURN
;dzielenie: c=a/b
PROC RDiv(REAL POINTER a,b,c)
RAssign(a,fr0)
RAssign(b,fr1)
FDIV()
RAssign(fr0,c)
RETURN
;podnoszenie e do potegi: b=e^a
PROC Exp(REAL POINTER a,b)
RAssign(a,fr0)
FEXP()
RAssign(fr0,b)
RETURN
;podnoszenie 10 do potegi: b=10^a
PROC Exp10(REAL POINTER a,b)
RAssign(a,fr0)
FEXP10()
RAssign(fr0,b)
RETURN
;logarytm naturalny: b=ln a
PROC Log(REAL POINTER a,b)
RAssign(a,fr0)
FLOG()
RAssign(fr0,b)
RETURN
;logarytm dziesietny: b=log a
PROC CLog(REAL POINTER a,b)
RAssign(a,fr0)
FLOG10()
RAssign(fr0,b)
RETURN
;potegowanie: c=a^b
PROC Power(REAL POINTER a,b,c)
Log(a,c)
RMul(b,c,c)
Exp(c,c)
RETURN
;zapis REAL na urzadzenie
PROC PrintRD(BYTE d REAL POINTER a)
BYTE ARRAY aux(20)
StrR(a,aux)
PrintD(d,aux)
RETURN
;zapis REAL na urzadzenie standardowe
PROC PrintR(REAL POINTER a)
PrintRD(device,a)
RETURN
;zapis REAL na urzadzenie ze znakiem konca wiersza (RETURN)
PROC PrintRDE(BYTE d REAL POINTER a)
PrintRD(d,a)
PutDE(d)
RETURN
;zapis REAL na urzadzenie standardowe ze znakiem konca wiersza (RETURN)
PROC PrintRE(REAL POINTER a)
PrintRDE(device,a)
RETURN
;odczyt REAL z urzadzenia
PROC InputRD(BYTE d REAL POINTER a)
BYTE ARRAY aux(128)
InputMD(d,aux,126)
ValR(aux,a)
RETURN
;odczyt REAL z urzadzenia standardowego
PROC InputR(REAL POINTER a)
InputRD(device,a)
RETURN
Oryginalny listing zawiera również przykład programu „kalkulator”. Dla potrzeby wizualnego ładu oddzieliłem go od listingu procedur.
;przyklad – kalkulator
MODULE
REAL k,l,m
PROC Setup()
Graphics(0)
PrintE(” REAL Calculator”)
PutE() PutE() PutE()
PrintE(” + = dodawanie”)
PrintE(” – = odejmowanie”)
PrintE(” * = mnozenie”)
PrintE(” / = dzielenie”)
PrintE(„HELP = koniec”)
PutE() PutE()
PrintE(„Wybierz dzialanie”) PutE()
RETURN
PROC Operate(Byte o)
BYTE n,key=$2FC
key=$FF
FOR n=1 TO 6
DO Put($9C) OD
PrintE(„pierwsza liczba „)
InputR(k)
PrintE(” druga liczba „)
InputR(l) PutE()
IF o=6 THEN
RAdd(k,l,m)
ELSEIF o=14 THEN
RSub(k,l,m)
ELSEIF o=7 THEN
RMul(k,l,m)
ELSE
RDiv(k,l,m)
FI
Print(„wynik = „)
PrintRE(m)
FOR n=1 TO 6
DO Put($1C) OD
RETURN
PROC Work()
BYTE key=$2FC,help=$2DC
help=0 key=$FF
DO
IF help=$11 THEN EXIT FI
IF key=6 OR key=7 OR
key=14 OR key=38 THEN
Operate(key)
FI
OD
RETURN
PROC Main()
Setup()
Work()
Graphics(0)
RETURN