RosettaCodeData/Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360
2016-12-05 22:15:40 +01:00

47 lines
1.7 KiB
Text

* Perfect numbers 15/05/2016
PERFECTN CSECT
USING PERFECTN,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
LA R6,2 i=2
LOOPI C R6,NN do i=2 to nn
BH ELOOPI
LR R1,R6 i
BAL R14,PERFECT
LTR R0,R0 if perfect(i)
BZ NOTPERF
XDECO R6,PG edit i
XPRNT PG,L'PG print i
NOTPERF LA R6,1(R6) i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT SR R9,R9 function perfect(n); sum=0
LA R7,1 j
LR R8,R1 n
SRA R8,1 n/2
LOOPJ CR R7,R8 do j=1 to n/2
BH ELOOPJ
LR R4,R1 n
SRDA R4,32
DR R4,R7 n/j
LTR R4,R4 if mod(n,j)=0
BNZ NOTMOD
AR R9,R7 sum=sum+j
NOTMOD LA R7,1(R7) j=j+1
B LOOPJ
ELOOPJ SR R0,R0 r0=false
CR R9,R1 if sum=n
BNE NOTEQ
BCTR R0,0 r0=true
NOTEQ BR R14 return(r0); end perfect
NN DC F'10000'
PG DC CL12' ' buffer
YREGS
END PERFECTN