Puzzle

I cannot test this on my system. In fact, I cannot even assemble it.

I have several different copies of the source code, in various stages of development, and playing with changes.
Email me if this doesn't work, and we can try another copy of the source code.

My yaho id is linlyons

This is the run JCL I used to test it. So you can see the files.

//*

//T1 EXEC PGM=PUZZLE,TIME=(0,10),REGION=2M,

// PARM='NOWTO,SKIPCOL=30'

//STEPLIB DD DSN=SRE87.L.LOAD,DISP=SHR

//SYSPRINT DD SYSOUT=*

//*YSUDUMP DD DSN=SRE87.L.SYSUDUMP,DISP=SHR

//SYSUT1 DD SYSOUT=*

//SYSUT2 DD SYSOUT=*

//SYSIN DD DSN=SRE87.L.ASM(PIECES),DISP=SHR

//*

//T2 EXEC PGM=PUZZLE,TIME=(0,10),REGION=2M,COND=EVEN,

// PARM='NODOC,NOWTO,SKIPCOL=31'

//STEPLIB DD DSN=SRE87.L.LOAD,DISP=SHR

//SYSPRINT DD SYSOUT=*

//*YSUDUMP DD DSN=SRE87.L.SYSUDUMP,DISP=SHR

//SYSUT1 DD SYSOUT=*

//SYSUT2 DD SYSOUT=*

//SYSIN DD DSN=SRE87.L.ASM(PIECES),DISP=SHR

//T9 EXEC PGM=PUZZLE,TIME=(5,20),REGION=2M,

// PARM='NODOC,NOWTO' ,SKIPCOL=31'

//STEPLIB DD DSN=SRE87.L.LOAD,DISP=SHR

//SYSPRINT DD SYSOUT=*

//*YSUDUMP DD DSN=SRE87.L.SYSUDUMP,DISP=SHR

//SYSUT1 DD SYSOUT=*

//SYSUT2 DD SYSOUT=*

//SYSIN DD DSN=SRE87.L.ASM(PIECES),DISP=SHR

//SYSUT3 DD SYSOUT=*

//SYSUT4 DD SYSOUT=*

//SYSUT5 DD SYSOUT=*

//SYSUT6 DD SYSOUT=*

//SYSUT7 DD SYSOUT=*

//SYSUT8 DD SYSOUT=*

//SYSUT9 DD SYSOUT=*

//SYSUT10 DD SYSOUT=*

//SYSUT1$ DD SYSOUT=*

//SYSUT2$ DD SYSOUT=*

//SYSUT7$ DD SYSOUT=*

This is the input file that you'll need

-0001020304

10006121824

80006070809

80001061218 X

80001020309 X

80006121817 X

80006121819 *** XX

80006050403 ***

80001071319 ***

80001020306 ***

X0001020308 ***

X0001020307

X0006121811 *** X

X0006121805 X

X0006121807 *** XX

X0006121813 X

X0005060708 ***

X0004050607

&0006121117 ***

&0006121319

&0605111700 ***

&0006071319 X

&0001040506 XXX

&0001070809 *** X

&0001020506

&0001020809 ***

M X

L0001020612 X

M XXX X

+0006120507 XXX

M X

T0006121113 XXX

T0001020713 X

T0006120405 X

T0006120708

#0006120711

#0006120513 *** X

#0006120105 XX

#0107130008 *** XX

#0506070011 ***

#0506070013

#0405060011 ***

#0607080013

Z0006120111

Z0001071314 *** XX

Z0405060010 *** X

Z0607080014 XX

W0006051110 X

W0001070814 XX

W0100060511 XX

W0006071314

O0001060705 *

O0001060708 *

O0001060702 * XXX

O0001060712 * XXX

O0001060713 * X

O0001020708 *

O0006120713 *

O0006120511 *

U0001061213 XXX

U0006010208 X

U0001071213 XXX

U0006070208

And the program. I played with it many times. I hope this works.

PUZZLE TITLE 'PUZZLE INITIALIZATION STUFF'

*======================================================================

MACRO

&LABEL PRTBL &PAGE=,&WIDTH=,&LENGTH=,&BOARD=,&DCB=,&PAGEW=,&PAGEL=, X

&SPACEW=1,&SPACEL=1,&TITLE=,&NTITLE=2,&LTITLE=, X

&FMTRTN=0

*LABEL PRTBL PAGE=,WIDTH=,LENGTH=,BOARD=,DCB=,PAGEW=,PAGEL=,FMTRTN=,X

* SPACEW=1,SPACEL=1,TITLE=(LINE1),NTITLE=2,LTITLE=

&LABEL DC A(&PAGE,&WIDTH,&LENGTH,&BOARD) 1

.* CUR.LOC, ENT.LEN, #.LINES, A(BOARD); LEN.ENT.LINE, LINE.LENGTH

DC A(&WIDTH+&SPACEW,(&LENGTH+&SPACEL)*&PAGEW) 2

DC A(&PAGEW-&WIDTH,&PAGEW*(&PAGEL-&LENGTH),&PAGE,&PAGE) 3

.* LINE.LENGTH, PAGE.LEN; A(CUR.LINE),A(PAG); A(END/LINE), A(END/PAGE)

DC A(&PAGE+&PAGEW-&WIDTH,&PAGE+(&PAGEL-&LENGTH)*&PAGEW)

DC A(&DCB,&FMTRTN),PL2'0',AL2(&LTITLE-1)

.* A(DCB, BOARD.FMT.RTN), PAGE.COUNT, LEN/TITLE, A(WRITE.INIT)

DC A(&TITLE,&PAGEL)

.* #LINES.WRITE, TITLE, PAGE.INIT.REGS

DC A(&TITLE,(&PAGEL+&NTITLE)*&PAGEW,ZERO),C' ',AL3(0)

DC CL132' ' TITLE

MEND

*======================================================================

MACRO

&LABEL PRPGE &TITLE,&PAGEW,&PAGEL,&NUMTITL=2

&TITLE DS (&NUMTITL)CL&PAGEW

DS CL1

&LABEL DS (&PAGEW)CL&PAGEL

DS 64X

MEND

*======================================================================

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

*---------------------------------------------------------------------*

* *

* THERE ARE TWO MAJOR TABLES USED TO DO THIS CALCULATION. ONE IS *

* THE PIECE TABLE. IT CONTAINS 12 ENTRIES, ONE FOR EACH POSSIBLE *

* PIECE. EACH ENTRY CONTAINS SEVERAL SUB-ENTRIES, ONE FOR EACH *

* POSSIBLE ORIENTATION OF THE PIECE, AND CONTROL TO KEEP TRACK OF *

* WHICH ORIENTATION IS BEING USED/TESTED. *

* THE BOARD IS 6 X 10 - THAT IS 60 LOCATIONS. IF BITS CAN BE *

* USED TO REPRESENT LOCATIONS, THE PIECES AND BOARD CAN BE KEPT IN *

