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