*        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