* N-QUEENS PROBLEM 04/09/2015 MACRO &LAB XDECO ®,&TARGET &LAB B I&SYSNDX branch around work area P&SYSNDX DS 0D,PL8 packed W&SYSNDX DS CL13 char I&SYSNDX CVD ®,P&SYSNDX convert to decimal MVC W&SYSNDX,=X'40202020202020202020212060' nice mask EDMK W&SYSNDX,P&SYSNDX+2 edit and mark BCTR R1,0 locate the right place MVC 0(1,R1),W&SYSNDX+12 move the sign MVC &TARGET.(12),W&SYSNDX move to target MEND NQUEENS CSECT SAVE (14,12) save registers on entry BALR R12,0 establish addressability USING *,R12 set base register ST R13,SAVEA+4 link mySA->prevSA LA R11,SAVEA mySA ST R11,8(R13) link prevSA->mySA LR R13,R11 set mySA pointer LA R7,LL l LA R6,1 i=1 LOOPI LR R1,R6 do i=1 to l SLA R1,1 i*2 STH R6,A-2(R1) a(i)=i LA R6,1(R6) i=i+1 BCT R7,LOOPI loop do i OPENEM OPEN (OUTDCB,OUTPUT) open the printer file LA R9,1 n=1 start of loop LOOPN CH R9,L do n=1 to l BH ELOOPN if n>l then exit loop SR R8,R8 m=0 LA R10,1 i=1 LR R5,R9 n SLA R5,1 n*2 BCTR R5,0 r=2*n-1 E40 CR R10,R9 if i>n BH E80 then goto e80 LR R11,R10 j=i E50 LR R1,R10 i SLA R1,1 i*2 LA R6,A-2(R1) r6=@a(i) LR R1,R11 j SLA R1,1 j*2 LA R7,A-2(R1) r7=@a(j) MVC Z,0(R6) z=a(i) MVC Y,0(R7) y=a(j) LR R3,R10 i SH R3,Y -y AR R3,R9 p=i-y+n LR R4,R10 i AH R4,Y +y BCTR R4,0 q=i+y-1 MVC 0(2,R6),Y a(i)=y MVC 0(2,R7),Z a(j)=z LR R1,R3 p SLA R1,1 p*2 LH R2,U-2(R1) u(p) LTR R2,R2 if u(p)<>0 BNE E60 then goto e60 LR R1,R4 q AR R1,R5 q+r SLA R1,1 (q+r)*2 LH R2,U-2(R1) u(q+r) C R2,=F'0' if u(q+r)<>0 BNE E60 then goto e60 LR R1,R10 i SLA R1,1 i*2 STH R11,S-2(R1) s(i)=j LA R0,1 r0=1 LR R1,R3 p SLA R1,1 p*2 STH R0,U-2(R1) u(p)=1 LR R1,R4 q AR R1,R5 q+r SLA R1,1 (q+r)*2 STH R0,U-2(R1) u(q+r)=1 LA R10,1(R10) i=i+1 B E40 goto e40 E60 LA R11,1(R11) j=j+1 CR R11,R9 if j<=n BNH E50 then goto e50 E70 BCTR R11,0 j=j-1 CR R11,R10 if j=i BE E90 goto e90 LR R1,R10 i SLA R1,1 i*2 LA R6,A-2(R1) r6=@a(i) LR R1,R11 j SLA R1,1 j*2 LA R7,A-2(R1) r7=@a(j) MVC Z,0(R6) z=a(i) MVC 0(2,R6),0(R7) a(i)=a(j) MVC 0(2,R7),Z a(j)=z; B E70 goto e70 E80 LA R8,1(R8) m=m+1 E90 BCTR R10,0 i=i-1 LTR R10,R10 if i=0 BZ ZERO then goto zero LR R1,R10 i SLA R1,1 i*2 LH R2,A-2(R1) r2=a(i) LR R3,R10 i SR R3,R2 -a(i) AR R3,R9 p=i-a(i)+n LR R4,R10 i AR R4,R2 +a(i) BCTR R4,0 q=i+a(i)-1 LR R1,R10 i SLA R1,1 i*2 LH R11,S-2(R1) j=s(i) LA R0,0 r0=0 LR R1,R3 p SLA R1,1 p*2 STH R0,U-2(R1) u(p)=0 LR R1,R4 q AR R1,R5 q+r SLA R1,1 (q+r)*2 STH R0,U-2(R1) u(q+r)=0 B E60 goto e60 ZERO XDECO R9,PG+0 edit N XDECO R8,PG+12 edit M PUT OUTDCB,PG print buffer LA R9,1(R9) n=n+1 B LOOPN loop do n ELOOPN CLOSE (OUTDCB) close output L R13,SAVEA+4 previous save area addrs RETURN (14,12),RC=0 return to caller with rc=0 LTORG SAVEA DS 18F save area for chaining OUTDCB DCB DSORG=PS,MACRF=PM,DDNAME=OUTDD use OUTDD in jcl LL EQU 14 ll<=16 L DC AL2(LL) input value A DS (LL)H S DS (LL)H Z DS H Y DS H PG DS CL24 buffer U DC (4*LL-2)H'0' stack REGS make sure to include copybook jcl END NQUEENS