* A PAIR OF REGISTERS, AND THIS IS USED FOR THE CALCULATIONS. *

* THE SECOND TABLE IS USED TO KEEP TRACK OF PIECES AS THEY ARE *

* SET INTO THE PUZZLE BOARD (OR ARRAY). IT ALSO HAS 12 MAJOR *

* ENTRIES. EACH ENTRY IS USED TO CONTAIN ONE PIECE AS IT IS PLACED *

* INTO THE PUZZLE. WHEN THE LAST ENTRY IS MADE, A SOLUTION HAS BEEN *

* FOUND. AT THE BEGINNING, ALL OF THE PIECES ARE ARBITRARILY *

* PLACED IN THE PIECE TABLE, AND THE INDEX TABLE IS SET UP TO POINT *

* TO THE PIECES IN SEQUENCE. *

* THE FIRST AVAILABLE LOCATION (FIRST ZERO BIT IN THE PUZZLE BOARD *

* ARRAY) IS FOUND, AND THE PIECE USED MUST FILL THIS LOCATION. THIS *

* INSURES THAT AS THE ARRAY IS FILLED UP, NO EMPTY LOCATIONS ARE *

* LEFT. EACH LOCATION IN THE ARRAY MAY BE *

* THOUGHT OF AS HAVING AN ADDRESS THAT IS THE 54 55 56 57 58 59 *

* NUMBER OF BIT POSITIONS THAT A PIECE MUST 40 49 50 51 52 53 *

* BE SHIFTED UP TO PUT THE PIECE IN THE ARRAY. 42 43 44 45 46 47 *

* EACH PIECE HAS AN AREA OF 5 BITS. THE PIECE 36 37 38 39 40 41 *

* SHAPED LIKE AN 'L' THUS MIGHT OCCUPY THE 5 30 31 32 33 34 35 *

* POSITIONS 25, 19, 13, 14, AND 15. TO PUT 24 25 26 27 28 29 *

* THE PIECE IN THIS LOCATION, THE BIT PATTERN 18 19 20 21 22 23 *

* WOULD BE LOADED INTO AN EVEN-ODD REGISTER 12 13 14 15 16 17 *

* PAIR, AND SHIFTED RIGHT (UP) 13 PLACES. 06 07 08 09 10 11 *

* IF A PIECE IS ATTAMPTED TO BE PUT INTO 00 01 02 03 04 05 *

* THE ARRAY WITHOUT SHIFTING IT UP (I.E. *

* INTO POSITION '00') THE 00 LOCATION WILL BE USED. IF WE TAKE THE *

* '+' SHAPED PIECE, THIS PRODUCES AN IMPOSSIBLE SITUATION, IN THAT *

* THE LEFT CENTER PART OF THE PIECE FALLS OFF OF THE BOARD. WHILE *

* THIS IS VISUALLY QUITE APPARENT, IT TAKES A LITTLE MORE WORK TO *

* DETERMINE THAT THE BIT PATTERN IS INVALID. THE BITS FOR THIS *

* SITUATION FALL IN LOCATIONS 00, 05, 06, 07, AND 12, SINCE THE *

* BOARD IS KEPT IN ONE SINGLE CONTINUOUS STRING. HOWEVER, AFTER WE *

* TURN THESE BITS ON, WE TEST TO DETERMINE IF THE PIECE OCCUPIES A *

* LOCATION ON THE LEFT EDGE OF THE ARRAY (BOARD), AND IF IT DOES, *

* TEST TO SEE IF IT OCCUPIES A LOCATION ON THE RIGHT EDGE OF THE *

* BOARD. IF THE PIECE SEEMS TO BE ADJCENT TO BOTH EDGES, THE BIT *

* PATTERN MUST BE INVALID, SINCE NO PIECE IS LARGE ENOUGH TO TOUCH *

* BOTH EDGES SIMULTANEOUSLY, LEGALLY. *

* USING THIS TEST, WE TRY TO PUT PIECES IN, AND EACH TIME A PIECE *

* FITS INTO THE ARRAY, WE TURN ON BITS FOR THE POSITION IS OCCUPIES, *

* MARK THE PIECE AS USED, AND TRY TO FIT ANOTHER PIECE IN THE *

* REMAINING OPEN PORTION. IF WE GET TO A SITUATION IN WHICH NO *

* PIECE LEFT FITS, WE TAKE OUT THE LAST PIECE THAT WE SUCCESSFULLY *

* PUT IN THE ARRAY, (BY TURNING OFF THE BITS) AND TRY ANOTHER *

* ORIENTATION OF THE PIECE, OR A DIFFERENT PIECE ENTIRELY. *

* ANOTHER PROBLEM IS HOW TO PREVENT DUPLICATE SOLUTIONS. THESE *

* COULD OCCUR IN 3 WAYS, MIRROR IMAGES, ROTATIONS, AND JUST PLAIN *

* DUPLICATE IMAGES. THE FIRST 2 PROBLEMS ARE TAKEN CARE OF BY ONLY *

* USING ONE ORIENTATION OF THE PIECE SHAPED LIKE AN 'L'. ANY *

* ROTATION OF MIRROR IMAGE OF A SOLUTION WOULD HAVE THIS PIECE IN *

* A DIFFERENT ORIENTATION, THUS WE WILL NEVER TRY TO BUILD THAT *

* SOLUTION. HOWEVER, ONLY USING ONE ORIENTATION OF THE PIECE WILL *

* PERMIT EVERY VALID SOLUTION TO BE FOUND ONCE. *

* THE THIRD PROBLEM, JUST PLAIN DUPLICATES IS MORE COMPLICATED TO *

* SOLVE. THE SOLUTION INVOLVES HOW THE INDEX TABLE IS USED. *

* ASSUME THAT ALL OF THE PIECES ARE NUMBERED, 1 TO 12. WE WILL TRY *

* TO USE PIECE '1' IN LOCATION 00 FIRST. IF IT FITS, WE WILL THEN *

* TRY TO USE PIECES 2 THRU 12, IN ORDER, IN THE NEXT OPEN POSITION. *

* EACH TIME A PIECE IS FITTED INTO THE BOARD, ALL OF THE REMAINING *

* PIECES ARE ATTEMPTED TO BE USED IN ORDER. FOR ANY ONE POSITION OF *

* A PIECE, FROM NONE TO SEVERAL HUNDRED SOLUTIONS MAY BE FOUND. IN *

* ANY EVENT, ONCE A PIECE IS REMOVED FROM A LOCATION, IT IS NEVER *

* INSERTED INTO THE SAME LOCATION AGAIN UNLESS THE LOCATIONS OF *

* PIECES THAT HAVE BEEN PUT INTO THE BOARD PRIOR TO THE PIECE IN *

* QUESTION HAVE CHANGED. IN THE ABOVE DESCRIPTIONS, SOMETIMES WHEN *

* I SAID 'A DIFFERENT PIECE' I REALLY MEAN 'EITHER A DIFFERENT *

