104 lines
3.5 KiB
Plaintext
104 lines
3.5 KiB
Plaintext
* 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
|