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

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

46
Task/Digital-root/360-Assembly/digital-root.360 Normal file
View file

@ -0,0 +1,46 @@
* Digital root 21/04/2017
DIGROOT CSECT
USING DIGROOT,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A((PG-T)/4)) do i=1 to hbound(t)
LR R1,R6 i
SLA R1,2 *4
L R10,T-4(R1) nn=t(i)
LR R7,R10 n=nn
SR R9,R9 ap=0
DO WHILE=(C,R7,GE,=A(10)) do while(n>=10)
SR R8,R8 x=0
DO WHILE=(C,R7,GE,=A(10)) do while(n>=10)
LR R4,R7 n
SRDA R4,32 >>r5
D R4,=A(10) m=n//10
LR R7,R5 n=n/10
AR R8,R4 x=x+m
ENDDO , end
AR R7,R8 n=x+n
LA R9,1(R9) ap=ap+1
ENDDO , end
XDECO R10,XDEC nn
MVC PG+7(10),XDEC+2
XDECO R9,XDEC ap
MVC PG+31(3),XDEC+9
XDECO R7,XDEC n
MVC PG+41(1),XDEC+11
XPRNT PG,L'PG print
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
T DC F'627615',F'39390',F'588225',F'2147483647'
PG DC CL80'number=xxxxxxxxxx persistence=xxx root=x'
XDEC DS CL12
YREGS
END DIGROOT