* ROTATION (ORIENTATION) OF THE SAME PIECE, OR A DIFFERENT PIECE *

* ENTIRELY'. IT WAS JUST EASIER TO TALK ABOUT PIECES, AND EXPLAIN *

* THIS QUALIFICATION SEPARATELY. *

* THOSE ARE ALL OF THE NECESSARY CONCEPTS TO UNDERSTAND THE *

* OPERATION OF THIS PROGRAM. WHEN I WROTE IT, I DIDN'T KNOW IF IT *

* WOULD WORK, OR HOW LONG IT WOULD TAKE TO RUN. WHEN I RAN IT, I *

* FOUND THAT IT TOOK 23 MINUTES IN AN IBM 168-3, 21 MINUTES ON *

* THE IBM 370/195, AND 11 MINUTES ON AN IBM 370/3033. *

* GENERAL SECTIONS OF THE PROGRAM ARE *

* INITIALIZATION, READING A FILE THAT DEFINES ALL OF THE ROTATIONS *

* (ORIENTATIONS) OF THE PIECES THEN PUTTING THE BIT PATTERNS OF THE *

* PIECES INTO THE PIECE-TABLE, PRINTING PATTERNS OF EACH PIECE TO *

* INSURE THAT EACH PIECE WAS LOADED CORRECTLY, GENERAL PUZZLE *

* SOLUTION, AND FINALLY SEVERAL ROUTINES TO PRINT SOLUTIONS IN *

* VARIOUS FORMATS AS THEY ARE FOUND. THERE IS ALSO A ROUTINE THAT *

* SAVES ALL OF THE SOLUTIONS, SORTS THEM, AND THEN COMPARES THEM TO *

* INSURE THAT THERE ARE NO DUPLICATES. *

* *

*---------------------------------------------------------------------*

* THIS DSECT DEFINES THE MAIN TABLE USED TO DETERMINE WHICH PIECE TO

* TRY NEXT, AND KEEP TRACK OF PIECES ALREADY USED. THE TABLE HAS 12

* ELEMENTS, ONE FOR EACH PIECE. PIECES ARE TRIED IN A DIFFERENT ORDER

* BY EXCHANGING THE ADDRESS(ES) IN 'THIS', EACH OF WHICH POINTS TO

* AN ELEMENT IN THE 'PIECE' TABLE.

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

* NEXT IS THE 'PIECE' TABLE. EACH ELEMENT DEFINES ALL OF THE POSSIBLE

* POSITIONS OF A PIECE (MAXIMUM OF 8), AND THE TABLE IS THEREFORE A

* TWO DIMENSIONAL TABLE, HOWEVER, EACH ELEMENT HAS SOME EXTRA

* INFORMATION RELATING TO THE PIECE DEFINED IN ADDITION TO THE BIT

* PATTERNS FOR THE VARIOUS ROTATIONS OF THE PIECE.

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)

* FINALLY, THERE IS A DSECT THAT DEFINES PARAMETERS USED BY THE PRINT

* ROUTINE TO MOVE SOLUTIONS TO A PRINT PAGE IMAGE. MUCH LESS THINKING

* WENT INTO THIS ROUTINE, SO IT'S NOWHERE NEAR AS ELEGANT (IT'S A PIECE

* OF TRASH)

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

PGINIT DS 4F REGS TO INIT THE PAGE

PGL1 DS CL132

DS 0D

LPAG EQU *-PAG

PUZ CSECT

REGS BR,10

*--------------------------------------------------------------------*

* FIRST, DO ALL OF THE NORMAL REG SAVE STUFF. *

*--------------------------------------------------------------------*

USING *,13,12 SET UP 2 BASE REGS

STM 14,12,12(13) SAVE OS REGS

LR 2,15 DUPLICATE EP ADDR

LA 12,2048(2) SECOND BASE

LA 12,2048(12) 4096 PAST 13

ST 2,8(13) SAVE OUR SA ADDR IN OS

ST 13,4(2) WIPE OUT BEG OF PGM FOR OUR SAVE ARE

LR 13,2 LOAD ADDR OF OUR SAVE AREA

L 2,0(1) THE PARM FIELD ISN'T EVER USED,

LH 3,0(2) BUT I HAVE THIS PAVLOFF CONSISTANCY.

S 3,=F'1'

BM NOPARM

EX 3,MVCPARM

L 3,=A(BYLINE)

B PARMTEST

PARMLOOP LA 1,PARM

LA 1,1(1)

CLI 0(1),C','

BH *-8

BL NOPARM

MVC PARM,1(1)

PARMTEST CLC =C'NOWTO',PARM

BNE NNOWTO

MVI FLAGWTO,C'N'

B PARMLOOP

NNOWTO DS 0H

CLC =C'NODOC',PARM

BNE NNODOC

MVI FLAGDOC,C'N'

B PARMLOOP

NNODOC DS 0H

CLC =C'CHECK',PARM

BNE NCHECK

MVI FLAGCHK,C'C'

B PARMLOOP

NCHECK DS 0H

CLC =C'ESTAE',PARM

BNE NESTAE

ESTAE ESTAE,TERM=NO

LTR 2,15

BZ PARMLOOP

WTO 'BAD R/C FROM ESTAE '

EX 0,*

NESTAE CLC =C'SKIPCOL=',PARM

BNE NCOL

MVC PARM,PARM+8

LA R1,COLSKIP

COLLOOP PACK DW,PARM(2)

CVB R0,DW

STH R0,0(R1)

CLI PARM+3,C'0'

BL PARMLOOP

LA R1,2(R1)

MVC PARM,PARM+3

B COLLOOP

COLSKIP DC 4F'0'

NCOL CLC =C'CR',PARM

BNE NCR

MVC L1PAGE+5(30),TBLINDEX

TR L1PAGE+5(30),ALPHABET

MVC 24(20,3),L1PAGE+15

B PARMLOOP

NCR DS 0H

MVC PARMWTO+22(10),PARM

PARMWTO WTO 'INVALID PARM ( ) MUST BE NOWTO, CHECK, ESTAE, O

OR NODOC'

EX 0,*

FLAGCHK DC X'00'

FLAGWTO DC C'W'

FLAGDOC DC C' '

SPACES DC C' '

PARM DC CL100' '

MVCPARM MVC PARM(0),2(2) SAVE THE PARM FIELD

NOPARM SR 3,3

MVC PARM,SPACES

RP EQU 2 USE WITH 'PIECE' TABLE,A(A ROTATION)

RNUMTRY EQU 3 NUMBER OF TRIES TO PUT PIECE IN.

RLOC EQU 4 LOCATION OF FIRST EMPTY LOCATION

RPIECE EQU 5 USE WITH 'PIECE' TBL. RPIECE POINTS

* TO AN ELEMENT, RP POINTS TO A

* SPECIFIC ROTATION OF THE PIECE.

WR2 EQU 6 GENERAL WORK REG

RC EQU 7 ANOTHER ONE.

