47 lines
2.0 KiB
Plaintext
47 lines
2.0 KiB
Plaintext
* 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
|