* Knuth shuffle 02/11/2015 KNUTHSH CSECT USING KNUTHSH,R15 LA R6,1 i=1 LOOPI1 C R6,=A(CARDS) do i=1 to cards BH ELOOPI1 STC R6,PACK(R6) pack(i)=i LA R6,1(R6) i=i+1 B LOOPI1 ELOOPI1 LA R7,CARDS n=cards LOOPN C R7,=F'2' do n=cards to 2 by -1 BL ELOOPN L R5,RANDSEED r5=seed M R4,=F'397204094' r4r5=seed*const D R4,=X'7FFFFFFF' r5=r5 div (2^31-1) ST R4,RANDSEED r4=r5 mod (2^31-1); seed=r4 LR R5,R4 r5=seed LA R4,0 r4=0 DR R4,R7 r5=seed div n; r4=seed mod n LA R9,1(R4) r2=randint(n)+1 [1:n] LA R4,PACK(R7) @pack(n) LA R5,PACK(R9) @pack(nw) MVC TMP,0(R4) tmp=pack(n) MVC 0(1,R4),0(R5) pack(n)=pack(nw) MVC 0(1,R5),TMP pack(nw)=tmp BCTR R7,0 n=n-1 B LOOPN ELOOPN LA R6,1 i=1 LA R8,PG pgi=@pg LOOPI2 C R6,=A(CARDS) do i=1 to cards BH ELOOPI2 XR R2,R2 r2=0 IC R2,PACK(R6) pack(i) XDECO R2,XD edit pack(i) MVC 0(3,R8),XD+9 output pack(i) LA R8,3(R8) pgi=pgi+3 LA R6,1(R6) i=i+1 B LOOPI2 ELOOPI2 XPRNT PG,80 print buffer XR R15,R15 set return code BR R14 return to caller CARDS EQU 20 number of cards PACK DS (CARDS+1)C pack of cards TMP DS C temp for swap PG DC CL80' ' buffer XD DS CL12 to decimal RANDSEED DC F'16807' running seed YREGS END KNUTHSH