WR EQU 8 ''

RX EQU 9 POINTS TO CURRENT INDEX TBL ENTRY

* USED TO DEFINE ORDER IN WHICH TO

* TRY TO INSERT PIECES INTO PUZZLE.

*BR EQU 10 BAL RETURN REG

RPG EQU 11 PAGE DSECT REG - DEFINES ADDRESSES

* USED TO FORMAT VARIOUS PAGE AREAS.

USING T,RX

USING P,RP

USING PAG,RPG ADDRESSABILITY OF PAGE TABLES

*--------------------------------------------------------------------*

* FIRST, SPACE OUT THE PRINT PAGE AREAS. USE PARAMETERS FROM THE *

* PAGE CONTROL TABLES. _ *

* _ _ _ *

*--------------------------------------------------------------------*

LA RPG,PAGETBL LOAD ADDR OF PAGE TABLES TO INIT COR

B INITMVCL DON'T INIT PCETBL DUMMY PAGE TBL

INITLOOP DS 0H

MVC PGL1,L1 AND SAVE HEADING

BAL BR,WRITINIT GO DO PAGE HEADING INIT

INITMVCL DS 0H THE FIRST THING TO DO IS MOVE SPACES

* TO THE PAGE TABLES. THEY SHOULD BE

* GETMAINED AREAS, BUT WHY BOTHER.

LM 6,9,PGINIT REGS TO INIT A PAGE TABLE

MVCL 6,8 INIT CORE (SPACE IT OUT).

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

OPEN (SYSIN,INPUT,SYSUT1,OUTPUT)

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

LA R1,COLSKIP

TSTSKIP LH R15,0(R1)

LTR R15,R15

BZ PUTPIECE

LA R15,CARD-1(R15)

CLI 0(R15),C'*'

BE SKIPIECE

LA R1,1(R1)

B TSTSKIP

SKIPIECE MVC CARD+40(4),=C'SKIP'

PUTPIECE PUT SYSUT1,CARD-1 LIST OF INPUT DATA CARDS

CLI CARD+40,C'S'

BE GETAPCE

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

CNOP 2,4 ALIGN CARD ON F/W BOUNDARY

DC CL2' '

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.

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 CHECK

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,8(RP) PUT THE CHECKING CHAR IN PLACE

STM 3,11,SOLSAV SAVE THE REGS

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

LM 3,11,SOLSAV LOAD 'EM UP AGAIN.

LA RP,8(RP) ADDR OF NEXT MASK TO CHECK

MVC BOARD,BOARD-1 INIT BOARD TO PERIODS

BCT RC,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 'TABLE MACRO CONTROL $TBLGEN'

TABLE $TBLGEN ENTRYNO=2530,ENTRYLN=64,REG=5,KEY=4,KEYLEN=60, X

SORT=A,DOC=ALL

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

ST RLOC,TLOC SAVE THIS LOC IN CASE WE REMOV PCE

SR RP,RPIECE CALC OFFSET TO THIS ROTATION

LA RP,12(RP) ADD 1 CAUSE WE ALWASY SAVE NEXT

ST RP,TROT SAVE OFFSET TO THIS ROTATION

OR 6,14 OR PIECE INTO PUZZLE SO FAR

OR 7,15 (BOTH HALVES)

STM 6,7,PUZZLE AND SAVE FOR NEXT USE

CLI TL(RX),255 IS THIS ALL THE PIECES

BE MAINDONE YES, GO RECORD THE SOLUTION

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 RLOC,TLOC LOAD NEW (PREV) LOCATION

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)

STM 2,12,CARD SAVE ALL THE REGS,

L 7,=A(WRITEDOC) LOAD ADDR OF DOC. WRITE ROUTINE

BALR BR,7 GO WRITE DOCUMENTATION AND RELOAD

LM 2,12,CARD REGS THAT MAY HAVE BEEN WIPED OUT.

CLI FLAGCHK,C'C' DO WE CHECK FOR DUPLICATES

BNE NOTBLGM NO, DON'T DO GETMAIN FOR TABLE

$TBLGM TABLE DO A GETMAIN OF ABOUT 150K

NOTBLGM DS 0H

L RX,X LOAD PRIMARY INDEX

LR 1,RX DUPLICATE ADDRESS

SR RNUMTRY,RNUMTRY DON'T COUNT TIMES THRU FIT IN INITAL

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

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

B MAINLOSE GO TAKE NEXT TO LAST PIECE OFF ALSO

* 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 RNUMTRY,1(RNUMTRY) 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 FITGOOD NO, MUST FIT THE BOARD, PUT IT THERE

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

BZ FITGOOD NO, IT FITS, GO TO SAVE RTN

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 (SYSUT2,,SYSUT3,,SYSUT4)

CLI PARM,C'C' DO WE CHECK FOR DUPLICATES

BNE *+8 NO, BYPASS BAL TO RTN TO SORT AND CK

BAL BR,CHECKTBL YES, GO SORT AND COMPARE SOLUTIONS

CLOSE (SYSUT1)

L 13,4(13)

LM 14,12,12(13)

SR 15,15

BR 14

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'

* LOTS LESS THINKING WENT INTO THIS SECTION, I DIDN'T SUSPECT IT

* WOULD GET SO CRUMMY. I'D REWRITE IT, BUT WHY BOTHER, ALTHOUGH

* IT SURE WOULD BE NICE, AND IT WOULD MAKE THE MESS EASIER TO

* UNDERSTAND.

* BASICALLY, AS I REMEMBER, THE FIRST SECTION SETS UP A PICTURE

* OF THE PUZZLE, THEN IT IS COPIED INTO THE VARIOUS BOARD IMAGES.

* THE SETUP ISN'T BAD, BUT CONTROL OF THE BOARDS IS TERRIBLE - IT

* USES A BIG SET OF PARTIALLY DUPLICATED PARAMETERS - IT EVEN

