76 lines
2.7 KiB
Text
76 lines
2.7 KiB
Text
* Perfect numbers 15/05/2016
|
|
PERFECPO CSECT
|
|
USING PERFECPO,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 "
|
|
ZAP I,I1 i=i1
|
|
LOOPI CP I,I2 do i=i1 to i2
|
|
BH ELOOPI
|
|
LA R1,I r1=@i
|
|
BAL R14,PERFECT perfect(i)
|
|
LTR R0,R0 if perfect(i)
|
|
BZ NOTPERF
|
|
UNPK PG(16),I unpack i
|
|
OI PG+15,X'F0'
|
|
XPRNT PG,16 print i
|
|
NOTPERF AP I,=P'1' i=i+1
|
|
B LOOPI
|
|
ELOOPI L R13,4(0,R13) epilog
|
|
LM R14,R12,12(R13) "
|
|
XR R15,R15 "
|
|
BR R14 exit
|
|
PERFECT EQU * function perfect(n);
|
|
ZAP N,0(8,R1) n=%r1
|
|
CP N,=P'6' if n=6
|
|
BNE NOT6
|
|
L R0,=F'-1' r0=true
|
|
B RETURN return(true)
|
|
NOT6 ZAP PW,N n
|
|
SP PW,=P'1' n-1
|
|
ZAP PW2,PW n-1
|
|
DP PW2,=PL8'9' (n-1)/9
|
|
ZAP R,PW2+8(8) if mod((n-1),9)<>0
|
|
BZ ZERO
|
|
SR R0,R0 r0=false
|
|
B RETURN return(false)
|
|
ZERO ZAP PW2,N n
|
|
DP PW2,=PL8'2' n/2
|
|
ZAP SUM,PW2(8) sum=n/2
|
|
AP SUM,=P'3' sum=n/2+3
|
|
ZAP J,=P'3' j=3
|
|
LOOPJ ZAP PW,J do loop on j
|
|
MP PW,J j*j
|
|
CP PW,N while j*j<=n
|
|
BH ELOOPJ
|
|
ZAP PW2,N n
|
|
DP PW2,J n/j
|
|
CP PW2+8(8),=P'0' if mod(n,j)<>0
|
|
BNE NEXTJ
|
|
AP SUM,J sum=sum+j
|
|
ZAP PW2,N n
|
|
DP PW2,J n/j
|
|
AP SUM,PW2(8) sum=sum+j+n/j
|
|
NEXTJ AP J,=P'1' j=j+1
|
|
B LOOPJ next j
|
|
ELOOPJ SR R0,R0 r0=false
|
|
CP SUM,N if sum=n
|
|
BNE RETURN
|
|
BCTR R0,0 r0=true
|
|
RETURN BR R14 return(r0); end perfect
|
|
I1 DC PL8'1'
|
|
I2 DC PL8'200000000000'
|
|
I DS PL8
|
|
PG DC CL16' ' buffer
|
|
N DS PL8
|
|
SUM DS PL8
|
|
J DS PL8
|
|
R DS PL8
|
|
C DS CL16
|
|
PW DS PL8
|
|
PW2 DS PL16
|
|
YREGS
|
|
END PERFECPO
|