aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

YAPC::EU 2018 Glasgow Update!

Browse source
This commit is contained in:
Ingy döt Net 2018-08-17 15:15:24 +01:00
parent 22f33d4004
commit 4e2d22a71d
1170 changed files with 15042 additions and 3047 deletions
Download patch file Download diff file Expand all files Collapse all files

59
Task/Nth-root/360-Assembly/nth-root.360 Normal file
View file

@ -0,0 +1,59 @@
* Nth root - x**(1/n) - 29/07/2018
NTHROOT CSECT
USING NTHROOT,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
BAL R14,ROOTN call rootn(x,n)
LE F0,XN xn=rootn(x,n)
LA R0,6 decimals=6
BAL R14,FORMATF edit xn
MVC PG(13),0(R1) output xn
XPRNT PG,L'PG print buffer
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
ROOTN MVC ZN,=E'0' zn=0 ----------------------------
MVC ZN,N n
MVI ZN,X'46' zn=unnormalize(n)
LE F0,ZN zn
AE F0,=E'0' normalized
STE F0,ZN zn=normalize(n)
LE F6,=E'0' xm=0
LE F0,X x
DE F0,ZN /zn
STE F0,XN xn=x/zn
WHILEA LE F0,XN xn
SER F0,F6 xn-xm
LPER F0,F0 abs((xn-xm)
DE F0,XN /xn
CE F0,EPSILON while abs((xn-xm)/xn)>epsilon
BNH EWHILEA ~
LE F6,XN xm=xn
LE F0,ZN zn
SE F0,=E'1' zn-1
MER F0,F6 f0=(zn-1)*xm
L R2,N n
BCTR R2,0 n-1
LE F2,=E'1' xm
POW MER F2,F6 *xm
BCT R2,POW f2=xm**(n-1)
LE F4,X x
DER F4,F2 x/xm**(n-1)
AER F0,F4 (zn-1)*xm+x/xm**(n-1)
DE F0,ZN /zn
STE F0,XN xn=((zn-1)*xm+x/xm**(n-1))/zn
B WHILEA endwhile
EWHILEA LE F0,XN xn
BR R14 return ---------------------------
COPY FORMATF format a float
X DC E'2' x <== input
N DC F'2' n <== input
EPSILON DC E'1E-6' imprecision
XN DS E xn :: output
ZN DS E zn=float(n)
PG DC CL80' ' buffer
REGEQU
END NTHROOT