* CONFUSES ME (ALTHOUGH THAT'S NOT DIFFICULT!).

* FIRST, SAVE THE ORIGIONAL REGISTERS, THEN INSURE THE ADDRESS OF

* THE MAIN 'PIECE TABLE' IS LOADED.

SOLUTION DS 0H

STM 4,11,SOLSAV SAVE THE REGS

L RX,=A(TBL) LOAD ADDR OF INDEX TABLE

* NEXT, LOOP THRU THE PIECE TABLE, PUTTING THE IMAGE IF EACH PIECE

* ONTO THE BOARD. THE RTN USES,

* (A) IMAGE OF THE PIECE, AND

* (B) OFFSET OF THE PIECE ON THE BOARD FOR THE CURRENT SOLUTION.

* A X'FF' INDICATES THE END OF THE PIECE TABLE

SOLPCE DS 0H

LA RP,TPIECE LOAD ADDR OF THIS 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

* NEXT, COUNT THE SOLUTION, THEN TRANSLATE THE IMAGE OF THE BOARD

* FROM HORIZONTAL TO VERTICAL.

AP CNTPUZ,=P'1' COUNT THE SOLUTION

MVC BOARD2,TRANSLAT SETUP TO MOVE SOLUTION TO HORIZONTAL

TR BOARD2,BOARD BOARD, AND MOVE IT.

* LOAD THE ADDRESS OF A SERIES OF PARAMETERS THAT DEFINE A REPORT

* PAGE, TO USE TO PUT THIS SOLUTION ON THE REPORT PAGE IMAGE.

LA RPG,PAGETBL LOAD ADDR OF A PAGE CONTROL TBL

* NEXT MOVE THE SOLUTION TO THE VARIOUS PAGE IMAGES.

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

CLI FLAGCHK,C'C' DO WE CHECK FOR DUPLICATES

BNE NOTBLADD NO, DON'T ADD AN ENTRY TO THE TBL

$TBLADD TABLE GET AN ADDRESS IN THE TABLE

OI CNTPUZ+2,X'0F' FIX SIGN OF COUNT FIELD

UNPK BOARD2-5(5),CNTPUZ MAKE THIS PUZZLE NUMBER PRINTABLE

MVC 0(64,RTABLE),BOARD2-4 MOVE THIS SOLUTION INTO THE TBL

NOTBLADD DS 0H

CLI FLAGWTO,C'W' DO WE ADVERTIZE OUR PROGRESS,

BNE SKIPWTO NO, DON'T DO ALL THE WTO'S

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'

SKIPWTO DS 0H

NOWTOCNT DS 0H

SR RNUMTRY,RNUMTRY ZERO OUT CNT OF LOCATES FOR PIECE

LM 4,11,SOLSAV RELOAD THE REGS WE LIKELY WIPED OUT

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(L1COUNT,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 RNUMTRY,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

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 15,1

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,22(6) PLACE IN NEXT LINE

LA 8,10 DO IT 10 TIMES FOR NEXT LINE TOO

BCT 9,FMTBIGLP GO DO NEXT 5 LINES

BR BR RETURN

FMTBIGAD DC A(BIGBOARD,BOARD2,10,6)

TITLE 'RTN TO CHECK FOR DUPLICATE SOLUTIONS'

CHECKTBL DS 0H

$TBLSORT TABLE SORT ALL OU THE SOLUTIONS

$TBLTOP TABLE GO UP TO THE TOP OF THE TABLE

L 3,=A(PAGE) LOAD ADDR OF PRINT PAGE

LA 4,133(3) BEG OF NEXT LINE

TBLCHKLP DS 0H

LR 2,RTABLE SAVE PREV ENTRY ADDRESS

$TBLNEXT TABLE GET ADDR OF NEXT ENTRY IN TABLE

LTR RTABLE,RTABLE DID WE GET TO THE END

BZ CHKTBLX YES, EXIT FROM THIS ROUTINE

CLC 4(60,RTABLE),4(2) NO, IS THIS SOLUTION IDENTICAL TO

BNE TBLCHKLP THE PREVIOUS ONE

MVC 0(4,3),0(2) MOVE 2 SOLUTION NUMBERS TO A PAGE

MVC 5(4,3),0(RTABLE) MOVE 2 SOLUTION NUMBERS TO A PAGE

LA 3,20(3) NEXT PLACE

CR 4,3 DID WE RUN OFF THE END OF THE LINE

BH TBLCHKLP NO, GO COMPARE A COUPLE MORE SOLUTNS

LR 3,4 YES, START AT BEGINING OF NEXT LINE

LA 4,133(3) AND SAVE NEXT LINE ADDR

B TBLCHKLP NOW GO COMPARE A COUPLE MORE SOLS

CHKTBLX DS 0H

C 3,=A(PAGE) DID WE RECORD ANY DUPLICATES

BCR 8,BR NO, MUST BE OK

BAL BR,FORCEPAG YES, GO WRITE OUT ALL DUPLICATES

BR BR NOW RETURN

TITLE 'CONSTANTS AND MISSING ROUTINES '

ALPHABET DC C' ABCDEFGHIJKLMNOPQRSTUVWXYZ'

INITPCE DC A(PCETBL,324*4,DW),X'FF',AL3(0)

PAGETBL DS 0D 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'89'

DC A(LINE1,60)

DC A(LINE1,61*133,ZERO),C' ',AL3(0)

DS CL132

DS 0D

* CUR.LOC, ENT.LEN, #.LINES, A(BOARD); LEN.ENT.LINE, LINE.LENGTH

* LINE.LENGTH, PAGE.LEN; A(CUR.LINE),A(PAG); A(END/LINE), A(END/PAGE)

* A(DCB, BOARD.FMT.RTN), PAGE.COUNT, LEN/TITLE, A(WRITE.INIT)

* #LINES.WRITE, PAGE.INIT.REGS, TITLE.

*LABEL PRTBL PAGE=,WIDTH=,LENGTH=,BOARD=,DCB=,PAGEW=,PAGEL=, X

* SPACEW=1,SPACEL=1,TITLE=(LINE1),LTITLE=,FMTRTN=(RTN)

$BOARD1 PRTBL PAGE=$PAGE,WIDTH=6,LENGTH=10,BOARD=BOARD,DCB=SYSUT1$, X

PAGEL=59,PAGEW=133,TITLE=LINE1,LTITLE=60

$BOARD7 PRTBL PAGE=$PAGE7,WIDTH=6,LENGTH=10,BOARD=BOARD,DCB=SYSUT7$, X

PAGEL=88,PAGEW=205,TITLE=LINE7,LTITLE=60

$BOARD2 PRTBL PAGE=$PAGE2,WIDTH=6,LENGTH=10,BOARD=BOARD,DCB=SYSUT2$, X

PAGEL=59,PAGEW=133,TITLE=LINE1,LTITLE=60

QBOARD7 DC A(PAGE7,6,10,BOARD)

DC A(8,11*210)

DC A(195,210*76,PAGE7,PAGE7)

DC A(PAGE7+195,PAGE7+210*80)

DC A(SYSUT7,0)

DC PL2'0',H'59'

DC A(LINE7,90)

DC A(LINE7,90*210,ZERO),C' ',AL3(0)

DS CL132

DS 0D

QBOARD2 DC A(PAGE2,10,6,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'89'

DC A(LINE2,60)

DC A(LINE2,61*133,ZERO),C' ',AL3(0)

DS CL132

DS 0D

QBOARD8 DC A(PAGE8,10,6,BOARD2)

DC A(11,8*210)

DC A(190,210*80,PAGE8,PAGE8)

DC A(PAGE8+190,PAGE8+210*80)

DC A(SYSUT8,0)

DC PL2'0',H'59'

DC A(LINE8,90)

DC A(LINE8,90*210,ZERO),C' ',AL3(0)

DS CL132

DS 0D

QBOARD3 DC A(PAGE3,10,9,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,61)

DC A(LINE3,61*133,ZERO),C' ',AL3(0)

DS CL132

DS 0D

QBOARD9 DC A(PAGE9,10,9,BOARD2)

DC A(11,10*210)

DC A(190,210*78,PAGE9,PAGE9)

DC A(PAGE9+190,PAGE9+210*78)

DC A(SYSUT9,FMTCOUNT)

DC PL2'0',H'59'

DC A(LINE9,90)

DC A(LINE9,90*210,ZERO),C' ',AL3(0)

DS CL132

DS 0D

* CUR.LOC, ENT.LEN, #.LINES, A(BOARD); LEN.ENT.LINE, LINE.LENGTH

* LINE.LENGTH, PAGE.LEN; A(CUR.LINE),A(PAG); A(END/LINE), A(END/PAGE)

* A(DCB, BOARD.FMT.RTN), PAGE.COUNT, LEN/TITLE, A(WRITE.INIT)

* #LINES.WRITE, TITLE, PAGE.INIT.REGS

QBOARD4 DC A(PAGE4,21,13,BIGBOARD)

DC A(26,14*133)

DC A(119,133*54,PAGE4,PAGE4)

DC A(PAGE4+119,PAGE4+133*50)

DC A(SYSUT4,FMTBIGBD)

DC PL2'0',H'0'

DC A(LINE4,60)

DC A(LINE4+2,61*133,ZERO),C' ',AL3(0)

DS CL132

DS 0D

QBOARD10 DC A(PAGE10,21,13,BIGBOARD)

DC A(26,14*210)

DC A(180,210*76,PAGE10,PAGE10)

DC A(PAGE10+180,PAGE10+210*76)

DC A(SYSUT10,FMTBIGBD)

DC PL2'0',H'0'

DC A(LINE10,60)

DC A(LINE10+2,90*210,ZERO),C' ',AL3(0)

DS CL132

DS 0D

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 CL90'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',CL32' '

ORG

L1COUNT DC CL72' ' COUNT FIELDS WILL GO HERE

TBLINDEX DC AL1(3,15,16,25,18,9,7,8,20,0,0,12,9,14,23,15,15,4,0)

DC AL1(7,18,1,14,20,0,12,25,15,14,19)

DC C'.'

BOARD DS CL60

DS CL5 PUZZLE COUNT WILL GO HERE

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,51,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

LTORG

PUSH USING

ESTAE DS 0D

USING *,10

USING SDWA,2

LR 10,15

CH 0,=H'12'

BNE ESTAEOK

SR 15,15

BR 14

ESTAEOK STM 14,12,12(13)

LA 1,0(1)

LR 2,1

UNPK ESTAEWTO+8+6(7),SDWACMPC(4)

TR ESTAEWTO+8+6(6),HEX

MVI ESTAEWTO+8+6+6,C' '

ICM 1,7,SDWANXTA

S 1,=A(PUZ)

ST 1,0(13)

UNPK ESTAEWTO+8+23(7),1(4,13)

TR ESTAEWTO+8+23(6),HEX

MVI ESTAEWTO+8+29,C'.'

ESTAEWTO WTO 'ABEND-000000 AT OFFSET=000000. '

LA 3,SDWAGRSV

LA 6,4

ESTAEL1 LA 4,4

LA 5,ESTAEWTR+8

ESTAEL2 UNPK 0(9,5),0(5,3)

TR 0(8,5),HEX

MVI 8(5),C' '

LA 5,9(5)

LA 3,4(3)

BCT 4,ESTAEL2

ESTAEWTR WTO '00000000 00000000 00000000 00000000.'

BCT 6,ESTAEL1

LM 14,12,12(13)

SR 15,15

BR 14

LTORG

POP USING

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, X

DSORG=PS,MACRF=PM

SYSUT2$ DCB DDNAME=SYSUT2$,LRECL=133,BLKSIZE=1330,RECFM=FBA, X

DSORG=PS,MACRF=PM

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

SYSUT7 DCB DDNAME=SYSUT7,LRECL=210,BLKSIZE=2100,RECFM=FBA,DEVD=DA, X

DSORG=PS,MACRF=PM

SYSUT7$ DCB DDNAME=SYSUT7$,LRECL=205,BLKSIZE=2050,RECFM=FBA, X

DSORG=PS,MACRF=PM

SYSUT8 DCB DDNAME=SYSUT8,LRECL=210,BLKSIZE=2100,RECFM=FBA,DEVD=DA, X

DSORG=PS,MACRF=PM

SYSUT9 DCB DDNAME=SYSUT9,LRECL=210,BLKSIZE=2100,RECFM=FBA,DEVD=DA, X

DSORG=PS,MACRF=PM

SYSUT10 DCB DDNAME=SYSUT10,LRECL=210,BLKSIZE=2100,RECFM=FBA,DEVD=DA, X

DSORG=PS,MACRF=PM

PRINT GEN

HEX EQU *-240

DC C'0123456789ABCDEF'

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)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+8)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+12)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+16)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+20)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+24)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+28)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+32)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+36)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+40)

