RosettaCodeData/Task/Josephus-problem/360-Assembly/josephus-problem.360

83 lines
3.8 KiB
Plaintext

* Josephus problem 10/02/2017
JOSEPH CSECT
USING JOSEPH,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) " <-
ST R15,8(R13) " ->
LR R13,R15 " addressability
LA R7,1 m=1
DO WHILE=(C,R7,LE,=A(NPROB)) do m=1 to nprob
LR R1,R7 m
MH R1,=H'6' *6
LH R2,PROB-6(R1)
ST R2,N n=prob(m,1)
LH R2,PROB-4(R1)
ST R2,W w=prob(m,2)
LH R2,PROB-2(R1)
ST R2,S s=prob(m,3)
MVC PG,=CL80'josephus' init buffer
L R1,N n
XDECO R1,DEC edit
MVC PG+8(4),DEC+8 output
L R1,W w
XDECO R1,DEC edit
MVC PG+12(4),DEC+8 output
L R1,S s
XDECO R1,DEC edit
MVC PG+16(4),DEC+8 output
XPRNT PG,L'PG print buffer
MVI DEAD,X'00' dead(1)='0'B;
MVC DEAD+1(255),DEAD dead(*)='0'B;
L R11,N nx=n
L R8,=F'-1' p=-1
DO UNTIL=(C,R11,EQ,S) do until n=s
SR R9,R9 found=0
DO UNTIL=(C,R9,EQ,W) do until found=w
LA R8,1(R8) p=p+1
IF C,R8,EQ,N THEN if p=nn then
SR R8,R8 p=0
ENDIF , end if
LA R2,DEAD(R8) @dead(p+1)
IF CLI,0(R2),EQ,X'00' THEN if not dead(p+1) then
LA R9,1(R9) found=found+1
ENDIF , end if
ENDDO , end do
LA R2,DEAD(R8) @dead(p+1)
MVI 0(R2),X'01' dead(p+1)='1'B
BCTR R11,0 nx=nx-1
ENDDO , end do
MVC PG,=CL80' ' clear buffer
LA R10,PG ipg=0
L R9,N nn
BCTR R9,0 nn-1
SR R6,R6 i=0
DO WHILE=(CR,R6,LE,R9) do i=0 to nn-1
LA R2,DEAD(R6) @dead(i+1)
IF CLI,0(R2),EQ,X'00' THEN if not dead(i+1) then
XDECO R6,DEC edit i
MVC 0(4,R10),DEC+8 output
LA R10,4(R10) ipg=ipg+4
ENDIF , end if
LA R6,1(R6) i=i+1
ENDDO , end do
XPRNT PG,L'PG print buffer
LA R7,1(R7) m=m+1
ENDDO , end do
L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
PROB DC H'41',H'3',H'1' round 1
DC H'41',H'3',H'3' round 2
NPROB EQU (*-PROB)/6 number of rounds
N DS F n number of prisoners
W DS F w killing count
S DS F s number of prisoners to survive
PG DS CL80 buffer
DEC DS CL12 temp for xdeco
DEAD DS 256X n max
YREGS
END JOSEPH