*        Hailstone sequence        16/08/2015
HAILSTON CSECT
         USING  HAILSTON,R12
         LR     R12,R15
         ST     R14,SAVER14
BEGIN    L      R11,=F'100000'     nmax
         LA     R8,27              n=27
         LR     R1,R8
         MVI    FTAB,X'01'         ftab=true
         BAL    R14,COLLATZ
         LR     R10,R1             p
         XDECO  R8,XDEC            n
         MVC    BUF1+10(6),XDEC+6
         XDECO  R10,XDEC           p
         MVC    BUF1+18(5),XDEC+7
         LA     R5,6
         LA     R3,0               i
         LA     R4,BUF1+25
LOOPED   L      R2,TAB(R3)         tab(i)
         XDECO  R2,XDEC
         MVC    0(7,R4),XDEC+5
         LA     R3,4(R3)           i=i+1
         LA     R4,7(R4)
         C      R5,=F'4'
         BNE    BCT
         LA     R4,7(R4)
BCT      BCT    R5,LOOPED
         XPRNT  BUF1,80            print hailstone(n)=p,tab(*)
         MVC    LONGEST,=F'0'      longest=0
         MVI    FTAB,X'00'         ftab=true
         LA     R8,1               i
LOOPI    CR     R8,R11             do i=1 to nmax
         BH     ELOOPI
         LR     R1,R8              n
         BAL    R14,COLLATZ
         LR     R10,R1             p
         L      R4,LONGEST
         CR     R4,R10             if longest<p
         BNL    NOTSUP
         ST     R8,IVAL            ival=i
         ST     R10,LONGEST        longest=p
NOTSUP   LA     R8,1(R8)           i=i+1
         B      LOOPI
ELOOPI   EQU    *                  end i
         XDECO  R11,XDEC           maxn
         MVC    BUF2+9(6),XDEC+6
         L      R1,IVAL            ival
         XDECO  R1,XDEC
         MVC    BUF2+28(6),XDEC+6
         L      R1,LONGEST         longest
         XDECO  R1,XDEC
         MVC    BUF2+36(5),XDEC+7
         XPRNT  BUF2,80            print maxn,hailstone(ival)=longest
         B      RETURN
*        *      *                  r1=collatz(r1)
COLLATZ  LR     R7,R1              m=n  (R7)
         LA     R6,1               p=1  (R6)
LOOPP    C      R7,=F'1'           do p=1 by 1 while(m>1)
         BNH    ELOOPP
         CLI    FTAB,X'01'         if ftab
         BNE    NONOK
         C      R6,=F'1'           if p>=1
         BL     NONOK
         C      R6,=F'3'           & p<=3
         BH     NONOK
         LR     R1,R6              then
         BCTR   R1,0
         SLA    R1,2
         ST     R7,TAB(R1)         tab(p)=m
NONOK    LR     R4,R7              m
         N      R4,=F'1'           m&1
         LTR    R4,R4              if m//2=0  (if not(m&1))
         BNZ    ODD
EVEN     SRA    R7,1               m=m/2
         B      EIFM
ODD      LA     R3,3
         MR     R2,R7              *m
         LA     R7,1(R3)           m=m*3+1
EIFM     CLI    FTAB,X'01'         if ftab
         BNE    NEXTP
         MVC    TAB+12,TAB+16      tab(4)=tab(5)
         MVC    TAB+16,TAB+20      tab(5)=tab(6)
         ST     R7,TAB+20          tab(6)=m
NEXTP    LA     R6,1(R6)           p=p+1
         B      LOOPP
ELOOPP   LR     R1,R6              end p; return(p)
         BR     R14                end collatz
*
RETURN   L      R14,SAVER14        restore caller address
         XR     R15,R15            set return code
         BR     R14                return to caller
SAVER14  DS     F
IVAL     DS     F
LONGEST  DS     F
N        DS     F
TAB      DS     6F
FTAB     DS     X
BUF1     DC     CL80'hailstone(nnnnnn)=nnnnn : nnnnnn nnnnnn nnnnnn ...*
               ... nnnnnn nnnnnn nnnnnn'
BUF2     DC     CL80'longest <nnnnnn : hailstone(nnnnnn)=nnnnn'
XDEC     DS     CL12
         YREGS
         END    HAILSTON