DS ((TL-4)/4)F

DC A(*+TFIRSTPC+44)

DS ((TL-4)/4)F

DC 2F'-1' END OF THE TABLE

DC 64X'DD'

DC CL8' PCETBL'

PCETBL DC 324F'-1' TABLE OF PIECES/ROTATIONS

ZERO DC 3F'0'

DC 32X'DD' SPACE BEFORE BIG BOARD

DC 11C' 1'

BIGBOARD DS 13CL21 THIS WILL CONTAIN THE BIG PICTURE

ORG BIGBOARD

DC 11C'+-'

ORG

$PAGE PRPGE $LINE1,133,60

$PAGE2 PRPGE $LINE2,133,59

$PAGE3 PRPGE $LINE3,133,59

$PAGE4 PRPGE $LINE4,133,63,NUMTITL=0

$PAGE7 PRPGE $LINE7,210,88

$PAGE8 PRPGE $LINE8,210,88

$PAGE9 PRPGE $LINE9,210,88

$PAGE10 PRPGE $LINE10,210,88

NULL1 DS 64X'DD'

LINE1 DS 2CL133,CL2

PAGE DS 59CL133

NULL2 DS 64X'DD'

LINE2 DS 2CL134

PAGE2 DS 59CL133

NULL3 DS 64X'DD'

LINE3 DS 2CL134

PAGE3 DS 59CL133

NULL4 DS 64X'DD'

LINE4 DS C '1'

PAGE4 DS 63CL133

LINE7 DS 2CL210

PAGE7 DS 88CL210

DS 64X'DD'

LINE8 DS 2CL210

PAGE8 DS 88CL210

DS 64X'DD'

LINE9 DS 2CL210

PAGE9 DS 88CL210

DS 64X'DD'

LINE10 DS 2CL210

PAGE10 DS 88CL210

DS 64X'DD'

WRITEDOC DS 0D

USING *,7

CLI FLAGDOC,C'N' Q. DO WE PRINT DESCRIPTION,

BER BR NO, EXIT.

LM 2,6,DOCADDRS

