*        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