Puzzle1
This is the ORIGINAL version of the pentomino puzzle solution program.
I believe it works. You'll have to fix the JCL, but other than that, it should be good.
//SRE87Q JOB ,SD05A1,CLASS=W,MSGCLASS=T,NOTIFY=SRE87,COND=(0,LT)
//* RESTART=T
//*MAIN LINES=10
//ASM EXEC PGM=ASMA90,REGION=240K,PARM='XREF(SHORT)' ,TEST'
//SYSPRINT DD SYSOUT=*
//*YSPRINT DD DSN=DTS.L.LISTING,DISP=SHR
//SYSLIN DD DSN=&&PUNCH,UNIT=TEMP1,SPACE=(TRK,(40,40)),
// DCB=BLKSIZE=1680,DISP=(,PASS)
//SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR,DCB=BLKSIZE=9040 /SPS.MACLIB
// DD DSN=SPS.MACLIB,DISP=SHR
// DD DSN=SRE87.L.MACLIB,DISP=SHR
// DD DSN=DTS.L.MACLIB,DISP=SHR
//SYSUT1 DD UNIT=TEMP1,SPACE=(4000,(200,900),,,ROUND)
//SYSIN DD *
PUZ TITLE 'INITIALIZATION'
MACRO
&LABEL TIMEDATE
&LABEL TIME DEC
CNOP 0,4
STM 0,1,*+40 TIME/DATE HHMMSSTH 00YYDDDF
BAL 1,*+44 BRANCH AROUND DATA AREAS
DC 2X'4021204B20204B20204020204B202020'
DC 2F'0' TIME AND DATE GO HERE
MVC 0(16,1),16(1) REFRESH THE EDIT PATTERN
MVC 35(3,1),37(1) ERASE 00 IN DATE AND TH IN TIME
ED 0(16,1),32(1) AND FORMAT TIME AND DATE
MEND
TITLE 'DSECTS'
T DSECT
THIS DS F POINTER OF PIECE USED FOR THIS ENTRY
TCUR DS F POINTER TO PIECE BEING EXCHANGED
* FOR THIS / CURRENTLY.
TROT DS F OFFSET INTO THE PIECE TABLE TO THE
* ROTATION CURRENTLY BEING TESTED
TPCE DS F SAVE ADDR OF PIECE FOR PRINT RTN
TLOC DS 0F SAME AS TSQUARE
TSQUARE DS F INDEX SQUARE USED TO SAVE BASE ADDR
* OF A PIECE THAT FITS THE PUZZLE,
* USED TO BACK OUT THE PIECE
TPUZZLE DS CL8 PICTURE OF PUZZLE W/O THIS PIECE IN
TPIECE DS CL8 BIT PATTERN FOR THIS PIECE IN ITS
DS CL4 CURRENT LOCATION IN THE PUZZLE
TVARBEG EQU *
TFIRSTPC EQU *-T
TPCS DS 12F POINTERS TO THE 12 PIECE TBL ENTRIES
TEND EQU *
TL EQU *-T
TVL EQU *-TVARBEG
*
*
P DSECT
PCE DS 2F BIT PATTERN FOR THIS ROTATION
PCEFLAG DS 0X
PCEFLG DS X FLAGS FOR THIS PIECE / ROTATION
PF$UA EQU X'01' PIECE= U, AND PUZZLE LOC IS RESTRICT
PF$UB EQU X'02' -ED, TO AVOID DUPLICATE SOLUTIONS
PCECHAR DS C CHARACTER USED IN PRINTED SOLUTIONS
PCEHI DS H HIGHEST BASE ADDR A PIECE CAN BE USE
* AND STILL BE WITHIN THE BOARD
DS 0F
LPCEROT EQU *-P
LPCE EQU 108 LENGTH OF 9 ROTATIONS 4*(3*9)
*
*
PAG DSECT
PGPLACE DS F CURRENT LOC IN THE PAGE
PGLENT DS F LENGTH OF AN ENTRY
PGPNLINE DS F NUMBER OF LINES IN THIS ENTRY
PGABOARD DS F ADDR OF THE BOARD USED
*
PGENTADD DS F ADD THIS TO PGPLAC FOR ADDR OF NEXT
PGLINADD DS F ADD THIS TO PGLINE FOR ADDR OF NEXT
*
PGLENLIN DS F LENGTH OF A LINE
PGLENPAG DS F LENGTH OF A PAGE
PGLINE DS F ADDR OF BEG OF CURRENT LINE
PGAPAGE DS F ADDR OF PAGE
*
PGENDLIN DS F ADDR OF END OF CURRENT LINE
PGENDPAG DS F ADDR OF END OF PAGE
*
PGPRTRGS DS 0F FOLLOWING REGS USED DURING PRT TTN
PGDCB DS F ADDR OF DCB ASSOCIATED WITH THIS PAG
PGFORMAT DS A ADDR OF RTN TO INIT THE BOARD USED
PGPAGCNT DS PL2 PAGE COUNT FOR THIS LIST
PGTITL DS H LENGTH USED FOR EX OF MVC TITLE
PGPRTBEG DS F WRITE RTN ADDR TO BEGIN PRINTING
PGPRTNUM DS F WRITE RTN - NUMBER OF LINES / PAGE
*
PGL1 DS CL60
PGINIT DS 4F REGS TO INIT THE PAGE
LPAG EQU *-PAG
TITLE 'PUZ INITIALIZATION ETC.'
PUZ START 0
REGS RPG,11,BR,10,RX,9,WR,8,RC,7,WR2,6,RPIECE,5,RLOC,4, X
RCNTFIT,3,RCNTLOC,3,RP,2
USING *,12
SAVE (14,12),,*
LA 12,0(15) FOR BASE
LA 2,SAVEAREA
ST 2,8(13)
ST 13,4(2)
LR 13,2
*
L 2,0(1)
LH 3,0(2)
SH 3,=H'1'
BM NOPARM
EX 3,MVCPARM
LA R4,PARM
B PARMTEST
PARMLOOP LA R4,1(R4)
CLI 0(R4),C' '
BE NOPARM
CLI 0(R4),C','
BNE PARMLOOP
LA R4,1(R4)
PARMTEST CLC =C'NODOC',0(R4)
BNE NNODOC
MVI FLAGDOC,C'N'
B PARMLOOP
NNODOC CLC =C'MAX',0(R4)
BNE NMAXSOL
SR R1,R1
BAL BR,PARMCONV
ZAP MAXSOL,DW
B PARMLOOP
NMAXSOL MVC PARMWTO+8(7),=C'UNKNOWN'
PARMBAD MVC PARMWTO+21(12),0(R4)
PARMWTO WTO 'INVALID PARM= '
ABEND 1
*
PARMCONV LR R14,R4 POINT TO PARM
LA R14,1(R14) BUMP TO NEXT BYTE
CLI 0(R14),C'=' LOOK FOR = SIGN, START OF NUMBER.
BNE *-8 Q. FOUND '=', NO, LOOK MORE.
LR R15,R14 YES, START OF NUMBER, DUP ADDR
LA R15,1(R15) SCAN FOR END OF NUMBER.
CLI 0(R15),C'0'
BNL *-8 Q. NUMERIC, YES, LOOP MORE.
CLI 0(R15),C',' Q. NUMBER END WITH SPACE,
BE PARMCONS COMMA,
CLI 0(R15),C' ' OR PARENTHESIS,
BE PARMCONS NO, ERROR.
CLI 0(R15),C')'
BNE PARMBAD
PARMCONS LR R0,R15 CALC LENGTH OF FIELD
SR R15,R14 CALC LENGTH OF FIELD
SH R15,=H'2' SUBT 2 FOR EXECUTE INST
BM PARMBAD Q. LENGTH=0, YES, ERROR.
EX R15,PARMCONP PACK THE NUMBER,
LR R15,R0 SAVE NEXT LOCATION
CVB R0,DW MAKE IT BINARY.
LTR R1,R1 Q. ADDRESS PASSED,
BZR BR NO, RETURN
BM PARMCONH MINUS, ASSUME HALFWORD
ST R0,0(R1) NORMAL ADDR, STORE.
BR BR
PARMCONH STH R0,0(R1) STORE HALFWORD IF HI BIT ON.
BR BR
PARMCONP PACK DW,1(0,R14)
*
MAXSOL DC F'999999'
FLAGDOC DC C' '
PARM DC CL40' '
*
*RP EQU 2
*RCNTFIT EQU 3
*RCNTLOC EQU RCNTFIT 2 PARTS CODED WITH DIFFERENT NAMES
*RLOC EQU 4
*RPIECE EQU 5
*WR2 EQU 6
*RC EQU 7
*WR EQU 8
*RX EQU 9
*BR EQU 10
*RPG EQU 11
*
USING T,RX
USING P,RP
USING PAG,RPG ADDRESSABILITY OF PAGE TABLES
MVCPARM MVC PARM(0),2(2) SAVE THE PARM FIELD
NOPARM DS 0H
OPEN (SYSIN,INPUT,SYSUT1,OUTPUT)
L R2,=A(SYSUT1)
TM DCBOFLGS-IHADCB(R2),DCBOFOPN IS IT OPEN
BNO NODOC NO, SKIP THE DOCUMENTATION
L 6,=A(DOCUMENT-133) LOOP THRU ALL THAT TRASH
DOCLOOP LA 6,133(6) NEXT LINE ADDRESS
PUT (2),(6)
MVC 1(132,6),0(6) SPACE OUT THE STUFF, IT'S A PAGE
CLI 133(6),X'00' WAS THAT THE LAST LINE
BNE DOCLOOP NO, GO DO MORE
NODOC DS 0H
LA RPG,PAGETBL-LPAG LOAD ADDR OF PAGE TABLES TO INIT COR
*
B INITLOOP+4 DON'T DO TITLE INIT FOR PCE TBL
INITLOOP DS 0H
BAL BR,WRITINIT GO DO PAGE HEADING INIT
LM 6,9,PGINIT REGS TO INIT A PAGE TABLE
MVCL 6,8 INIT CORE
MVC PGL1,L1 AND SAVE HEADING
LA RPG,LPAG(RPG) ADDR OF NEXT PG TABLE
CLI 0(RPG),255 END OF THE PAGE TABLES
BNE INITLOOP NO, GO INIT NEXT PIECE OF CORE
*
TITLE 'SET UP PIECE TABLE'
L RP,APCETBLM
ST RP,CARDSAVP SAVE ADDR OF BEG OF THIS PIECE
L RX,X
GETAPCE DS 0H
GET SYSIN,CARD GET A ROTATION
L R1,=A(SYSUT1)
TM DCBOFLGS-IHADCB(R1),DCBOFOPN IS IT OPEN
PUTOPEN (1),CARD-1 LIST OF INPUT DATA CARDS
*
CLI CARD,C'M' IS THAT THE END OF A ROTATION
BNE CARDNEP NO, GO DO NEXT
L RP,CARDSAVP LOAD ADDR OF BEG OF THIS PIECE
LA RP,LPCE(RP) NEXT PIECE
ST RP,CARDSAVP SAVE ADDR OF BEG OF THIS PIECE
B GETAPCE AND GO READ AGAIN
*
CARDNEP DS 0H
CLI CARD,C' ' IS THIS A PIECE
BNE GETNOTPC NO, I WONDER WHAT IT CAN BE
*
LA RP,LPCEROT(RP) GET ADDR OF NEXT POSSIBLE ROTATION
SR 14,14
SR 15,15
*
LA RC,5 ALWAYS HAVE 5 BITS TO TEST
LA WR,CARDBITS
SR RX,RX SET UP TO SAVE HIGHEST VALUE
*
CRDBITLP DS 0H
PACK DW,0(2,WR) ISOLATE LOCATION OF THIS BIT
CVB WR2,DW MAKE SHIFT PATTERN BINARY
CR RX,WR2 IS NEW VALUE HIGHER THAN HIGHEST PRV
BH *+6 YES, LEAVE IT ALONE
LR RX,WR2 NO, SAVE NEW HIGH VALUE
SR 0,0
LA 1,1
SLDL 0,0(WR2) SHIFT THE PIECE/BIT UP TO ITS LOCATN
OR 14,0 ADD BIT TO MASK FOR THIS PIECE
OR 15,1 ADD BIT TO MASK FOR THIS PIECE
LA WR,2(WR) SHIFT TO NEXT BIT OFFSET
BCT RC,CRDBITLP GO DO NEXT 4 BIT LOCATIONS
*
STM 14,15,PCE SAVE THE BIT PATTERN FOR THIS PIECE
MVC PCEFLAG,CARD$UAB MOVE FLAG TO PCE TABLE
MVC PCECHAR,CARDCHAR CHARACTER USED IN PRINTED SOLUTIONS
*
LA RC,60 HIGHEST POSSIBLE SQUARE ON BOARD
SR RC,RX CALC MAX VALUE
LR WR,RP SAVE ADDR OF THIS PIECE
STH RC,PCEHI SAVE HI VALUE WE CALCULATED, THEN
* SEE IF IT FITS. IF NOT, DECREASE.
*
LASTLOP DS 0H
LR RLOC,RC DUPLICATE COUNT
LM 14,15,PCE LOAD PIECE BIT MASK
SLDL 14,4(RLOC) SHIFT UP ENOUGH TO LOP OFF A BIT
SRDL 14,4(RLOC) AND SHIFT BACK DOWN AGAIN
C 14,PCE IF NOT EQUAL, WE LOST SOME BITS
BNE CARDLST1 SO SUBTRACT 1 AND TRY AGAIN
C 15,PCE+4 (HAVE TO DO BOTH HALVES OF PUZZL)
BNE CARDLST1 IF NOT =, TRY 1 LESS
*
SLDL 14,0(RLOC) SHIFT PIECE UP TO TOP OF BOARD.
BAL BR,FIT GO SEE IF IT FITS THE BOARD
LM 6,7,FITSAV RELOAD REGS FIT DESTROYED
LTR RP,RP IS IT STILL GOOD
BNZ LASTGOOD
*
CARDLST1 DS 0H
LR RP,WR RELOAD ADDR OF THIS PIECE
BCT RC,LASTLOP GO TRY NEXT LAST
*
LASTGOOD DS 0H
STH RLOC,PCEHI SAVE LAST POSSIBLE LOCATION
B GETAPCE NOW GO READ AGAIN (FINALLY
*
*
DC C' '
CARD DC CL132' '
ORG CARD+1
CARDCHAR DS C
CARDBITS DS 5CL2 3
CARD$UAB DS C SPECIFY MASK A OR B
ORG
*
*
HINIT DC 2F'0',4C'H' PLACE TO PRINT PIECES FROM
CARDSAVP DC F'0' PLACE TO SAVE ADDR OF FIRST ROT OF P
*
*
GETNOTPC DC H'1'
TITLE 'PRINT FORMATTED PIECES'
EODAD DS 0H --COME HERE ON OEF ON SYSIN.
CLI FLAGDOC,C' ' IF NOT BLANK, DOCUMENTATION ONLY
BE NDOCONLY IF BLANK, GO DO THE PUZZLE
CLOSE (SYSIN,,SYSUT1) IF NOT BLANK, CLOSE FILES
B BACK2MVS AND GO BACK TO MVS
NDOCONLY DS 0H SET UP TITLES, TABLES NEXT
LA RPG,QBOARD1 LOAD ADDR OF CONTROL TBL FOR PAGE
BAL BR,WRITINIT GO INITIALIZE PAGE HEADING
PRTPCS DS 0H
L RP,=A(PCETBL-LPCEROT) ADDR OF FITST PIECE
PRTPCSLP DS 0H
MVC BOARD,BOARD-1 INIT BOARD TO PERIODS
LA RP,LPCEROT(RP) ADDR OF NEXT ROTATION
TM PCEFLAG,X'FF' FLAG
BZ PRTPCSX END OF TABLE
BO PRTPCSLP NULL ENTRY
BAL BR,SETPIECE GO PUT PCE IN A TBL
*
ST RP,CARDSAVP SAVE ADDR OF CURRENT PIECE
LM 14,15,PCE LOAD THE PIECE
LH WR,PCEHI LOAD HIGHEST POSSIBLE LOC
SLDL 14,0(WR) SHIFT PIECE UP TO HI LOC
STM 14,15,HINIT STORE THE PIECE IN DUMMY PCE TBL
LA RP,HINIT LOAD POINTER TO DUMMY TBL
BAL BR,SETPIECE FORMAT THE PIECE IN A BOARD
LA RPG,QBOARD1 LOAD ADDR OF CONTROL TBL FOR PAGE
BAL BR,SETBOARD THEN FORMAT THE BOARD
L RP,CARDSAVP AND THEN LOAD THE READ PIECE ADDR
*
B PRTPCSLP GO TRY NEXT PIECE
*
PRTPCSX DS 0H ALL PIECES DONE
LA RP,MASKS LOAD ADDR OF 4 MASKS TO CHECK
LA RC,5 5 MASKS TO 3HECK
L WR,=CL4'OOOO' USE THIS CHAR TO PUT ON PAPER
PRBOARDS DS 0H
L WR2,8(RP) SAVE WHATEVER IS NEXT IN MEMORY
ST WR,4(RP) PUT THE CHECKING CHAR IN PLACE
BAL BR,SETPIECE GO PUT PIECE ON BOARD
ST WR2,8(RP) RESTORE WHATEVER IS NEXT IN MEMORY
LA RPG,QBOARD1 LOAD ADDR OF CONTROL TBL FOR PAGE
BAL BR,SETBOARD THEN FORMAT A BOARD
LA RP,8(RP) ADDR OF NEXT MASK TO CHECK
MVC BOARD,BOARD-1 INIT BOARD TO PERIODS
BCT WR2,PRBOARDS GO BACK AND PRT ALL WORK/BOARDS
BAL BR,FORCEPAG FORCE WRITING THIS PAGE
*
ZAP CNTPUZ,=P'0'
LA RPG,QBOARD1 LOAD ADDR OF CONTROL TBL FOR PAGE
BAL BR,WRITINIT INIT HEADING AGAIN FOR COUNT
*
B MAIN GO DO MAIN SECTION
TITLE 'SUBR - SAVE, LOSE, COPY/COPY2, SWAP'
CALCLOC DS 0H
SR RLOC,RLOC
LM 14,15,PUZZLE LOAD THE PUZZLE
LA 0,255 LOAD 1 BITS IN LOW BYTE
LA 1,7 MAX 7 TIMES THRU
*
CALCLOC1 DS 0H
LR WR,15 SAVE LOW BYTE
OR 15,0 TRY TO TURN LOW BITS ON
CR WR,15 WERE ALL THE BITS ALREADY ON
BNE DOBITS
*
LA RLOC,8(RLOC) ADD 8 TO CURRENT OFFSET
SRDL 14,8
BCT 1,CALCLOC1 AND LOOP
*
DOBITS DS 0H
LR 14,WR LOAD LOW BYTE INTO R-14
*
CALCLOC2 DS 0H
SR 15,15
SRDL 14,1 SHIFT BITS DOWN UNTIL WE GET A ZERO
LTR 15,15 WAS IT A ZERO
BZ CALCLOC3 YES, SAVE
LA RLOC,1(RLOC)
B CALCLOC2 TRY NEXT BIT
*
CALCLOC3 DS 0H
BR BR RETURN TO MAIN
*
SAVE DS 0H
STM 6,7,TPUZZLE SAVE PUZZLE W/O PIECE
STM 14,0,TPIECE AND SAVE THIS PIECE
SR RP,RPIECE CALC OFFSET TO THIS ROTATION
ST RP,TROT SAVE OFFSET TO THIS ROTATION
OC PUZZLE,DW SET PUZZLE FOR NEXT LEVEL
LA RX,TL(RX) SET INDEX TO NEXT SLOT
BAL WR,COPY NOW COPY INDEX TO NEXT LEVEL
AP CNTSAVE,=P'1' ADD 1 TO COUNT OF NO. OF PCS SAVED
BR BR RETURN TO CALLER (PROBABLY --SAVE--
*
LOSE DS 0H
S RX,=A(TL) BACKUP ONE INDEX TABLE ENTRY
MVC PUZZLE,TPUZZLE RESTORE PREV COPY OF PUZZLE
C RX,=A(TBL) DID WE TRY TO BACKUP TO FAR
BL FINI YES, BETTER QUIT
L RPIECE,TPCE LOAD BASE ADDR OF THIS PIECE
BR BR NO, THEN TRY A NEW PIECE
*
COPY DS 0H
LA 1,TEND DUMMY LAST ENTRY
ST 1,TCUR INIT NEW CURRENT PIECE
*
COPY2 DS 0H
LR 1,RX LOAD THE INDEX VALUE
S 1,=A(TL) BACKUP 1 TABLE ENTRY
MVC TVARBEG(TVL),TVARBEG-T(1) COPY VARIABLE PART FROM PREV
SR 1,1
ST 1,TSQUARE
ST 1,TROT
BR WR RETURN TO CALLER
*
SWAP DS 0H
BAL WR,COPY2 REFREST VARIABLE PORTION
LM 14,15,THIS
S 15,=F'4' ADDR OF NEXT ENTRY TO SWAP
CR 15,14 COMPARE IT TO CURRENT
BL SWAPBAD IF ALL HAVE BEEN DONE, ERROR
BE SWAPSAVE IF SAME, LEAVE ADDRESSES ALONE
*
L 0,0(14) IF NOT, LOAD THE 2 ADDRESSES,
L 1,0(15) AND SWITCH 'EM
ST 0,0(15)
ST 1,0(14)
*
SWAPSAVE DS 0H
ST 15,TCUR SAVE NEW CUR POINTER
SR 1,1 START WITH FIRST ROTATION AFTER SWAP
ST 1,TROT BY ZEROING CUTTENT ROTATION OFFSET
L RP,THIS LOAD NEW PIECE POINTER
L RP,0(RP) AND LOAD ADDR OF NEW PIECE
LR RPIECE,RP LOAD BASE ADDR OF THIS PIECE
ST RPIECE,TPCE USED TO CALC OFFSET TO CURNT ROTATN
BR BR AND RETURN
*
SWAPBAD DS 0H
SR RP,RP BAD INDICATION
BR BR AND RETURN
TITLE 'MAIN LOGIC AND NEXT ROTATN'
MAIN DS 0H
CLOSE (SYSIN)
OPEN (SYSUT2,OUTPUT,SYSUT3,OUTPUT,SYSUT4,OUTPUT)
*
SR RCNTFIT,RCNTFIT DON'T COUNT TIMES THRU FIT IN INITAL
L RX,X LOAD PRIMARY INDEX
LR 1,RX DUPLICATE ADDRESS
S 1,=A(TL) SUBT 1 ENTRY LENGTH
MVC 0(TL,1),0(RX) SET UP PRIMARY BACKUP
BAL BR,SWAP INITIAL SWAP
B MAINLOC AND FOR KICKS, LOC FIRST SQUARE
*
MAINLOSE DS 0H
BAL BR,LOSE GO ERASE THIS LAST PIECE
L RLOC,TLOC LOAD NEW (PREV) LOCATION
B MAINNEXT GO TRY NEXT ROTATION OF NEXT 2 LAST
*
MAINLOC DS 0H
BAL BR,CALCLOC GO CALC NEW LOCATION
*
MAINNEXT DS 0H
BAL BR,NEXT GO TRY THE NEXT PIECE
LTR RP,RP
BNZ MAINFIT OK, SEE IT IT FITS
MAINSWAP DS 0H
BAL BR,SWAP TRY NEXT PIECE
LTR RP,RP IS THERE ANOTHER PIECE
BZ MAINLOSE NO, GO REMOVE THE LAST PIECE
B MAINNEXT YES, GO TRY TO FIT IT IN
*
MAINFIT DS 0H
BAL BR,FIT GO SEE IF PIECE FITS
LTR RP,RP DID IT FIT
BZ MAINSWAP NO ROTATION FITS, GO GET ANOTHER PCE
BAL BR,SAVE NOW SAVE THIS PIECE
CLC DONE,PUZZLE IS THE PUZZLE ALL DONE
BE MAINDONE YES, GO SAVE THE SOLUTION
BAL BR,SWAP AFTER SAVE, DO INITIAL SWAP AGAIN
B MAINLOC AND GO CALC NEW LOCATION
*
MAINDONE DS 0H
BAL BR,SOLUTION GO RECORD THIS SOLUTION
BAL BR,LOSE GO TAKE LAST PIECE OFF THE BOARD
CP CNTPUZ,MAXSOL
BL MAINLOSE GO TAKE NEXT TO LAST PIECE OFF ALSO
B QUIT
* NEED TO REMOVE ATLEAST 2 PIECES FOR
* A NEW SOLUTION
*
NEXT DS 0H
L RP,THIS LOC OF CURRENT PIECE SWAPED UP
* FROM THE BOTTOM.
L RP,0(RP) LOC OF FIRST AVAIL PIECE
L 1,TROT
AR RP,1 ADD IN THIS ROTATION
LA 1,LPCEROT(1) SET UP NEXT ROTATION
ST 1,TROT
CLI PCEFLAG,255 IS THIS A VALID ENTRY
BCR 7,BR RETURN IF GOOG ENTRY
SR RP,RP IF NOT, INDICATE BAD
BR BR RETURN WITH THIS PCE ADDR
*
*
FIT DS 0H SEE IF THIS PIECE FITS
STM 6,11,FITSAV SAVE REGS WE WIPE OUT
LM 6,11,PUZZLE LOAD PUZZLE AND SIDES
FITLOOP DS 0H LOOP THRU ROTATIONS HERE
LA RCNTFIT,1(RCNTFIT) COUNT THIS TEST
CH RLOC,PCEHI IS THIS PIECE TO BIG TO FIT
BH FITBAD YES, GO TURN IT AND TRY AGAIN
LM 14,0,PCE NO, LOAD BITS AND FLAG
SLDL 14,0(RLOC) SHIFT BITS UP TO WHERE THEY WILL GO
LR 1,6 TRY HALF OF PUZZLE
NR 1,14 DOES PIECE OVERLAP WITH SOMETHING
BNZ FITBAD ALREADY THERE. IF SO, REJECT
LR 1,7 TRY OTHER HALF
NR 1,15 DOES IT OVERLAP
BNZ FITBAD YES, TRY ANOTHER ROTATION OF THIS PC
*
LR 1,15 LOAD HI HALF OF PUZZLE
NR 1,11 DOES PIECE TOUCH RITE SIDE
BNZ FITLEFT YES, SEE IF IT TOUCHES LEFT SIDE TOO
LR 1,14 LOAD OTHER HALF OF LEFT
NR 1,10 DOES OTHER HALF TOUCH BOARDER
BZ FITTRYAB NO, GO TRY SPECIAL STUFF
*
FITLEFT DS 0H
LR 1,9 LOAD HALF OF SIDEMASK
NR 1,15 DOES PIECE TOUCH THIS SIDE TOO
BNZ FITBAD YES, ERROR
LR 1,14 LOAD PIECE MASK
NR 1,8 DOES IT TOUCH THE SIDE
BNZ FITBAD YES, GO TURN THE PIECE AROUND
*
FITTRYAB DS 0H
LTR 0,0 IS THIS THE U SHAPED PIECE
BP FITGOOD NO (HI BIT OFF) PIECE IS GOOD
TM PCEFLAG,PF$UA SEE WHICH MASK TO TEST
BNO FITNOTUA NOT THIS, DO THE OTHER
LR 1,14 FITST HALF OF BOARD
N 1,MASKA IS THERE A CONFLICT
BNZ FITBAD YES, REJECT
B FITGOOD NO, OK
*
FITNOTUA DS 0H
LR 1,14 PIECE
N 1,MASKB PLUS MASK. Q. CONFLICT
BNZ FITBAD BIT ON = CONFLICT, REJECT PIECE
LR 1,15 OTHER HALF OF PIECE
N 1,MASKB+4 Q. CONFLICT
BZ FITGOOD A. NO, OK, KEEP PIECE
*
FITBAD DS 0H
CLI PCEFLAG+LPCEROT,255 IS THERE ANOTHER ROTATION 4 THISPC
BE *+12 NO, BRANCH AROUND THE STUFF TODO NXT
LA RP,LPCEROT(RP)
B FITLOOP GO TRY NEXT POSITION OF THIS PIECE
*
SR RP,RP
LM 6,11,FITSAV LOAD REGS WE WIPE OUT
BR BR RTN TO MAIN LINE
FITGOOD DS 0H
LM 8,11,FITSAV+8 RELOAD REGS
BR BR
*
TITLE 'END OF THE WHOLE THING'
QUIT DS 0H DIE HERE
*
*
FINI DS 0H
BAL BR,FORCEPAG FORCE WRITING THIS PAGE
CLOSE (SYSUT1,,SYSUT2,,SYSUT3,,SYSUT4)
BACK2MVS DS 0H
GOBACK RC=0
*
*
FORCEPAG DS 0H
STM 3,11,SOLSAV SAVE REGS AS OF ENTRY
LA RPG,PAGETBL LOAD ADDR OF A PAGE CONTROL TBL
FORCLOOP DS 0H
L 1,PGDCB LOAD DCB ADDR
TM 48(1),X'10' IS THIS DCB OPEN
BNO FORCNEXT NO, GO TRY NEXT PAGE/DCB
LA BR,FORCNEXT LOAD RETURN ADDR
L 1,PGAPAGE LOAD ADDR OF BEG OF PAGE
STM 2,11,PAGESAVE SAVE REGS O IN PAGE SAVE AREA
BAL BR,SETFORCE GO FORCE END OF PAGE
FORCNEXT DS 0H
LA RPG,LPAG(RPG) ADDR OF NEXT PAGE CONTROL TBL
CLI 0(RPG),255 ARE ALL TABLES DONE
BNE FORCLOOP NO, GO DO NEXT ONE
LM 3,11,SOLSAV LOAD REGS AS OF ENTRY
BR BR RETURN
TITLE 'SOLUTION DRIVER SET UP PRT'
*
SOLUTION DS 0H
STM 3,11,SOLSAV SAV OTHER REGS TOO
L RX,=A(TBL) LOAD ADDR OF INDEX TABLE
*
SOLPCE DS 0H
L RP,TPCE LOAD ADDR OF A PCE
BAL BR,SETPIECE PUT PIECE INTO THE BOARD
LA RX,TL(RX) POINT TO NEXT PIECE
CLI 0(RX),255 END OF INDEX TBL
BNE SOLPCE NO, GO DO NEXT PCE
*
*
AP CNTPUZ,=P'1' COUNT THE SOLUTION
MVC BOARD2,TRANSLAT SETUP TO MOVE SOLUTION TO HORIZONTAL
TR BOARD2,BOARD BOARD, AND MOVE IT.
LA RPG,PAGETBL LOAD ADDR OF A PAGE CONTROL TBL
*
PAGELOOP DS 0H
BAL BR,SETBOARD GO PUT BOARD ONTO THE CURRENT PAGE
LA RPG,LPAG(RPG) ADDR OF NEXT PAGE CONTROL TBL
CLI 0(RPG),255 ARE ALL TABLES DONE
BNE PAGELOOP NO, GO TRY NEXT
MVC BOARD(60),BOARD-1 PUT PERIODS AROUND THE BOARD
*
*
NOP100 NOP SOL100 BRANCH TO ONLY WTO EACH 100 SOLUTION
NOP10 NOP SOL10 SAME / EVERY 10 SOLUTIONS
TM CNTPUZ+2,X'30' WTO 1, 2, AND 3 SOLUTIONS
BNZ DOWTOCNT GO DO THE WTO
OI NOP10+1,X'F0' TURN NOP INTO BR, ONLY DO EVERY 10
*
SOL10 DS 0H
TM CNTPUZ+2,X'F0' IS THIS A MULTIPLE OF 10
BNZ NOWTOCNT NO, BYPASS THE WTO
TM CNTPUZ+1,X'0F' IS IT A MULTIPLE OF 100
BNZ DOWTOCNT NO, GO DO WTO
OI NOP100+1,X'F0' SET 100 NOP TO ONLY WTO EVERY 100
*
SOL100 DS 0H
TM CNTPUZ+1,X'0F' IS THIS 100-109, 200-209, 300-309...
BNZ NOWTOCNT NO, BYPASS THE WTO
TM CNTPUZ+2,X'F0' IS THIS 100, 100, 300, ..
BNZ NOWTOCNT NO, BYPASS THE WTO
*
DOWTOCNT DS 0H
OI CNTPUZ+2,X'0F' FIX SIGN
UNPK WTOCNT+8(5),CNTPUZ PUT COUNT INTO WTO
WTOCNT WTO '00000'
*
NOWTOCNT DS 0H
*
*
LM 3,11,SOLSAV RELOAD REGS
BR BR
*
*
SETPIECE DS 0H
LM 14,15,PCE LOAD A PIECE
IC WR,PCECHAR AND LOAD THE CHAR TO BE USED
LA RC,60 SIXTY POSSIBLE PLACES
LA 1,BOARD-1 AND LOOK AT THE BOARD
SLDL 14,4 LOSE EXTRANEOUS BITS
*
SETPLOOP DS 0H
LTR 14,14 IS THERE A BIT HERE
BNM *+8 NO, DON'T STORE CHAR
STC WR,0(1,RC) YES, INDICATE THE CHAR
SLDL 14,1 SHIFT NEXT BIT INTO PLACE
BCT RC,SETPLOOP AND GODO NEXT BIT
*
BR BR RETURN
TITLE 'THIS IS THE --PAGE -- STUFF'
MVCLINE MVC 0(0,3),0(6) MVC LINE OF PUZZLE TO THE PAGE
*
PRTPAGX DS 0H
LM 2,11,PAGESAVE RELOAD ALL REGS
BR BR AND RETURN TO CALLER
*
SETBOARD DS 0H
STM 2,11,PAGESAVE SAVE ALL REGS
LM 14,15,PGDCB LOAD DCB AND FORMAT RTN ADDR
TM 48(14),X'10' IS THIS DCB OPEN
BNO PRTPAGX NO, JUST EXIT
LTR 15,15 IS THERE A PRINT/FORMAT RTN FOR THIS
BZ *+8 NO, DON'T TRY TO USE IT THEN
BAL BR,0(15) YES, GO DO IT
*
LM 3,6,PGPLACE LOAD PARAMETERS TO FMT AN ENTRY
BCTR 4,0 SUBT 1 FOR LENGTH IN MVC INST
LR 1,3 DUP PLACE IN PAGE
*
PRTMVCPZ DS 0H
EX 4,MVCLINE GO MOVE A LINE OF PUZZLE TO PAGE
LA 6,1(4,6)
LA 3,133(3) NEXT LINE OF THIS ONE
BCT 5,PRTMVCPZ MVC ALL LINES TO PAGE
*
A 1,PGENTADD ADD LENGTH OF AN ENTRY ON THIS LINE
ST 1,PGPLACE AND SAVE IT
C 1,PGENDLIN ARE WE AT THE END OF THE LINE YET
BL PRTPAGX NO, RETURN TO DO PUZZLE AGAIN
*
L 1,PGLINE LOAD CURRENT LINE ADDR
A 1,PGLINADD ADD LENGTH OF A LINE (SEVERAL LINES
*
SETFORCE DS 0H
PRTSAVLN DS 0H
ST 1,PGPLACE SAVE NEW PLACE
ST 1,PGLINE AND NEW LINE ADDR
LR 3,1 CALC NEW END OF LINE ADDR
A 3,PGLENLIN BEG + LENGTH
ST 3,PGENDLIN AND SAVE NEW END OF LINE ADDR
*
C 1,PGAPAGE DID WE DO FIRST ENTRY ON PAGE
BE HAV2WRIT YES, HAVE TO GO PRINT THIS PAGE
*
C 1,PGENDPAG DID WE GET TO THE END OF THE PAGE
BL PRTPAGX NO, GO DO ANOTHER SOLUTION
*
L 1,PGAPAGE LOAD ADDR OF BEG OF PAGE
B PRTSAVLN GO SET THE LINE ADDR
*
*
MOVET1 MVC 0(0,7),L1 MOVE TITLE TO PAGE
*
HAV2WRIT DS 0H
LM 4,8,PGPRTRGS LOAD ADDRESSES USED IN PRT RTN
* 4-DCB 5-PUZZL.FORMAT 6-NULL 7-A(FIRST LINE) 8-NO.OF LINS
LH 1,PGTITL LOAD LENGTH OF THE TITLE LINE
LTR 1,1 IS THERE ONE
BZ NOTITLE NO, PASS THIS PART
MVC L1,PGL1 MOVE TITLE BACK TO STARTING POINT
OI CNTPUZ+2,X'0F' FIX SIGN
UNPK L1TO,CNTPUZ LIST COUNT SO FAR
AP PGPAGCNT,=P'1' COUNT THE PAGE
OI PGPAGCNT+1,X'0F' FIX THE SIGN
UNPK L1PAGE,PGPAGCNT PUT PAGE NUMBER ON HEADING
C 1,=F'120' IS THIS THE LONG TITLE
BL XLONGTIT NO, SKIP THE NEXT PART
AP TOTCNTLO,PAGCNTLO
AP TOTCNTSV,PAGCNTSV KEEP TOTAL COUNT OF LOCATES AND SAVS
LM 14,0,=A(L1+66,EDITCNTS,4) ADDR OF CNT FIELDS AND NO.
EDITLOOP DS 0H
MVC 0(16,14),=X'40202020202020202020202020212020'
ED 0(16,14),0(15)
LA 14,16(14) NEXT EDIT PATTERN
LA 15,8(15) NEXT COUNT FIELD
BCT 0,EDITLOOP GO DO NEXT 3 FILEDS
MVC EDITCNTS(16),EDITCNTS-8 ZERO OUT COUNTS FOR THIS PAGE
*
XLONGTIT DS 0H
EX 1,MOVET1 PUT TITLE ON REPORT
NOTITLE DS 0H
*
PUTALINE DS 0H
PUT (4),(7) WRITE A RECORD
MVC 2(131,7),1(7) BLANK OUT THE LINE
LA 7,133(7) ADDR OF NEXT LINE
BCT 8,PUTALINE LOOP THRU ALL THE LINES
INITHDR DS 0H
AP CNTPUZ,=P'1' THIS WILL BE FIRST ON NEXT PAGE
OI CNTPUZ+2,X'0F' DO THE SIGN
UNPK L1FROM,CNTPUZ HDR FOR NEXT TIME
SP CNTPUZ,=P'1' RESTORE CORRECT COUNT
*
TIMEDATE
MVC DATIME,0(1) PUT DATE AND TIME IN HEADING
MVC PGL1,L1 AND SAVE HEADING
B PRTPAGX AND RETURN, TO COME BACK FOR NEXT RP
*
*
WRITINIT DS 0H INIT PAGE HEADING HERE
STM 2,11,PAGESAVE SAV REGS
B INITHDR AND GO INIT HEADING
*
*
FMTCOUNT DS 0H
CVD RCNTLOC,DW MAKE THE COUNT OF NUMBER OF LOC DECM
AP PAGCNTSV,CNTSAVE SAVE COUNT
AP PAGCNTLO,DW SAVE COUNT OF NUMBER OF LOCARDS
MVC EDCOUNT(20),=2X'40202020202021204040'
ED EDCOUNT+10(8),DW+4
ED EDCOUNT(8),CNTSAVE
MVC CNTSAVE,=PL4'0' INIT CNT OF NUMBER OF SAVES
SR RCNTLOC,RCNTLOC ZERO OUT CNT OF LOCARES FOR PIECE
BR BR RETURN
*
*
FMTBIGBD DS 0H
LM 14,1,=A(BIGBOARD-21,BIGBOARD+21,6,42)
MVC 0(42,15),0(14) INIT A LINE (PARE OF LINES)
AR 14,1 NEXT SLOT
BCT 0,*-8 GO MOVE NEXT BATCH
*
LM 6,9,FMTBIGAD YES, LOAD ADDRESSES TO BE USED
*
FMTBIGLP DS 0H
CLC 0(1,7),1(7) IS THIS SQUARE SAME PIECE AS NEXT
BNE *+8 NO, LEAVE SEPARATER THERE
MVI 21+2(6),C' ' YES, ERASE THE SEPARATER
*
CLC 0(1,7),10(7) IS THIS SQUARE SAME PIECE AS 1 ROW
BNE *+8 DOWN, NO, LEAVE SEPARATER ALONE
MVI 42+1(6),C' ' YES, ERASE THE SEPARATER
*
LA 7,1(7) ADD 1 TO PLACE IN SOURCE PUZZLE
LA 6,2(6) ADD 2 TO LOC IN THE DATA AREA
BCT 8,FMTBIGLP GO DO NEXT 9 POSITIONS
*
LA 6,1(6) SKIP 1 EXTRA BYTE AT END OF LINE
BCT 9,FMTBIGLP GO DO NEXT 5 LINES
BR BR RETURN
FMTBIGAD DC A(BIGBOARD,BOARD2,10,6)
*
LTORG
*
TITLE 'CONSTANTS AND MISSING ROUTINES '
INITPCE DC A(PCETBL,324*4,DW),X'FF',AL3(0)
PAGETBL DS 0F ADDR OF TABLES DEFINING PAGES
QBOARD1 DC A(PAGE,6,10,BOARD)
DC A(8,11*133)
DC A(126,133*54,PAGE,PAGE)
DC A(PAGE+126,PAGE+133*54)
DC A(SYSUT1,0)
DC PL2'0',H'59'
DC A(LINE1,60)
DS CL60
DC A(LINE1,61*133,ZERO),C' ',AL3(0)
*
QBOARD2 DC A(BOARD2,6,10,BOARD2)
DC A(11,8*133)
DC A(126,133*54,PAGE2,PAGE2)
DC A(PAGE2+126,PAGE2+133*54)
DC A(SYSUT2,0)
DC PL2'0',H'59'
DC A(LINE2,60)
DS CL60
DC A(LINE2,61*133,ZERO),C' ',AL3(0)
*
QBOARD3 DC A(BOARD2,8,10,BOARD2)
DC A(11,10*133)
DC A(126,133*54,PAGE3,PAGE3)
DC A(PAGE3+126,PAGE3+133*54)
DC A(SYSUT3,FMTCOUNT)
DC PL2'0',H'130'
DC A(LINE3,60)
DS CL60
DC A(LINE3,61*133,ZERO),C' ',AL3(0)
*
QBOARDA DC A(BIGPAGE,21,11,BIGBOARD)
DC A(26,12*133)
DC A(119,133*54,BIGPAGE,BIGPAGE)
DC A(BIGPAGE+119,BIGPAGE+133*50)
DC A(SYSUT4,FMTBIGBD)
DC PL2'0',H'0'
DC A(LINE4,60)
DS CL60
DC A(LINE4,61*133,ZERO),C' ',AL3(0)
*
DC X'FF' END OF THE TABLES OF PAGE DEFINITION
*
DS 0D
DC CL16'DW PUZ MASKS SA'
*
DW DC D'0'
PUZZLE DC D'0'
*
MASKS DS 0F
LEFTSIDE DC BL4'00001000001000001000001000001000'
DC BL4'00100000100000100000100000100000'
*
RITESIDE DC BL4'00010000010000010000010000010000'
DC BL4'01000001000001000001000001000001'
*
MASKA DC X'FFFFFFF0',F'0' USE ONLY LOW HALF OF BOARD
*
MASKB DC BL4'00001100001100001100001100001100'
DC BL4'00110000110000110000110000110000'
*
DONE DC XL8'0FFFFFFFFFFFFFFF' PUZZLE LOOKS LIKE THIS WHEN DONE
*
APCETBLM DC A(PCETBL-LPCEROT) ADDR OF PCETBL MINUS 1 ROTATION
APCE DC A(PCETBL)
ATBL DC A(TBL) ADDR ON INDEX TBL
*
DC F'-1'
DC 0F'0',C'SAVAREAS'
SAVEAREA DC 18F'0'
DC F'-1'
FITSAV DS 6F
DC F'-1'
SOLSAV DS 9F
DC F'-1'
PAGESAVE DS 10F REG SAVE AREA
DC F'-1'
*
X DC A(TAB) POINTER TO CURRENT ENTRY IN TABLE
* USED TO JUGGLE THE PIECES AROUND
*
*
L1 DC CL60'1 '
ORG L1+3
DC C'SOLUTIONS '
L1FROM DC CL5' '
DC CL3' - '
L1TO DC CL5' ',CL3' '
DATIME DC CL16' '
DC C' PAGE '
L1PAGE DC CL3'0'
ORG
DC CL72' ' COUNT FIELDS WILL GO HERE
*
*
DC 11C' 1'
BIGBOARD DS 11CL21 THIS WILL CONTAIN THE BIG PICTURE
ORG BIGBOARD
DC 11C'+-'
ORG
DC 32X'DD' SPACE AFTER BIGBOARD
*
DC C'.'
BOARD DS CL60
BOARD2 DS CL60 HORIZONTAL BOARD
DC CL10' '
EDCOUNT DC 2CL10' '
DC CL10' '
TRANSLAT DC FL1'0,6,12,18,24,30,36,42,48,54'
DC FL1'1,7,13,19,25,31,37,43,49,55'
DC FL1'2,8,14,20,26,32,38,44,50,56'
DC FL1'3,9,15,21,27,33,39,45,31,57'
DC FL1'4,10,16,22,28,34,40,46,52,58'
DC FL1'5,11,17,23,29,35,41,47,53,59'
CNTSAVE DC PL4'0' COUNT OF N NUMBER OF PIECES
CNTPUZ DC PL3'0' NUMBER OF SOLUTIONS SO FAR
DC PL8'0' TO INIT NEXT 2 FIELDS
EDITCNTS EQU *
PAGCNTLO DC PL8'0' COUNT OF LOCATES
PAGCNTSV DC PL8'0' COUNTS OF NUMBER OF SAVES
TOTCNTLO DC PL8'0' COUNT OF LOCARES
TOTCNTSV DC PL8'0' COUNTS OF NUMBER OF SAVES
*
*
TITLE 'TABLES AND DSECTS'
PRINT NOGEN
SYSIN DCB DDNAME=SYSIN,DEVD=DA,DSORG=PS,EODAD=EODAD,MACRF=GM
*
*
SYSUT1 DCB DDNAME=SYSUT1,LRECL=133,BLKSIZE=1330,RECFM=FBA,DEVD=DA, X
DSORG=PS,MACRF=PM
*
*
SYSUT2 DCB DDNAME=SYSUT2,LRECL=133,BLKSIZE=1330,RECFM=FBA,DEVD=DA, X
DSORG=PS,MACRF=PM
*
*
CNTDCB DS 0F
SYSUT3 DCB DDNAME=SYSUT3,LRECL=133,BLKSIZE=1330,RECFM=FBA,DEVD=DA, X
DSORG=PS,MACRF=PM
*
*
BIGDCB DS 0F
SYSUT4 DCB DDNAME=SYSUT4,LRECL=133,BLKSIZE=1330,RECFM=FBA,DEVD=DA, X
DSORG=PS,MACRF=PM
*
*
DS 0D
DC CL8'INDEXTBL'
DC 12D'0' TO MAKE SPACE FOR PRIOR ENTRY
TBL DS 0D
TAB DS 0D
*
*
DC A(*+TFIRSTPC) CURRENT ENTRY
DC A(TAB+TL) SWITCH ENTRY (INIT AT END OF TBL
DC F'0' OFFSET TO CURRENT ROTATION
DC F'0' ADDR OF A PIECE USED IN PUZZLE
DC F'0' POINTER TO FIRST AVAILABLE SQUARE
DC 2F'0' INITIAL PUZZLE MASK
DC 3F'0' PLACE TO KEEP PICTURE OF THIS PIECE
*
DC A(PCETBL) ADDR OF FIRST PIECE
DC A(PCETBL+LPCE)
DC A(PCETBL+LPCE*2)
DC A(PCETBL+LPCE*3)
DC A(PCETBL+LPCE*4)
DC A(PCETBL+LPCE*5)
DC A(PCETBL+LPCE*6)
DC A(PCETBL+LPCE*7)
DC A(PCETBL+LPCE*8)
DC A(PCETBL+LPCE*9)
DC A(PCETBL+LPCE*10)
DC A(PCETBL+LPCE*11)
*
DC A(*+TFIRSTPC+4)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+8)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+12)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+16)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+20)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+24)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+28)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+32)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+36)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+40)
DC XL(TL-4)'00'
DC A(*+TFIRSTPC+44)
DC XL(TL-4)'00'
DC 2F'-1' END OF THE TABLE
*
*
DC CL8' PCETBL'
PCETBL DS 324F TABLE OF PIECES/ROTATIONS
ZERO DC 3F'0'
*
LINE1 DS 2CL133,CL2
PAGE DS 59CL133
*
LINE2 DS 2CL134
PAGE2 DS 59CL133
*
LINE3 DS 2CL134
PAGE3 DS 59CL133
*
LINE4 DC C'1 '
BIGPAGE DS 63CL133
EJECT
ORG LINE1
DOCUMENT EQU *
DC CL133' THIS IS A PROGRAM TO GET ALL OF THE SOLUTIONS OF A PUZZLE THX
AT HAS MULTIPLE SOLUTIONS. IN ADDITION TO SOLVING THE X
PUZZLE,'
DC CL133' IT CAN BE USED TO RUN INSTRUCTION LOOPS ON A SYSTEM. THE PU
UZZLE IS SOLD IN STORES AS ''HEXED'' AND IS ALSO DESCRIBE
ED IN SOME'
DC CL133' PUZZLE BOOKS AS ''PENTIMIEMOS''. BASICALLY, IT CONSISTS OF
F A 6 BY 10 BOARD, AND 12 PIECES OF 5 SQUARES EACH
H.'
DC CL133' EACH OF THE PIECES IS A DIFFERENT SHAPE, AND IF YOU TAKE FIVE
SQUARES, AND TRY TO SET THEM TOGETHER SO THAT YOU GET EAC
H POSSIBLE'
DC CL133' COMBINATION, THERE ARE 12 OF THEM. HERE IS A LIST OF THE 12
12 SHAPES THAT ARE POSSIBLE. '
DC CL133' EACH OF THE PIECES IS A DIFFERENT SHAPE, AND IF YOU TAKE FIVE
SQUARES, AND TRY TO SET THEM TOGETHER SO THAT YOU GET EAC
H POSSIBLE'
DC CL133' '
DC CL133' X XXX X XX X X XX XX XXXX XXXXX'
DC CL133' X X XX X XXX XX X XX X XX X '
DC CL133' XXX X XX XX X XX XX X XXX XXXX '
DC CL133' '
DC CL133' I FIRST SAW THIS PUZZLE MANY YEARS AGO, AND KEPT A LIST OF SE
EVERAL HUNDRED SOLUTIONS. MORE RECENTLY, I SAW IT IN AX
BOOK, AND'
DC CL133' FOUND THAT THERE WERE MORE THAN 2,000 SOLUTIONS, SO I WROTE T
THIS PROGRAM TO SEE IF I COULD DO IT, NOT KNOWING HOW LON
NG IT'
DC CL133' WOULD RUN. SO FAR IT RUNS 23 MINUTES ON THE 360-195 AND ABO
OUT THE SAME ON A 370-168. ON A 3033, IT RUNS ABOUT 11X
MINUTES.'
DC CL133' THE PROGRAM LOGIC IS GENERALLY AS FOLLOWS, '
DC CL133' FIRST, THE 6 X 10 BOARD IS CONSIDERED TO BE 10 ROWS OF 6X
BITS EACH, LAID OUT IN A ROW. THIS IS A STRING OF 60 X
BITS,'
DC CL133' WHICH WILL FIT IN AN EVEN/ODD REGISTER PAIR. EACH PIECE, CA
AN BE REPRESENTED BY SETTING 5 BITS ON IN A DOUBLE WORD.X
'
DC CL133' SOME PIECES ARE SYMETRICAL, WHILE OTHERS ARE NOT. FOR UNSYM
METRICAL PIECES, MULTIPLE PATTERNS ARE NECESSARY TO REPRE
SENT'
DC CL133' VARIOUS ROTATIONS AND REVERSALS OF THE PIECE. AS A PIECE IS
FITTED INTO THE PUZZLE, THE BITS FOR THE LOCATION(S) IT X
USED ARE'
DC CL133' TURNED ON. TO FIT ANOTHER PIECE, IT CANNOT OCCUPY ANY SQUAR
RE THAT IS ALREADY OCCUPIED. (IF YOU ''AND'' THE PUZZLEX
SO FAR,'
DC CL133' AND THE PIECE, NO BITS MAY BE LEFT ON.) ALSO, THE PIECE MUS
ST BE CHECKED TO INSURE THAT IS WITHIN THE 6 BY 10 BOUN
NDARY OF'
DC CL133' THE PUZZLE BOARD. (BECAUSE OF THE BOARD ROWS BEING ALL STRU
UNG TOGETHER, WE MIGHT TRY TO PUT THE PIECE ACCROSS AN ED
DGE, HALF'
DC CL133' ON ONE SIDE, AND HALF ON THE OTHER.) WE DO THIS BY CHECKING
G TO SEE IF THE PIECE IS ADJCENT TO THE LEFT EDGE OF THEX
BOARD, '
DC CL133' AND IF IT IS, THEN IS IT ALSO ADJCENT TO THE RIGHT EDGE. SI
INCE NO PIECE IS LONG ENOUGH TO TOUCH BOTH EDGES, THE ONL
LY WAY'
DC CL133' THIS COULD SEEM TO HAPPEN, IS IF A PIECE IS PLACED ON THE BOU
UNDARY STRADDLING THE LEFT AND RIGHT EDGES. FOR EACH PI
IECE, WE'
DC CL133' TEST TO FIND THE LOWEST AVAILABLE SQUARE, AND THEN SHIFT EACH
H PIECE UP SO THAT IT''S LOWEST ELEMENT (BIT) FITS IN THE
E FIRST'
DC CL133' AVAILABLE SQUARE. IF THE PIECE DOES FIT, IT IS OR''ED INTO T
THE PUZZLE SO FAR, AND WE FIND THE NEXT LOWEST AVAILABLEX
LOCATION'
DC CL133' AND DO IT ALL OVER AGAIN, HAVING MARKED THAT PIECE AS BEING U
USED ALREADY SO WE DON''T DUPLICATE IT. IF THE PIECE DO
OESN''T '
DC CL133' FIT, WE TRY THE NEXT ROTATION IF THERE IS ONE. IF NOT, WE G
GO ON TO THE NEXT PIECE AND TRY THAT. EVENTUALLY, WE EI
ITHER GET'
DC CL133' A SOLUTION, OR WE GET TO A POINT WHERE WE HAVE TO REMOVE A PI
IECE, AND TRY ITS NEXT ROTATION, OR THE NEXT AVAILABLE PI
IECE.'
DC CL133' TO INSURE WE DON''T GET ANY MIRROR OR ROTATED SOLUTIONS, WE O
ONLY USE ONE ATTITUDE OF THE ''L'' SHAPED PIECE. '
DC CL133' '
DC CL133' TO KEEP TRACK OF PIECES, ROTATIONS, AND WHICH PIECES WE HAD T
TRIED TO USE, WE HAVE TWO TABLES.'
DC CL133' 1. THE PIECE TABLE, WHICH HAS 12 ENTRIES, EACH OF WHICHX
CAN CONTAIN UP TO 8 POSSIBLE ROTATIONS FOR THE SPECIFIC P
PIECE.'
DC CL133' 2. THE INDEX TABLE, USED TO KEEP TRACK OF THE ORDER IN W
WHICH TO TRY TO USE PIECES, AND ALSO WHICH PIECES ARE PLA
ACED'
DC CL133' IN THE PUZZLE, AND WHERE THEY ARE. IT ALSO CONTAINSX
12 MAJOR ENTRIES. EACH ENTRY CONTAINS AN INDEX TO EACHX
OF THE'
DC CL133' 12 PIECES. THE PIECES ARE TRIED IN THE PUZZLE FROM H
HERE, AND THE INDEXES ARE JUGGLED AROUND SOMEWHAT LIKE PL
LAYING '
DC CL133' SOLITARE. IN DETAIL, THE FIRST ENTRY IS ALLOWED TO T
TRY ALL OF THE PIECES, IN ROTATION. WHEN IT FINDS A FIT
T, THE'
DC CL133' INDEX FOR THE PIECE IS FIXED IN THE FIRST LOCATION, AN
ND THE WHOLE ENTRY IS PASSED TO THE NEXT AVAILABLE SLOT,X
WHICH'
DC CL133' IS ONLY ALLOWED TO ROTATE THE LAST ELEVEN PIECES. WH
HEN A PIECE IS FOUND TO FIT IN THE NEXT PLACE IN THE PUZZ
ZLE, IT''S'
DC CL133' INDEX IS SAVED IN THE SECOND LOCATION, AND THE ENTRY I
IS PASSED ON TO THE THIRD SLOT.'
DC CL133' FROM HERE, THE FIRST 2 P INDEXES MUST REMAINE FIXED, S
AND SLL OF THE REST TRIED. '
DC CL133' THE ORDER OF ROTATION IS VERY REGULAR, SO THAT NO POSS
SIBLE COMBINATION IS MISSED. '
DC CL133' '
DC CL133' THE PROGRAM CURRENTLY HAS FOUR OUTPUT FILES, DISPLAYING SOLUT
TIONS IN FOUR DIFFERENT FORMATS. THE FIRST THREE ARE AL
L THE'
DC CL133' SAME, ONE BEING ROTATED 90 DEGREES, AND ANOTHER HAVING COUNTS
S OF THE NUMBER OF ATTEMPTS TO FIT A PIECE INTO THE PUZZL
LE, AND'
DC CL133' NUMBER OF TIMES PIECES WERE REMOVED (BECAUSE PIECES WERE PUTX
IN, AND THEN THE PUZZLE COULDN''T BE FINISHED). IN THE
E TITLE TO'
DC CL133' THIS SECTION, THERE ARE TOTALS OF THESE FIGURES FOR THE PAGE,
, AND FOR THE PUZZLE SO FAR. (THERE ARE 127,515,731 ATT
TEMPTS'
DC CL133' TO FIT PIECES INTO THE PUZZLE FOR THE ENTIRE RUN, AND 11,808,
,921 TIMES THAT PIECES WERE PUT INTO, AND REMOVED FROM, T
THE BOARD.)'
DC CL133' WHEN A SOLUTION IS FOUND, IT IS RECORDED, THEN THE LAST PIECE
E IS REMOVED, AND THE NEXT ROTATION OF THE ONE BEFORE ITX
IS TRIED.'
DC CL133' SOMETIMES, ONLY ONE OR TWO ATTEMPTS ARE NEEDED TO GET TO A DI
FERENT SOLUTION, OTHER TIMES ALMOST 1,000,000 PIECES AREX
TRIED '
DC CL133' BEFORE ANOTHER SOLUTION IS FOUND. IN THE FIRST THREE FORMAT
TS OF SOLUTIONS, EACH PIECE IS REPRESENTED BY A DIFFERENT
T'
DC CL133' CHARACTER. IN THE FORTH FORMAT, THE BOARD AND ALL THE PIECE
ES ARE OUTLINED. THIS TAKES UP LOTS MORE PAPER.'
DC CL133' '
DC CL133' THE BIT PATTERNS OF THE PIECES ARE SPECIFIED ON CONTROL CARDS
S, WHICH ARE LISTED. IN ADDITION, THE PIECES ARE ALL SH
HOWN IN'
DC CL133' THE LOWEST, AND HIGHEST POSSIBLE POSITIONS ON THE BOARD. TH
HIS IS TO ALLOW CHECKING PIECES, AND BOARD FORMAT.'
DC CL133' ALSO, THE LEFT AND RIGHT EDGES OF THE BOARE ARE SHOWN, AND AX
COUBLE OF EXTRA MASKS THAT ARE NOT USED. EACH PAGE HASX
A PAGE'
DC CL133' NUMBER, THE SOLUTIONS THAT ARE FORMATTED ON THE PAGE, AND THE
E TIME AND DATE THAT THE PAGE WAS STARTED. THE TOTAL TI
IME '
DC CL133' REQUIRED TO GET ALL OF THE SOLUTIONS CAN BE FOUND BY SUBTRACT
TING THE START TIME FROM THE STOP TIME (FORMAT = HH.MM.SS
S).'
DC CL133' THERE MAY HOWEVER HAVE BEEN OTHER JOBS RUNNING IN THE SYSTEMX
AT THE SAME TIME. THE OUTPUT IS FORMATTED IN LARGE FULL
L PAGE'
DC CL133' BUFFERS. WHEN A PAGE BUFFER FILLS UP, IT IS PRINTED, AND BL
LANKED OUT. THERE IS ONE FORMATTING AND PRINT ROUTINE,X
AND A '
DC CL133' CONTROL BLOCK TO CONTROL LOCATION, AND PRINTING OF THE PAGESX
. IT IS A DRAG, MUCH MORE COMPLICATED THAN SEEMS NECESS
SARY.'
DC CL133' '
DC CL133' '
DC X'00'
ORG
DCBD DSORG=PS,DEVD=DA
END
//LINK EXEC PGM=IEWLF128,REGION=220K,PARM='LIST,XREF' ,TEST'
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD UNIT=TEMP1,SPACE=(TRK,(5,5))
//SYSLMOD DD DSN=SRE87.L.LOAD(PUZ),DISP=SHR
//SYSLIN DD DSN=&&PUNCH,DISP=(OLD,DELETE)
//*
//T EXEC PGM=PUZ,TIME=(0,9),PARM='MAXSOL=100'
//STEPLIB DD DSN=SRE87.L.LOAD,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD DSN=SRE87.L.SYSUDUMP,DISP=SHR
//SYSIN DD DSN=DTS.L.ASM(PIECES),DISP=SHR
//* SUT1 DD *
//SYSUT2 DD *
//SYSUT3 DD *
//SYSUT4 DD *
//
//SYSIN DD *
-0001020304 00010001
10006121824 00020001
M 00030001
80006070809 00040001
80001061218 X 00050001
80001020309 X 00060001
80006121817 X 00070001
80006121819 XXX 00080001
80006050403 00090001
80001071319 00100001
80001020306 00110001
M 00120001
X0001020308 00130001
X0001020307 00140001
X0006121805 X 00150001
X0006121811 X 00160001
X0006121813 XXX 00170001
X0006121807 X 00180001
X0005060708 00190001
X0004050607 00200001
M 00210001
&0006121117 00220001
&0006121319 00230001
&0605111700 X 00240001
&0006071319 X 00250001
&0001040506 XXX 00260001
&0001020506 X 00270001
&0001070809 00280001
&0001020809 00290001
M X 00300001
L0001020612 X 00310001
M XXXXX X 00320001
+0006120507 XXXXX 00330001
M X 00340001
T0006121113 XXXXX 00350001
T0001020713 X 00360001
T0006120405 X 00370001
T0006120708 00380001
M 00390001
#0006120711 00400001
#0006120513 X 00410001
#0006120105 XXX 00420001
#0107130008 XXX 00430001
#0506070011 00440001
#0506070013 00450001
#0405060011 00460001
#0607080013 00470001
M 00480001
Z0006120111 00490001
Z0001071314 XXX 00500001
Z0405060010 X 00510001
Z0607080014 XXX 00520001
M 00530001
W0006051110 X 00540001
W0001070814 XXX 00550001
W0100060511 XXX 00560001
W0006071314 00570001
M 00580001
O0001060705 00590001
O0001060712 00600001
O0001060713 XXX 00610001
O0001060708 XXX 00620001
O0001060702 X 00630001
O0001020708 00640001
O0006120713 00650001
O0006120511 00660001
M 00670001
U0001061213 XXX 00680001
U0006010208 X 00690001
U0001071213 XXX 00700001
U0006070208 00710001