DOCMVC EX 5,DOCMVC1

EX 5,DOCMVC2

LA 8,DOCDCBS

L 9,0(8)

DOCPUT PUTOPEN (9),(4)

MVI DOCLINE,C' '

LA 8,4(8)

L 9,0(8)

LTR 9,9

BNZ DOCPUT

AR 2,6

AR 3,6

C 2,DOCADDRS+4

BL DOCMVC

BR BR

DOCMVC1 MVC 01(0,4),0(2)

DOCMVC2 MVC 67(0,4),0(3)

* REG= 2 3 4 5 6

DOCADDRS DC A(DOC,(ENDDOC-DOC)/124*62+DOC,DOCLINE,61,62)

DOCDCBS DC A(SYSUT1,SYSUT2,SYSUT3,SYSUT4,0)

LTORG

DOCLINE DC CL210'1'

DOC EQU *

DC CL62'THIS PROGRAM SOLVES A PUZZLE THAT WAS DESCRIBED IN SCIENTIFIC'

DC CL62'AMERICAN AS ''PENTIMINOES''. IT IS ALSO SOLD IN STORES AS '

DC CL62'(HEXED) AND (BRAIN DAMAGE). THE GENERAL DESCRIPTION OF IT IS:'

DC CL62'THERE ARE 12 PIECES THAT HAVE TO BE FITTED INTO A BOARD '

DC CL62'THAT IS 6 X 10. EACH OF THE PIECES OCCUPIES 5 SQUARES ON '

DC CL62'THE BOARD. IF YOU TAKE 5 INDIVIDUAL SQUARES, AND PUT THEM '

DC CL62'TOGETHER IN ALL OF THE POSSIBLE UNIQUE PATTERNS SO THAT YOU '

DC CL62'CANNOT ROTATE OR TURN OVER ONE PATTERN TO MAKE ANOTHER, '

DC CL62'THERE WILL BE 12 PATTERNS. TO GET ALL OF THE SOLUTIONS TO '

DC CL62'THE PUZZLE, THE BOARD IS REPRESENTED AS A BIT PATTERN, '

DC CL62'CONTAINING 60 BITS. THIS CAN BE LOADED IN AN EVEN-ODD '

DC CL62'REGISTER PAIR. PIECES CAN THEN BE REPRESENTED AS BIT '

DC CL62'PATTERNS ALSO, AND AS PIECES ARE PLACED ON THE BOARD, THE '

DC CL62'CORRESPONDING BITS ARE TURNED ON IN THE REGISTERS. WHEN '

DC CL62'ALL OF THE PIECES HAVE BEEN PLACED ON THE BOARD, A SOLUTION '

DC CL62'HAS BEEN FOUND. THIS IS RECORDED, THEN A PIECE OR TWO IS '

DC CL62'REMOVED, AND A DIFFERENT SOLUTION IS ATTEMPTED BY TURNING '

DC CL62'THE PIECES OVER, OR ROTATING THEM. TO ACCOMPLISH ALL THIS, '

DC CL62'SEVERAL PROBLEMS HAD TO BE WORKED OUT. '

DC CL62' FIRST, IT IS NECESSARY TO DESCRIBE HOW THE PIECES ARE '

DC CL62'KEPT, AND HOW THEY ARE SELECTED. THIS IS DONE WITH 2 '

DC CL62'TABLES, THE ''PIECE'' TABLE, AND THE ''INDEX'' TABLE. EACH '

DC CL62'CONSISTS OF 12 MAJOR ENTRIES, WITH MINOR ENTRIES WITHIN '

DC CL62'EACH MAJOR ENTRY. EACH ENTRY IN THE PIECE TABLE DESCRIBES '

DC CL62'ALL OF THE WAYS A PIECE CAN BE ORIENTED TO FIT ONTO THE '

DC CL62'PUZZLE BOARD. THE PIECE THAT IS SHAPED LIKE A ''+'' CAN '

DC CL62'ONLY HAVE ONE ORIENTATION, SINCE ROTATING IT, OR TURNING IT '

DC CL62'OVER DOES NOT CHANGE THIS. THE PIECE SHAPED LIKE A ''U'' '

DC CL62'CAN HAVE 4 POSSIBLE ORIENTATIONS, CORRESPONDING TO FOUR '

DC CL62'90 DEGREE ROTATIONS. TURNING THE PIECE OVER DOES NOT CHANGE '

DC CL62'THE SHAPE. THE PIECE SHOWN AT THE RIGHT HAS EIGHT '

DC CL62'POSSIBLE SHAPES, FOUR ROTATIONS ON EACH SIDE. EACH XXX '

DC CL62'OF THESE ROTATIONS IS DESCRIBED IN THE ENTRY FOR XXX '

DC CL62'THIS PIECE. EACH OF THE 12 ENTRIES IN THE TABLE X '

DC CL62'COMPLETELY DESCRIBES A PIECE. THE PIECES ARE LOADED '

DC CL62'INTO THE PIECE TABLE FROM CONTROL CARDS IN THE SYSIN FILE. '

DC CL62'PART OF THE INITIALIZATION PROCESS READS THIS FILE, AND '

DC CL62'MAKES UP THE BIT PATTERNS FROM THE CONTROL INFORMATION. '

DC CL62' THE OTHER MAJOR TABLE IS THE INDEX TABLE. IT IS USED TO '

DC CL62'SELECT PIECES IN ORDER, TO INSURE THAT ALL PIECES ARE TRIED '

DC CL62'IN ALL POSSIBLE LOCATIONS, BUT THAT NO PIECE IN INCORRECTLY '

DC CL62'TRIED TWICE IN THE SAME LOCATION. THIS WILL BE DESCRIBED '

DC CL62'IN MORE DETAIL LATER. '

DC CL62' NEXT, LOOK AT THE TABLE. THIS IS THE '

DC CL62'LOGICAL CONCEPT OF HOW THE BOARD IS LAID 54 55 56 57 58 59 '

DC CL62'OUT. PIECES ARE BIT PATTERNS (5 BITS 48 49 50 51 52 53 '

DC CL62'PER PIECE) AND EACH PATTERN IS SET UP 42 43 44 45 46 47 '

DC CL62'TO USE POSITION 00 (AND 4 OTHER HIGHER 36 37 38 39 40 41 '

DC CL62'POSITIONS). AS EACH PIECE IS ADDED TO 30 31 32 33 34 35 '

DC CL62'THE TABLE, THE BITS FOR THE POSITION 24 25 26 27 28 29 '

DC CL62'IT OCCUPIES ARE TURNED ON. TO TEST TO 18 19 20 21 22 23 '

DC CL62'DETERMINE IF A PIECE FITS, THE BOARD SO 12 13 14 15 16 17 '

DC CL62'FAR IS ANDED WITH THE BIT PATTERN FOR 06 07 08 09 10 11 '

DC CL62'THE PIECE, AND IF NONE OF THE POSITIONS 00 01 02 03 04 05 '

DC CL62'OVERLAP THE PIECE FITS (MAYBE). EACH '

DC CL62'TIME A PIECE IS ADDED TO THE BOARD, THE PROGRAM CALCULATES '

DC CL62'THE FIRST EMPTY LOCATION (STARTING FROM 00) AND THE NEXT '

DC CL62'PIECE WILL BE ADDED USING THIS LOCATION. THUS NO EMPTY '

DC CL62'POSITIONS WILL BE LEFT AS THE BOARD IS FILLED UP. FOR '

DC CL62'EXAMPLE, IF 12 WAS THE FIRST EMPTY LOCATION, EACH PIECE '

DC CL62'WOULD BE LOADED INTO A REGISTER, AND SHIFTED UP 12 PLACES '

DC CL62'(BITS), THEN TESTED TO DETERMINE IF IT FIT ON THE BOARD. '

DC CL62'ASSUMING THAT IT DID FIT, THERE IS STILL ONE POSSIBLE '

DC CL62'PROBLEM, THE PIECE MIGHT HANG OFF THE EDGE OF THE BOARD. '

DC CL62'WHILE THIS IS EASILY APPARENT VISUALLY, IT TAKES A LITTLE '

DC CL62'LONGER IN THE PROGRAM. THE BIT PATTERN FOR THE PIECE IN THE '

DC CL62'LOCATION IT IS TO BE USED, IS TESTED TO DETERMINE IF IT IS '

DC CL62'ADJCENT TO THE LEFT EDGE, AND THEN THE RIGHT EDGE. IF THE '

DC CL62'PIECE TOUCHES BOTH EDGES, IT MUST HANG OFF THE EDGE OF THE '

DC CL62'BOARD, SINCE NO PIECE IS BIG ENOUGH TO BE ADJCENT TO BOTH '

DC CL62'EDGES SIMULTANEOUSLY. ALSO, DURING THE INITIAL SET UP, THE '

DC CL62'HIGHEST LOCATION EACH PIECE CAN OCCUPY IS DETERMINED, AND '

DC CL62'NO PIECE IS ATTEMPTED TO BE USED IN SUCH A FASION THAT IT '

DC CL62'HANGS OVER THE TOP OF THE BOARD. '

DC CL62' AS PIECES ARE ADDED TO THE BOARD, THEY ARE MARKED AS USED '

DC CL62'AND ARE NOT USED AGAIN. AS THE BOARD IS FILLED UP, IT '

DC CL62'OFTEN HAPPENS THAT THE REMAINING PIECES WON''T FIT IN THE '

DC CL62'SPACE LEFT. WHEN THAT HAPPENS THE LAST PIECE INSERTED IS '

DC CL62'REMOVED, BY (A) TURNING OFF THE BITS FOR THE POSITION THE '

DC CL62'PIECE OCCUPIED, AND (B) MARKING THE PIECE USEABLE AGAIN. '

DC CL62' MARKING THE PIECE USABLE OR UNUSEABLE, AND KEEPING TRACK '

DC CL62'OF WHICH PIECES HAVE BEEN USED WHERE IS THE FUNCTION OF THE '

DC CL62'INDEX TABLE. THE 12 MAJOR ENTRIES DEFINE THE ORDER THAT '

DC CL62'PIECES WERE PUT ON THE BOARD (IE. THE FIRST ENTRY TELLS '

DC CL62'WHICH PIECE WAS PLACED ON THE BOARD FIRST, THE SECOND ENTRY '

DC CL62'THE SECOND PIECE, ETC.). EACH INDEX TABLE ENTRY POINTS TO '

DC CL62'A PIECE TABLE ENTRY. THE PROGRAM WORKS THRU THE INDEX '

DC CL62'TABLE TO TRY TO ADD PIECES TO THE PUZZLE. WHEN A PIECE IS '

DC CL62'FOUND TO NOT FIT, THE ENTRY FOR IT IS SWAPPED IN THE INDEX '

DC CL62'TABLE. THE SWAPPING LOGIC INSURES THAT ALL OF THE PIECES '

DC CL62'ARE TRIED IN ALL POSSIBLE POSITIONS. THIS IS ACCOMPLISHED '

DC CL62'BY TRYING PIECES IN EVERY POSSIBLE ORDER, WHICH IS DONE BY '

DC CL62'USING A TRIPLE LOOP. WITHIN THE 2 OUTER LOOPS, THE '

DC CL62'ADDRESSES IN THE INDEX TABLE ARE SWAPPED, AND THE INNER '

DC CL62'LOOP RUNS THRU THE VARIOUS ROTATIONS OF EACH PIECE. THE '

DC CL62'SWAPPING LOGIC IS, IN THE OUTER LOOP, EACH PIECE IS SWAPEDD '

DC CL62'WITH THE FIRST PIECE. THE NEXT LOOP CAUSES EACH PIECE TO '

DC CL62'THE RIGHT OF THE PIECE IN LOOP 1 TO BE SWAPPED WITH IT. '

DC CL62'AFTER EACH SWAP, PIECES ARE TESTED TO DETERMINE IF THEY FIT '

DC CL62'INTO THE PUZZLE. THE SWAPPING IS ONLY DONE WHEN PIECES ARE '

DC CL62'NOT IN THE CURRENT SOLUTION. '

DC CL62'THIS PROGRAM EXECUTED IN 22 MINUTES ON THE IBM-370(195), '

DC CL62'23 MINUTES ON AN IBM 370(168 MOD3), 11 MINUTES ON A 3033, '

DC CL62'6 1/4 MINUTES ON A 3081 AND 3 1/2 MINUTES ON A 3090. '

DC CL62' '

DC CL62'THE PARM FIELDS THAT CAN BE SPECIFIED ARE, '

DC CL62'PARM=NODOC SURPRESSES THIS PROGRAM DESCRIPTION. '

DC CL62'PARM=ESTAE INTERCEPTS ABENDS, PRINTS THE ABEND CODE, '

DC CL62' NEXT INSTRUCTION ADDRESS, AND REGISTERS. '

DC CL62'PARM=CHECK CAUSES THE ROUTINE TO CHECK FOR DUPLICATE '

DC CL62' SOLUTIONS TO BE EXECUTED. '

DC CL62'PARM=NOWTO SUPRESSES THE WTO NOTIFICATION TO THE OPERATOR '

DC CL62' WHICH INDICATE HOW FAR ALONG IN THE PROCESS '

DC CL62' WE ARE. '

DC CL62'SKIPCOL=30 NONE BLANK IN COL-30 SHOULD BE SKIPPED. '

DC CL62' 30,31,32 IN COLS 30,31,32 SHOULD BE SKIPPED. '

DC CL62' '

*DC CL62' - - '

BYLINE DC CL62'DESIGNED AND WRITTEN BY ALPHRED E. NEWMAN'

DC CL62' '

ENDDOC EQU *

DCBD DSORG=PS,DEVD=DA

IHASDWA

END