A
AGO .START
THIS PROGRAM IS RIGHT AT THE 4K BOUNDARY.
IF YOU WAMT TO MAKE CHANGES, AND STILL USE THE 4K ALIGNMENT,
WHICH I FIND USEFUL FOR TESTING, YOU'LL NEED ANOTHER BASE REG,
AND YOU WANT TO CHECK THE ALIGNMENT.
IT'S PROBABLY CORRECT AT 8K, BUT LOOKING DOESN'T HURT.
R13 IS THE BASE REG, AND I HAVEN'T USED R12, JUST IN CASE.
SO IT IS AVAILABLE.
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZA
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZA
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\PENTOMINOES.PIECES.TXT
SET INIT=%G%.INIT.TXT
SET INIT2=%G%.INIT2 .TXT
SET INIT2N=%G%.INIT2N.TXT
SET PIECES=%G%.PIECES.TXT
BAT\ASMLG %G%.MLC TIME(1)
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\OLD.PIECES.NEW.TXT
/7X06 10X6
-0001020304 #1
10006121824
M
80006070809 #2
-----------------------------------------------------------
*
* $ DSECT 0
* DS XL4 NXNN
* DS XL4 WIDTH
* DS XL4 LENGTH
* DS XL4 WIDTHX
* DS XL4 LENGTHX
* ORG $
* $CHAR DS 0CL1
* $ROTATID DS CL4
* $BOARD DS XL8
* $VALID DS XL8
* $MIN DS F
* $MAX DS F
* ORG
* *
* $ DSECT 0
* DS CL2
* $DEF DS CL10,CL4 PIECE DEF/LOC
* $BITMAP DS D BIT MAP OF PIECE
* $VALID DS D VALID START LOCATIONS OF PIECE/ROTATION
* *
* $LOW DS F
* * $HIGH DS F
* *
* $IMAGE DS CL25 PRINT IMAGE
* *
* $PRIOR DS A ADDR OF PRIOR BOARD MAP
* $CURRBD DS 2F CURR BOARD BITS USED
* $CURRIMG DS CL60 PRINT IMAGE OF CURRENT
* *
* L$ EQU *-$
* LL$ EQU 12*8*L$+L$
*
-----------------------------------------------------------
.START ANOP
* -----------------------------------------------------------
MACRO
$$LA &R,&FROM
AIF ('&FROM'(1,1) EQ '(').LR
LA &R,&FROM
MEXIT
.LR LR &R,&FROM
MEND
*
MACRO
&LBL CLRZ &LOC,&LEN
&LBL LR 14,13
SR 15,15
$$LA R0,&LOC
$$LA R1,&LEN
MVCL (0),(14)
MEND
*
MACRO
&LABEL ERR &BC,&TEXT
&LABEL REVB &BC,SYS&SYSNDX
WTO &TEXT
EX 0,*
SYS&SYSNDX DS 0H
MEND
*
* LCLA &A
* GBLA &ERR
* LCLC &SYS
* &A SETA K'&TEXT-3
* &ERR SETA 1+&ERR
* &SYS SETC 'SYS&ERR'
* .* DC C'&A &ERR &SYS '
* &LABEL REVB &BC,&SYS
* .* STM 0,15,ERRREGS
* BAL R14,ABEND ERR
* DC AL1(&A),C&TEXT
* .* DC AL1(&ERR,&A),C&TEXT
* &SYS DS 0H
* MEND
*
* MACRO
* &LABEL ERR &BC,&TEXT
* LCLA &A
* GBLA &ERR
* LCLC &SYS
* &A SETA K'&TEXT-3
* &ERR SETA 1+&ERR
* &SYS SETC 'SYS&ERR'
* .* DC C'&A &ERR &SYS '
* &LABEL REVB &BC,&SYS
* .* STM 0,15,ERRREGS
* BAL R14,ABEND ERR
* DC AL1(&A),C&TEXT
* .* DC AL1(&ERR,&A),C&TEXT
* &SYS DS 0H
* MEND
* -----------------------------------------------------------
MACRO
&LABEL REVB &COND,&TO
LCLC &C,&B
LCLA &LEN
AIF ('&COND' NE 'B').ADDREM
&LABEL NOP &TO
MEXIT
.ADDREM ANOP
&LEN SETA K'&COND
AIF ('&COND'(2,1) NE 'N').ADD
&B SETC '&COND'(3,&LEN-2)
AGO .DOIT
.ADD ANOP
&B SETC '&COND'(2,&LEN-1)
&B SETC 'N&B'
.DOIT ANOP
&LABEL B&B &TO
MEND
* -----------------------------------------------------------
MACRO
&L PUTP &DCB,&REC
&L LA 1,&REC
BAL 14,PUTPIECE
MEND
* -----------------------------------------------------------
* GBLA &TRAC
* &TRAC SETA 0
* GBLA &TRAC#
* &TRAC# SETA 10
* MACRO
* &LABEL TRAC
* GBLA &TRAC
* AIF (&TRAC EQ 0).Z
* GBLA &TRAC#
* &TRAC# SETA &TRAC#+1
* &LABEL STM 0,15,TRACREGS
* TR&TRAC# BAL R9,TRACE
* DC CL2'&TRAC#'
* LM 0,15,TRACREGS
* .Z MEND
* -----------------------------------------------------------
PUZA START 0
YREGS
USING *,13 ,12
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
* LA R12,4095
* LA R12,1(R12,R13)
*
B RESTART
DC 12F'0'
*
* NXNNLIST DC A(*),C' 3X20 4X15 5X12 6X10 '
NXNNLIST DC A(*),C' 6X10 5X12 4X15 3X20 '
RESTART BAL R9,GETMAIN
ZAP PIECE#,=P'0'
L R1,NXNNLIST
LA R1,5(R1)
MVC PARM(4),0(R1)
ST R1,NXNNLIST
CLI 0(R1),C'3'
BL ALLDONE
MVC DCBDDNAM-IHADCB+PIECES+6(1),0(R1)
* PIECES#
MVC NXNN,PARM
MVC MAXCOL,PARM
BAL R9,OPEN
MVC LINE(6),=C'PARM= '
MVC LINE+6(L'PARM),PARM
** MVC LINE+12(24),TESTZERO
PUT INIT,LINE-1
WTO MF=(E,LINE-5)
BAL R9,PUT2N2
MVC LINE,LINE-1
* LA R11,CARD
* LA R10,NXNN
* USING $,11
*
CONVNXNN IC R0,NXNN
N R0,=F'15'
ST R0,WIDTH
BCTR R0,0
ST R0,WIDTHX
PACK DW,NXNN+2(2)
CVB R0,DW
ST R0,LENGTH
BCTR R0,0
ST R0,LENGTHX
*
PUTP PIECES,IDMSG
MVC LINE,LINE-1
MVC LINE(4),NXNN
MVC LINE+4(20),WIDTH
*
PUTP PIECES,LINE
MVC LINE,LINE-1
B GET
* TESTZERO DC C'===>',4C' ',4X'00',4C'.',4X'01',C'<==='
* *
LGETMAIN DC A(3200,0) (48*62,0) 62*48 = ACCURATE
*
GETMAIN LM R2,R3,LGETMAIN
ST R3,APIECE
LTR R3,R3
BNZ CLRZ
LR R0,R2
ST R0,LTABLE
GETMAIN R,LV=(0)
LR R3,R1
ST R1,LGETMAIN+4
ST R1,ATABLE
ST R1,APIECE
LA R0,0(R1,R2)
SH R0,=H'50'
ST R0,ENDTABLE
CLRZ CLRZ (3),(2)
BR R9
*
PUTPIECE L R15,APIECE
MVC 0(48,R15),0(R1)
LA R15,48(R15)
MVI 0(R15),X'FF'
ST R15,APIECE
C R15,ENDTABLE
BLR R14
EX 0,*
*
ENDTABLE DC F'0'
LTABLE DC A(4000)
ATABLE DC A(0)
APIECE DC A(0,48)
* *
PUSH PRINT
PRINT NOGEN
USING IHADCB,2
CNOP 0,4
DCBLIST DC A(INIT,IN,INIT1,INIT2,INIT2N,PIECES,INIT,0)
OPEN LA R3,DCBLIST
MVC LINE,LINE-1
L R2,0(R3)
* OPEN (INIT,OUTPUT)
* B OPENUNPK
*
OPENLOOP MVC OPENMSG+5(8),DCBDDNAM
TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BO NEXTDCB
** CLC =C'IM ',DCBDDNAM
CLI DCBDDNAM+2,C' '
BE OPENIN
OPENOUT OPEN ((2),OUTPUT)
MVC OPENMSG+18(3),=C'OUT'
B OPENUNPK
OPENIN OPEN (IN,INPUT)
MVC OPENMSG+18(3),=C' IN'
OPENUNPK TM DCBOFLGS-IHADCB+INIT,DCBOFOPN
BZ NEXTDCB
UNPK OPENMSG+32(3),DCBRECFM(2)
TR OPENMSG+32(2),HEX-240
MVI OPENMSG+34,C','
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+42(5),DW+5(3)
MVC LINE(L'OPENMSG),OPENMSG
PUT INIT,LINE-1
NEXTDCB LA R3,4(R3)
L R2,0(R3)
LTR R2,R2
BNZ OPENLOOP
MVC LINE,LINE-1
BR R9
OPENMSG DC C'OPEN ........ FOR INPUT, RECFM=.., LRECL=.....'
POP PRINT
DROP 2
* ---------------------------
* MVC LINE+16(0),1(R14)
* ABEND IC R1,0(R14)
* EX R1,ABEND-6
* LA R14,0(R14)
* SR R14,R13
* ST R14,16(R13)
* MVC LINE(09),=C'ERROR AT '
* UNPK LINE+9(5),18(3,R13)
* TR LINE+9(4),HEX-240
* MVI LINE+13,C' '
* WTO MF=(E,ERRWTO)
* BAL R9,PUT2N2
* EX 0,*
* ---------------------------
*
* AIF (&TRAC EQ 0).NOTRAC
* TRACE#S DC C'0-34-78-BC-F'
* TRACREGS DC 16F'0',C' '
* TRACLINE DC CL132' '
* TRACE TM DCBOFLGS-IHADCB+TRACEOUT,DCBOFOPN
* BZ 2(R9)
* CLI FLAGTRAC,C'T'
* BNE 2(R9)
* MVC TRACLINE+5(2),0(R9)
* LA R0,0(R9)
* SR R0,R13
* ST R0,12(R13)
* UNPK TRACLINE+9(5),14(3,R13)
* TR TRACLINE+9(4),HEX-240
* MVI TRACLINE+13,C' '
* MVC TRACLINE+15(4),NXNN
* MVC TRACLINE+20(L'ROTATID),ROTATID
* MVC TRACLINE+30(12),CARD
* PUT TRACEOUT,TRACLINE
* MVC TRACLINE,TRACLINE-1
* MVC TRACLINE(8),=C'REGS 0-7'
* LA R3,TRACREGS
* LA R6,TRACE#S
* LA R4,4
* TRACLOOP LA R5,TRACLINE+9
* LA R2,4
* MVC TRACLINE+5(3),0(R6)
* LA R6,3(R6)
* TRACUNPK UNPK 0(9,R5),0(5,R3)
* TR 0(8,R5),HEX-240
* MVI 8(R5),C' '
* LA R3,4(R3)
* LA R5,9(R5)
* BCT R2,TRACUNPK
* PUT TRACEOUT,TRACLINE-1
* BCT R4,TRACLOOP
* MVC TRACLINE,TRACLINE-1
* MVC TRACLINE(9),=C'BOARDCHR='
* MVC TRACLINE+9(90),BOARDCHR
* PUT TRACEOUT,TRACLINE-1
* MVC TRACLINE(9),=C'VALIDCHR='
* MVC TRACLINE+9(90),VALIDCHR
* PUT TRACEOUT,TRACLINE-1
* MVC TRACLINE,TRACLINE-1
* B 2(R9)
* .NOTRAC ANOP
* ---------------------------
PUT2N PUT INIT2N,LINE-1
B PUT2RET
PUT2N2 PUT INIT2N,LINE-1
PUT2 PUT INIT2,LINE-1
PUT2RET MVC LINE,LINE-1
BR R9
* -------------------------------------
*
VALUES DC A(PIECEDEF),CL8'PIECEDEF'
DC A(FIRSTLOC),CL8'FIRSTLOC'
DC A(MAXWIDTH),CL8'MAX WID'
DC A(MAXLENG),CL8'MAX LENG'
DC A(MAXHEIGH),CL8'MAXHEIGH'
* DC A(HIGH),CL8'HIGH '
DC A(HIGHLOC),CL8'HIGHLOC '
DC A(MAXLENG),CL8'MAXLENG'
* DC A(WIDPIECE),CL8'WID PIEC'
DC A(WIDTH),CL8'WIDTH'
DC A(LENGTH),CL8'LENGTH'
DC X'FF'
* DC A(FIRSTLOC),CL8'FIRSTLOC'
* DC A(MAXWIDTH),CL8'MAXWIDTH'
* DC A(HILIMIT),CL8'HILIMIT '
* DC A( ),CL8' '
* DC A( ),CL8' '
* DC A( ),CL8' '
* -------------------------------------
* SORRY FOR STUPID STUFF.
* HAD AN ERROR IN THE COMPRESS RTN
* AND WASDOVERLAYING STUFF. TOOK ME A BIT TO FIND IT.
*
DS 0F
NXNN DC CL4' '
PIECEDEF DC CL10' ',10C'%',10C'#'
ROTATID DC CL4' ',CL12'BOARD,VALID='
BOARD DC XL8'0'
VALID DC XL8'0',8C'$'
* BOARD STATISTICS.
WIDTH DC F'0' 3,4,5,6
LENGTH DC F'0' 10,12,15,20
WIDTHX DC F'0'
LENGTHX DC F'0'
LRECL DC F'81'
* PIECE STATISTICS.
PARAMS DS XL40
FIRSTLOC DC F'0'
FIRSTWID DC F'0'
FIRSTLEN DC F'0'
HIGHLOC DC F'0'
MAXWIDTH DC F'0'
MAXLENG DC F'0'
MAXHEIGH DC F'0'
HILIMIT DC F'0'
*
* HIGH DC F'0'
* WIDPIECE DC F'0'
*
*
MINWIDTH DC F'0'
MINLENG DC F'0'
LASTLINE DC F'0'
LPARAMS EQU *-PARAMS
DC CL4'END'
DC A(*-NXNN)
* -------------------------------------
*
DC C'.'
BOARDCHR DC 2CL60' '
DC C','
VALIDCHR DC 2CL60' ' SETVERT RTN USES EXTRA
*
MAXCOL DC C'5'
DW DC 4D'0'
*
PIECE# DC PL2'0'
PUTSEPAR PUT INIT,SEPAR FOUND "M" SEPARATOR
AP PIECE#,P1
OI PIECE#+1,X'0F'
UNPK CARD+13(3),PIECE#
MVI CARD+13,X'40'
MVC ROTATID,CARD+13
MVI ROTATID+3,X'C0'
PUTM PUT INIT,CARD
PUT INIT2,CARD
GET IN,CARD
CLC SPACES(4),CARD
BE PUTM
B GOT
*
TOOWIDE PUT INIT2N,CARD PIECE WIDER THAN BOARD
GET MVC CARD,CARD-1
GET IN,CARD
GOT CLI CARD,C'M'
BE PUTSEPAR
CLC =C'//',CARD
BE Z
CLC SPACES(2),CARD
BE GET
MVC 12(10,R13),CARD+2
NC 12(10,R13),CHARZERO
CLC 12(10,R13),CHARZERO
BE GOODCARD
MVC WTOBADC+8+20(12),CARD
WTOBADC WTO 'BAD PIECE DEF CARD ' <=== BAD CARD
EX 0,*
CHARZERO DC 10C'0'
GOODCARD LA R14,CARD+2
LA R15,PIECEDEF
LA R0,10
SR R1,R1
*
* PIECE LOCATIONS 1-NN ARE CODED IN PIECE DEFINITIONS.
* CONVERT PIECE LOCATIONS TO PIECE OFFSETS 0-NN-1
* THIS WAS ORIGINALLY CODED, BUT SPECIFYING LOCATIONS
* RATHER THAN OFFSETS WAS EASIER TO THINK ABOUT.
*
QOFFSET IC R1,0(R14)
BCTR R1,0
STC R1,0(R15)
LA R14,1(R14)
LA R15,1(R15)
BCT R0,QOFFSET
*
MVC CARD+12(L'CARD-12),SPACES
MVC CARD+20(10),PIECEDEF
SR R15,R15
IC R15,ROTATID+3
LA R15,1(R15)
STC R15,ROTATID+3
MVC CARD+13(4),ROTATID
PUT INIT,CARD
*
CLI CARD+2,C'0'
BL GET
WTO MF=(E,CARD-6)
* -------------------
MVC 12(10,R13),PIECEDEF
NC 12(10,R13),TEN00000
CLC 12(10,R13),TEN00000
BE ANAL
ERR B,'NON NUMERIC PIECE DEFINITION'
TEN00000 DC 10C'0'
* -------------------
* THIS SECTION CREATES THE PRINTABLE PIECE,
* TO MAKE SURE THAT THE DEFINITIONS ARE CORRECT.
*
ANAL MVC BOARDCHR,BOARDCHR-1
MVC VALIDCHR,VALIDCHR-1
MVI PARAMS,0
MVC PARAMS+1(LPARAMS-1),PARAMS
LA R2,PIECEDEF
LA R0,5
* TRAC
LOADLOOP CLC 1(1,R2),MAXCOL
BH TOOWIDE
*
IC R6,0(R2) LINE #, 1, 2, 3, 4, 5
IC R7,1(R2) DISPLACEMENT IN LINE 1-5
N R6,=F'7'
N R7,=F'7'
*
LR R14,R6
MH R14,WIDTH+2
AR R14,R7
STH R14,10(R2)
*
C R0,=F'5'
BNE *+8
ST R7,FIRSTLOC
*
C R7,MAXWIDTH
BNH *+8
ST R7,MAXWIDTH
C R6,MAXLENG
BNH *+8
ST R6,MAXLENG
LR R1,R6
MH R1,WIDTH+2
AR R1,R7
C R1,HIGHLOC
BNH *+8
ST R1,HIGHLOC
A R1,=A(BOARDCHR)
MVI 0(R1),C'X'
* TRAC
LA R2,2(R2)
BCT R0,LOADLOOP
LA R1,59
S R1,HIGHLOC
ST R1,MAXHEIGH
* ---------------
LA R2,BOARDCHR PRT PIECE
L R3,WIDTHX
L R4,LENGTH
MVC LINE(1),0(R2)
MVCPIECE EX R3,*-6
PUT INIT1,LINE-1
LA R2,1(R2,R3)
BCT R4,MVCPIECE
MVC LINE,LINE-1
PUT INIT1,LINE-1
* TRAC
MVC VALIDCHR,VALIDCHR-1
* ---------------------------------------------------
L R3,MAXLENG SET TOP EXCLUDED LOCS
LTR R3,R3 FOR THE PIECE BASE.
BZ NOTTOP ONLY THE ----- WILL APPLY
LA R2,VALIDCHR+60
S R2,WIDTH
L R1,WIDTHX
MVC 0(0,R2),=C'TTTTTT'
EX R1,*-6
S R2,WIDTH
BCT R3,*-8
* TRAC
NOTTOP DS 0H
* ---------------
L R2,FIRSTLOC SET RIGHT EXCLUDED LOCX
LTR R0,R2 FOR THE PIECE BASE.
BZ NOTRIGHT THERE WILL NOT BE A LOT
LA R3,VALIDCHR
RIGHTLOP LR R4,R3
MVI 0(R4),C'R'
A R4,WIDTH
C R4,=A(VALIDCHR+60)
BL RIGHTLOP+2
LA R3,1(R3)
BCT R2,RIGHTLOP
* TRAC
NOTRIGHT DS 0H
* ---------------
L R2,MAXWIDTH SET LEFT EXCLUDED LOCATIONS
LTR R2,R2
BZ NOTLEFT
S R2,FIRSTLOC Q. BASE LOC ALL THE WAY LEFT?
BZ NOTLEFT YES, NOTHING TO DO.
LA R3,VALIDCHR
A R3,WIDTHX
LA R0,VALIDCHR+60
NEXTCOL LR R4,R3
MVI 0(R4),C'L'
A R4,WIDTH
CR R4,R0
BL *-10
BCTR R3,0
BCT R2,NEXTCOL
* TRAC
NOTLEFT DS 0H
* ---------------
*
LA R2,BOARDCHR+60 SHOW PIECES
S R2,WIDTH
L R3,WIDTHX LENGTH OF LINE TO LIST
LA R4,VALUES
MVC LINE(0),0(R2)
MVCBCHAR EX R3,*-6
MVC LINE+8(0),VALIDCHR-BOARDCHR(R2)
EX R3,*-6
CLI 0(R4),0
BH PUTVALU
*
MVC LINE+16(8),4(R4)
L R1,0(R4)
CLI 0(R1),0
BE REP##
MVC LINE+25(16),0(R1)
B PUTVALU-4
*
REP## L R0,0(R1)
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+25(3),DW+6(2)
LA R4,12(R4)
PUTVALU PUT INIT2,LINE-1
MVC LINE,LINE-1
S R2,WIDTH
C R2,=A(BOARDCHR-2)
BH MVCBCHAR
PUT INIT2,SEPAR
*
BCOMPRES LA R2,BOARDCHR
LA R3,BOARD
MVI COMPTYPE,C'B'
* TRAC
BAL R9,COMPRESS
* TRAC
LA R2,VALIDCHR
LA R3,VALID
MVI COMPTYPE,C'V'
* TRAC
BAL R9,COMPRESS
BAL R9,SHIFTREC
* TRAC
*
MAKEREC MVC LINE(4),ROTATID
MVC LINE(1),CARD+1
MVC LINE+4(16),BOARD
MVC LINE+20(4),FIRSTLOC
MVC LINE+24(4),MAXHEIGH
MVC LINE+28(20),PIECEDEF
*
PUTP PIECES,LINE
*
MVC LINE,LINE-1
* TRAC
B GET
* ---------------
*
* SHIFT THE BOARD SO THAT LOC-1 IS NOT ZERO.
* THIS WILL MAKE FITTING PIECES EASIER IN PUZB
SHIFTREC L R1,FIRSTLOC
LTR R1,R1
BZR R9
LM R14,R15,BOARD
STM R14,R15,16(R13)
SRDL R14,1
BCT R1,*-4
STM R14,R15,BOARD
STM R14,R15,24(R13)
BR R9
*
* YOU CAN'T PUT THE STARTING SQUARE ANYWHERE AT ALL IN THE BOARD.
* THE NEXT 4 SQUARES GO ABOVE IT.
* SO YOU HAVE TO INVALIDATE STARTING LOCATIONS THAT WOULD PUT
* PARTS OF THE PIECE OUTSIDE OF VALID PUZZLE LOCATIONS.
*
* IF A PIECE STARTS AT 0,0 THEN WE'RE GOOD.
* OTHERWISE, HAVE TO MARK LOW LOCATIONS AS INVALID.
*
COMPRESS SR R4,R4
SR R5,R5
LA R15,59(R2) PLACE TO PUT BIT
LA R14,PIECEDEF
LA R0,60
XC 0(8,R3),0(R3)
COMPLOOP CLI 0(R15),C'A'
BL COMPSLDL
O R5,=F'1'
CLI COMPTYPE,C'B'
BNE COMPSLDL
IC R1,0(R14)
N R1,=F'15'
MH R1,LRECL+2
IC R6,1(R14)
N R6,=F'15'
AR R1,R6
STH R1,20(R14)
*
* BCTR R1,0
* STH R1,10(R14)
* LA R1,1(R1)
LA R14,2(R14)
COMPSLDL SLDL R4,1
BCTR R15,0
BCT R0,COMPLOOP
SRDL R4,1
STM R4,R5,0(R3)
BR R9
COMPTYPE DC C' '
*
* MVC LINE(1),0(R2)
* LISTBOAR MVC LINE,LINE-1
* MVC LINE+15(10),PIECEDEF
* MVC LINE+27(3),ROTATID+1
* ** L R3,WIDTHX LENGTH OF LINE TO LIST
* ** LA R4,5 WIDTH # TIMES THRU LIST LOOP
* LISTBEX EX R3,LISTBOAR-6
* PUT INIT1,LINE-1
* MVC LINE,LINE-1
* LA R2,1(R2,R3)
* BCT R4,LISTBEX
* PUT INIT1,SEPAR
* BR R9
*
* ==========================================
Z L R0,ATABLE
PUT PIECES,(0)
L R0,APIECE
S R0,ATABLE
CVD R0,DW
OI DW+7,X'0F'
MVC LINE(17),=C'PIECE REC LENGTH='
UNPK LINE+17(5),DW+5(3)
PUT INIT,LINE-1
WTO MF=(E,LINE-5)
MVC LINE,LINE-1
* LM R0,R1,LTABLE
* FREEMAIN R,LV=(0),A=(1)
LA R2,=A(IN,PIECES,0)
BAL R9,ZCLOSE
MVI LINE,C'='
MVC LINE+1(44),LINE
PUT INIT,LINE-1
MVC LINE,LINE-1
B RESTART
*
ZCLOSE L R3,0(R2)
TM DCBOFLGS-IHADCB(R3),DCBOFOPN
BZ ZCLO
CLOSE ((3))
MVC LINE(8),DCBDDNAM-IHADCB(R3)
MVC LINE+8(7),=C' CLOSED'
TM DCBOFLGS-IHADCB+INIT,DCBOFOPN
BZ ZCLO
PUT INIT,LINE-1
ZCLO LA R2,4(R2)
L R3,0(R2)
LTR R3,R3
BNZ ZCLOSE
MVC LINE,LINE-1
BR R9
*
ALLDONE LA R2,DCBLIST+4
BAL R9,ZCLOSE
* Z CLOSE (IN,,INIT,,INIT1,,INIT2,,INIT2N)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
*
ZZZ WTO 'END OF FILE // MISSING ON IN FILE'
EX 0,*
LTORG
FLAGTRAC DC C' '
IDMSG DC CL38'PUZA, ASM &SYSDATE AT &SYSTIME'
P1 DC X'1C'
HEX DC C'0123456789ABCDEF '
PARM DC CL40' '
* MRRWTO DC H'64,0',C' ABEND AT '
DC H'30,0',C' '
LINE DC CL080' '
SEPAR DC C' ----------------------------- '
SPACES DC CL080' '
PUSH PRINT
PRINT NOGEN
DS 0D
IN DCB DDNAME=IN,DSORG=PS,EODAD=ZZZ,MACRF=GM,LRECL=80,RECFM=FT
DS 0D
INIT DCB DDNAME=INIT,DSORG=PS,LRECL=80,RECFM=FT,MACRF=PM
DS 0D
PIECES DCB DDNAME=PIECES,DSORG=PS,LRECL=3200,RECFM=F,MACRF=PM, X
BUFNO=1
INIT1 DCB DDNAME=INIT1,DSORG=PS,LRECL=080,RECFM=FT,MACRF=PM
TRACEOUT DCB DDNAME=TRACEOUT,DSORG=PS,LRECL=080,RECFM=FT,MACRF=PM
INIT2 DCB DDNAME=INIT2,DSORG=PS,LRECL=080,RECFM=FT,MACRF=PM
DS 0D
INIT2N DCB DDNAME=INIT2N,DSORG=PS,LRECL=080,RECFM=FT,MACRF=PM
POP PRINT
*
CNOP 2,8
DC H'24,0',C' '
CARD DC CL80' '
*
* DCBD DEVD=DA
*
@@PAD#1 EQU ((*-PUZA)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-PUZA)
ORG *+@@PAD#2
*
END PUZA
=====================================================================
AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZB
SET INFILE=%G%.I5.TXT
SET OUTFILE=%G%.OUTFILE.TXT
BAT\ASMLG %G%.MLC TIME(1) PARM('PRINT-9')
=========== CREATE FILE OF BREAK POINT COMMANDS. =================
C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZBB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZB
SET LISTING=%G%.PRN
SET ATFILE=%G%.BREAK.ATFILE.TXT
SET COMMANDS=%G%.BREAK.COMMANDS.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
--//SYSIN INPUT TO CREATE BREAKPOINT COMMANDS. ------------
LOADLOC=FF000 13R%
LABEL=FINDMAXN
LABEL=ZIN,MAIN,BUMPBASE,FIRSTBASE,NEXTBASE,TESTBASE,FOUND1,SABEPUZ
LABEL=QQBACK,BACKOUT,QQVALID,QVALID,QFIT,SAVEFIT,GETAIIEC,GETASPAC
LABEL=CLRPAGE,CLRINDX
LABEL=AGETMAIN,CARD,LINE,
COMMAND=
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZB ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZBT EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PUZBB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
-----------------------------------------------------------
* -----------------------------------------------------------
.START ANOP
*
MACRO
CLRZ &LOC,&LEN,&PAD=
$$LA R0,&LOC
$$LA R1,&LEN
LR 14,13
SLR 15,15
AIF (T'&PAD EQ 'O').MVCL
ICM 15,8,=&PAD
.MVCL MVCL (0),(14)
MEND
*
MACRO
$$LA &R,&FROM
AIF ('&FROM'(1,1) EQ '(').LR
LA &R,&FROM
MEXIT
.LR LR &R,&FROM
MEND
*
MACRO
&L GETP &FILE
L R1,APIECE INPUT BUFFER
LA R2,48(R1) NEXT ELEMENT IN INPUT BUFFRE
ST R2,APIECE SAVE FOR NEXT TIME
MEND
*
MACRO
W &TEXT
LCLA &LEN
&LEN SETA (K'&TEXT-3)
DC AL1(&LEN),C&TEXT
MEND
.*
MACRO
&LBL SAY &TEXT
&LBL BAL R1,SAY
DC PL6'0'
AIF ('&TEXT' NE '').DC
DC AL2(*-PUZB)
MEXIT
.DC DC CL8&TEXT
MEND
.*
.* *
.* LCLA &N
.* &N SETA K'&TEXT
.* &N SETA &N-1
.* &N SETA &N/2
.* &N SETA &N*2
.* BAL R1,WTO
.* DC AL2(&N+4,0),CL&N.&TEXT
.* MEND
.*
MACRO
ERRWTO &TEXT
LCLA &A
&A SETA K'&TEXT-2
MVC LINE(&A),=C&TEXT
WTO MF=(E,LINE-6)
MVC LINE,LINE-1
MEND
PUZB START 0
YREGS
DS 18F
DW DS 4D
ORG *-8
HW DS 4H
BOARD DS D
PRTTEST DS CL60
ORG PUZB
USING *,13,12
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
LA 12,4095
LA 12,1(12,13)
L R4,0(R1)
*
L R2,LGETMAIN
ST R2,LTABLE
GETMAIN R,LV=(2)
ST R1,LGETMAIN+4
LR R11,R1
USING DSECT,R11
CLRZ INDEX,(2)
*
LA R1,PAGE
LR R0,R1
LA R2,LLINE
AR R2,R1
STM R0,R2,APAGE
BAL R9,CLRPAGE
*
MVC LINE-8(8),=X'4040004800004040'
MVC LINE,LINE-1
MVC SPACES,SPACES-1
MVI SEPAR,C'='
MVC SEPAR+1(L'SEPAR-1),SEPAR
MVC WTO-8(8),LINE-8
MVC WTO,SPACES
*
LH R5,0(R4)
SH R5,=H'1'
BM OPEN
* MVC PARM(0),2(R4)
* EX R5,*-6
CLC =C'SAYSTOP=',2(R4)
BNE OPEN
SH R5,=H'9'
EX R5,PACKSAY#
AP SAYSTOP,P1
B OPEN
PACKSAY# PACK SAYSTOP,10(0,R4)
* B OPEN
* -----------------------------------------
* THERE ARE 62 PIECES/ROTATIONS FROM PUZA.
* 76 ALLOWS FOR THE PIECES + X'FF' AT THE END OF EACH SET.
* I'VE ALIGNED THEM ON A 125 BYTE BOUNDARY TO MAKE TESTING,
* LOOKING AT THE CONTENTS OF ENTRIES EASIER.
* ONE COULD CHANGE THAT LATER, BUT WHY BOTHER.
*
* THE LARGE TABLE CONTAINS ENTRIES FOR EACH OF THE 61 ROTATIONS
* OF THE 12 PIECES. + HAS ONLY 1. T HAS 4. L WOULD HAVE 4,
* BUT ONLY 1 IS DEFINED BECAUSE THAT ELIMINATES GETTING MIRROR
* IMAGES -- IE THE SAME SOLUTION, TURNED OVER OR ROTATED 180 DEGREES.
* THE INDEX TABLE IS INTERNALLY DEFINED, ON TOP OF THE "DOC" SECTION,
* BECAUSE IT'S SMALL AND THE SPACE IS FREE.
*
* BUT, THIS IS THE LARGE TABLE. FOR TESTING, I ALIGNED IT ON A 256
* BYTE BOUNDARY. IT'S ENTRY LENGTH IS SLIGHTLY MORE THAN 128 AND 256
* IS THE NEXT CONVENIENT SIZE. WORSE, I PUT IT ON A REALY 256 BYTE
* BOUNDARY SO PROGRAM OFFSETS EXACTLY MATCH LOCATIONS.
*
LISTDCBM DC C'........ OPENED FOR OUTPUT, RECFM=.., LRECL=.....'
PUSH USING,PRINT
USING IHADCB,2
PRINT NOGEN
OPENOUT MVC LISTDCBM(8),DCBDDNAM
OPEN ((2),OUTPUT)
B LISTDCB
OPENIN MVC LISTDCBM(8),DCBDDNAM
MVC LISTDCBM+20(3),=C' IN'
OPEN ((2),INPUT)
LISTDCB UNPK LISTDCBM+34(3),DCBRECFM-IHADCB(2,R2)
TR LISTDCBM+34(2),HEX-240
MVI LISTDCBM+36,C','
LH R0,DCBLRECL-IHADCB(R2)
CVD R0,16(R13)
OI 13(R13),X'0F'
UNPK LISTDCBM+44(5),21(3,R13)
POP USING,PRINT
MVC LINE(L'LISTDCBM),LISTDCBM
WTOLINE WTO MF=(E,LINE-6)
PUTLINE PUT OUTFILE,LINE-1
MVC LINE,LINE-1
BR R9
*
OPEN LA R2,OUTFILE
BAL R9,OPENOUT
LA R2,INFILE
BAL R9,OPENIN
*
SLR R8,R8
BAL R9,QINDEXM
*
LA R5,$$L
GET INFILE PUZA PGM-ID. NEXT. NXNN+++
LR R0,R1 ALL IE 1 SINGLE RECORD.
STM R0,R1,APIECE
MVC IDA,0(R1)
*
GETP INFILE NXNN, PUZZLE WIDTH, LEN, WID-1, LEN-1
LA R5,$$L(R5)
MVC NXNN(LNXNN),0(R2)
*
MVC LINE(LIDA),IDA
PUT OUTFILE,LINE-1
MVC LINE,LINE-1
MVC LINE(LIDB),IDB
MVC LINE+LIDB(4),NXNN
PUT OUTFILE,LINE-1
MVC LINE,LINE-1
*
SLR R5,R5
SLR R8,R8
LA R6,INDEX
L R7,ATABLE
MVC 0($L,R7),ZEROS
ZAP HW,=P'1'
ZAP HW+2,=P'0'
GETP INFILE FIRST PIECE, MUST BE "+"
LA R5,$$L(R5)
CLI 0(R2),C'+'
BE NEWPIECE+18
ERRWTO '+ PIECE MUST BE FIRST (JUST BECAUSE)'
EX 0,*
* ---------------- CREATE INDEX, LOAD ROTATIONS
USING $,R7
USING $INDEX,R6
*
NEWPIECE MVI 0(R7),X'FF' END OF PIECE
LA R7,$L(R7) BUMP ADDR IN TABLE
MVC 0(128,R7),ZEROS
LA R6,LINDEX(R6)
*
AP HW+2,P1
MVC HW+4,2(R2) SAVE ROTATID
MVC 0(LINDEX,R6),ZEROS
ST R7,0(R6) $INDEXR7
MVI 8(R6),X'FF'
LA R5,1(R5)
SAMEPIEC MVC 0(120,R7),ZEROS
MVC 0($$L,R7),0(R2) SAVE PASSED DATA
MVI $L(R7),X'FF'
LA R8,1(R8)
*
LM R0,R1,$$VALID
LA R2,VALCHAR
LA R15,60
*
* BOTH BOARD, AND VALID TABLES, 8 BYTES EACH, WERE PASSED.
* WE'RE GOING TO CREATE A CHARACTER VALID TABLE.
* THAT WILL MAKE THE 'VALID' TEST MUCH EASIER AND FASTER.
* BUT IT DID MAKE THE ROTATE DSECT 128 BYTES INSTEAD OF 64.
*
SETVAL LA R14,1
NR R14,R1
BZ *+8
MVI 0(R2),C'X'
LA R2,1(R2)
SRDL R0,1
BCT R15,SETVAL
*
**** MVC $$L($L-$$L,R7),ZEROS SAVE PASSED DATA
LA R7,$L(R7) POINT TO NEXT SLOT
MVI 0(R7),X'FF'
*
GETIN GETP INFILE GET NEXT ENTRY
LA R5,$$L(R5)
AP HW,=P'1' COUNT IT
LA R8,1(R8) TWICE - WHAT THE HECK
CLI 0(R2),X'FF' Q. END OF FILE/RECORD/TABLE
BE ZIN YEP
*
CLC HW+4(1),2(R2) Q. SAME ROTAT=ID PREFIX?
BE SAMEPIEC YES, SAME PIECE, NEXT ROTATION
B NEWPIECE
* -------------------------------------------
APIECE DC 2F'0'
*
LGETMAIN DC A(LDSECT,0)
*
LTABLE DC A(384*73)
ATABLE DC F'0'
ENDTABLE DC F'0'
*
LLINE EQU 80
DC A(22*80)
APAGE DC A(0,0,0)
DC H'53,0',C' '
INDTBL DC CL48' '
DC AL2(L'IM1+L'IM2+5,0),C' '
* --------------------------------------
*M1 DC C'INDEX=...... TO ...... LEN=...... PAG=...... TO ...... LEN=.X
* ..... '
*M2 DC C'TABLE=...... TO ...... LEN=...... GM=...... TO=...... LEN=.X
* ..... '
* --------------------------------------
DC AL2(L'IM1+5,0),C' '
IM1 DC C'INDEX=...... TO ...... LEN=...... TBL=...... TO ...... LEN=.X
..... '
DC AL2(L'IM2+5,0),C' '
IM2 DC C' PAGE=...... TO ...... LEN=...... GM=...... TO=...... LEN=.X
..... '
* --------------------------------------
*INDEXMSG DC C'INDEX=...... TO ...... LEN=...... TBL=...... TO ....X
* LEN=...... PAG=...... TO ...... LEN=...... GM=..... X
* TO ...... LEN=...... '
PRTINDT MVC LINE(L'INDTBL),INDTBL
QINDEXM LA R0,INDEX
L R2,=A(32*13)
LA R1,INDEX(R2)
STM R0,R2,20(R13) ---
*
LA R0,PAGE
LR R1,R0
LR R2,R1
LA R3,LLINE(R2)
S R3,WIDTH
STM R0,R1,APAGE
ST R3,APAGE+8
L R2,APAGE-4
AR R1,R2
STM R0,R2,44(R13) ---
*
LA R1,128(R1)
SRL R1,7
SLL R1,7
LR R0,R1
L R2,LTABLE
AR R1,R2
ST R0,ATABLE
STM R0,R2,32(R13) ---
*
L R2,LGETMAIN LENG
L R0,LGETMAIN+4 ADDRESS
LR R1,R2
AR R1,R0
STM R0,R2,56(R13) ---
*
LA R14,IM1+6
LA R15,20(R13)
LA R1,4
LA R0,3
QINDUNPK UNPK 0(7,R14),1(4,R15)
TR 0(6,R14),HEX-240
MVI 6(R14),C' '
LA R15,4(R15)
LA R14,11(R14)
BCT R0,QINDUNPK
*
C R1,=F'3' == LENGTH OF IM1 AND IM2 MUST BE ODD,
BNE *+8 == SO THAT THE BUMP BETWEEN MSGS WILL
LA R14,7(R14) == BE ACCURATE
BCT R1,QINDUNPK-4
*
* MVC LINE(68),INDEXMSG
* ST R9,DW
** BAL R9,WTOLINE
WTO MF=(E,IM1-5)
WTO MF=(E,IM2-5)
* MVC LINE+0(L'INDEXMSG-68),INDEXMSG+68
* BAL R9,WTOLINE
MVC INDTBL(24),IM1
MVC INDTBL+25(23),IM2
* L R9,DW
BR R9
* -------------------------------------------
DC AL2(L'LOADEDM+5,0),C' '
**ADEDM DC C' ... PIECE DEFINITIONS (OUT OF 60) LOADED FOR .... BOARD'
**ADEDM DC C' ... ROTATIONS OF ... PIECES (OUT OF 60+12) LOADED FOR
LOADEDM DC C' ..... BYTES LOADED FOR ... ROTATIONS OF ... PIECES (OUT X
OF 60+12) FOR BOARD'
ZIN OI HW+1,X'0F'
CLOSE INFILE
CVD R5,DW
OI DW+7,X'0F'
UNPK LOADEDM+1(5),DW+5(3)
UNPK LOADEDM+24(3),HW
OI HW+3,X'0F'
UNPK LOADEDM+41(3),HW+2
MVC LOADEDM+L'LOADEDM-10(4),NXNN
WTO MF=(E,LOADEDM-5)
MVC LINE(L'LOADEDM),LOADEDM
PUT OUTFILE,LINE
*
MVC PRTTEST,SPACES
MVC DW(32),ZEROS
MVC LINE,LINE-1
LA R6,LINDEX(R6)
ST R6,ENDINDEX
MVI 0(R6),X'FF'
MVI 0(R7),X'FF'
ST R7,ENDTABLE
*
* GOT PIECES LOADED INTO THE GETMAIN TABLE.
* INDEX TABLE SET UP INTO THE PIECE TABLE.
*
* NEXT, FOR ALL ROTATIONS OF EACH PIECE, SAVE THE HHGHEST POSSIBLE
* STARTING LOCATION. DURING PROCESSING, WHEN WE GET HERE,
* WE NOT ONLY STOP PLAYING WITH THIS PIECE, WE BACK OUT THE LAST
* ONE, BECAUSE THIS PIECE WILL NEVER FIT INTO THE PUZZLE SO FAR.
*
* SO FIND AND SAVE THE HIGHEST POSSLBLE LOCATION FOR ANY ROTATION
* OF THIS PIECE IN THE ENTRY FOR THE FIRST PIECE.
*
LA R6,INDEX
L R7,0(R6)
MVC NEWBOARD,$$BOARD
MVC FIRSTNDX,INDEX
FINDMAXM L R7,0(R6)
L R8,$$MAX
* Q678
LR R15,R7
*
FINDMAX C R8,$$MAX
BNH *+8
L R8,$$MAX
LA R7,$L(R7)
CLI 0(R7),X'FF'
BL FINDMAX
*
ST R8,$$MAXMAX-$(R15)
LA R6,LINDEX(R6)
C R6,ENDINDEX
BL FINDMAXM
* --------------------------------------
SR R8,R8
LA R6,INDEX
L R7,0(R6)
SAY
B BUMPINDX
RESTART BAL R9,RESET
BAL R9,CLRPAGE
ZAP SAYSTOP,P0
B TESTBASE
*
* EX R0,GETINDEX
* B FIRSTBAS SKIP THE + 'CAUSE CANNOT USE IT.
* -------------------------------------------
* DURING PROCESSING, THE MAIN TABLE WE LOADED WON'T CHANGE.
* THE INDEX TABLE GETS ROTATED 12 TIMES.
* THE FIRST WORD IS THE ADDRESS OF THE FIRST MAIN TABLE ENTRY.
* THE 2ND WORD IS THE ADDRESS OF THE PRIOR INDEX ENTRY USED
*
* WORDS 3, 4, AND 5 ARE REGS 6,7,8 THAT WERE USED TO PLACE THIS PIECE
* THEY'RE USED TO BACK THE PIECE OUT, BUMP ROTATION, AND TRY AGAIN.
* THE NEXT 8 BYTES ARE THE BOARD SO FAR.
* -------------------------------------------
* BUMPINDX = MOVE TOP INDEX ENTRY TO THE END,
* AND MOVE ALL THE REST UP 1 PLACE.
* WHEN THE TOP PIECE COMES BACK, WE'RE ALL DONE.
* -------------------------------------------
* R10 = # PIECES CURRENTLY IN THE BOARD.
* LAST 2 ARE SAVED AND RENEWED WITH EACH ROTATION
* THEY MIGHT HAVE TO BE MOVED TO EACH SOLUTION.
* -------------------------------------------
FIRSTNDX DC XL8'00'
BUMPINDX ZAP #PIECES,P1
MVC INDEX+LLINDEX(LINDEX),INDEX
LA R14,INDEX
LA R15,LLINDEX
LA R0,INDEX+LINDEX
LR R1,R15
MVCL (0),(14)
MVI LLINDEX+INDEX,X'FF'
*
* MVC INDEX+LLINDEX(LINDEX),INDEX
* MVC INDEX(256),INDEX+LINDEX
* MVC INDEX+256(256),INDEX+256+LINDEX
* MVC INDEX+512(LLINDEX-512),INDEX+512
* MVI LLINDEX+INDEX,X'FF'
*
RESET BAL R14,ROT#INIT
SAY 'RESET'
LA R6,INDEX
MVC SOLLIST-4,SOLLIST-8
L R7,0(R6)
TM $$BOARD+7,1
BNZ NEXTROT
B TESTROT
* ----------------------------------
SAYSTOP DC CL6' '
SAY# DC PL6'0'
SAY#C DC CL14' '
DC H'120,0',C' '
SAYLINE DC CL140' '
EDIT6 DC X'4020202020206B2020206B212020',CL14' '
LEDIT6 EQU *-EDIT6
CNOP 0,4
SAYBRK DC CL8'MAIN BACKUPTESTPA'
ST R0,12(R13)
SAYRGS DC X'60708090'
*
REPLY DC F'0'
ECB DC F'-1'
*
DC 4F'0'
SAY LA R1,0(R1)
STM R14,R1,SAY-16
* --------------------------------
* WTOR CLI DCB,X'FF'
* WTOR 'ENTER QUESTION',REPLY,4,ECB
* WAIT 1,ECB=DW
* OC REPLY,SPACES
*
* CLC 2(6,R1),SAYBRK
* BE SAYWTO
* CLC 2(6,R1),SAYBRK+6
* BE SAYWTO
* CLC 2(6,R1),SAYBRK+12
* BNE SAYNWTO
* SAYWTO WTO MF=(E,LINE-5)
* L R1,SAY-4
*
SAYNWTO CLI 6(R1),X'20'
BH SAYLBL
MVC SAYLINE(8),SPACES
UNPK SAYLINE+2(5),6(3,R1)
TR SAYLINE+2(4),HEX-240
MVI SAYLINE+6,C' '
B SAYLBL+6
*
SAYLBL MVC SAYLINE(8),6(R1)
*
UNPK SAYLINE+10(9),BOARD(5)
UNPK SAYLINE+18(9),BOARD+4(5)
MVI SAYLINE+26,C' '
TR SAYLINE+10(16),HEX-240
*
LA R15,SAYRGS
LA R14,SAYLINE+28
LA R0,L'SAYRGS
SAYLOOP MVI 0(R14),C'R'
MVI 2(R14),C'='
SR R1,R1
IC R1,0(R15)
** ST R0,12(R13)
EX R1,SAYRGS-4
SRL R1,4
IC R1,HEX(R1)
STC R1,1(R14)
UNPK 3(9,R14),12(5,R13)
TR 3(8,R14),HEX-240
MVI 11(R14),C' '
LA R14,12(R14)
LA R15,1(R15)
BCT R0,SAYLOOP
*
OI #PIECES+3,X'0F'
UNPK 2(3,R14),#PIECES+2(2)
*
AP SAY#,P1
MVC 6(LEDIT6,R14),EDIT6
EDMK 6(LEDIT6,R14),SAY#
LR R15,R1
** MVC 6(LEDIT6,R14),0(R1)
*
L R1,SAY-4
AP 0(6,R1),P1
MVC 08(LEDIT6,R15),EDIT6
EDMK 08(L'EDIT6,R15),0(R1)
MVC 08(L'EDIT6,R15),0(R1)
MVC 6(24,R14),0(R15)
** MVC 19(12,R14),0(R1)
** MVC SAY##-16(12),0(R1)
* --------------------------------
*
WTO MF=(E,SAYLINE-5)
CLC SAY#,SAYSTOP
BL SAYEXIT
EX 0,*
*
SAYEXIT LM R14,R1,SAY-16
CLI 6(R1),X'40'
BL 8(R1)
B 14(R1)
* -------------------------------------------
* -------------------------------------------
* SAYSTOP DC CL6' '
* SAY# DC PL6'0'
* SAY#C DC CL14' '
* DC H'120,0',C' '
* SAYLINE DC CL120' '
* EDITL6 DC X'4020202020206B2020206B212020',CL14' '
* LEDITL6 EQU *-EDITL6
* CNOP 0,4
* SAYBRK DC CL8'MAIN BACKUPTESTPA'
* ST R0,12(R13)
* SAYRGS DC X'60708090'
* *
* REPLY DC F'0'
* ECB DC F'-1'
* *
* DC 4F'0'
* SAY LA R1,0(R1)
* STM R14,R1,SAY-16
* * WTOR CLI DCB,X'FF'
* * WTOR 'ENTER QUESTION',REPLY,4,ECB
* * WAIT 1,ECB=DW
* * OC REPLY,SPACES
* CLC 0(6,R1),SAYBRK
* BE SAYWTO
* CLC 0(6,R1),SAYBRK+6
* BE SAYWTO
* CLC 0(6,R1),SAYBRK+12
* BNE SAYNWTO
* SAYWTO WTO MF=(E,LINE-5)
* L R1,SAY-4
* *
* SAYNWTO CLI 0(R1),X'39'
* BH SAYLBL
* MVC SAYLINE(8),SAYLINE-1
* UNPK SAYLINE+2(5),0(3,R1)
* TR SAYLINE+2(4),HEX-240
* MVI SAYLINE+6,C' '
* B SAYLBL+6
* *
* SAYLBL MVC SAYLINE(8),0(R1)
* *
* UNPK SAYLINE+10(9),BOARD(5)
* UNPK SAYLINE+18(9),BOARD+4(5)
* MVI SAYLINE+26,C' '
* TR SAYLINE+10(16),HEX-240
* *
* LA R15,SAYRGS
* LA R14,SAYLINE+28
* LA R0,L'SAYRGS
* SAYLOOP MVI 0(R14),C'R'
* MVI 2(R14),C'='
* SR R1,R1
* IC R1,0(R15)
* EX R1,SAYRGS-4
* SRL R1,4
* IC R1,HEX(R1)
* STC R1,1(R14)
* UNPK 3(9,R14),12(5,R13)
* TR 3(8,R14),HEX-240
* MVI 11(R14),C' '
* LA R14,12(R14)
* LA R15,1(R15)
* BCT R0,SAYLOOP
* *
* OI #PIECES+3,X'0F'
* UNPK 2(3,R14),#PIECES+2(2)
* *
* AP SAY#,P1
* MVC 12(LEDITL6,R13),EDITL6
* EDMK 12(L'EDITL6,R13),SAY#
* MVC SAY#C,0(R1)
* MVC 7(L'EDITL6,R14),SAY#C
* WTO MF=(E,SAYLINE-5)
* CLC SAY#,SAYSTOP
* BL *+8
* EX 0,*
* *
* SAYEXIT LM R14,R1,SAY-16
* CLI 0(R1),X'40'
* BL 2(R1)
* B 8(R1)
* -------------------------------------------
NEXTBASE LA R7,$L(R7)
SAY 'NEXTBASE'
CLI 0(R7),X'FF'
BNE TESTBASE
BUMPBASE BAL R9,BUMPINDX
CLC FIRSTNDX,0(R6)
BNE TESTBASE
B Z
TESTBASE SAY 'TESTBASE'
L R7,0(R6)
TM $$BOARD+7,1
BZ NEXTBASE
MVC BOARD,$$BOARD
SR R8,R8
BAL R9,INITBASE
STM R6,R8,8(R6)
MVC 20(8,R6),BOARD
BAL R14,TESTPAGE
B MAIN
* ------------------------------ MAIN LOGIC -
ROT#INIT ZAP ROT#,=P'0'
*
ROT#ADD AP ROT#,P1
OI ROT#+1,X'0F'
UNPK ROT#C,ROT#
MVC 30(2,R6),ROT#C+1
BR R14
*
ROT# DC PL2'0'
ROT#C DC CL3'000'
*
SAVER6 DC 3F'0'
*
FOUND1 SAY 'FOUND1'
AP #PIECES,P1
BAL R14,SAVEPUZ
BAL R9,BACKOUT2
B MAIN
*
INITBASE LA R1,INDEX
LA R0,12
MVC 4(LINDEX-4,R1),ZEROS
LA R1,LINDEX(R1)
BCT R0,INITBASE+8
MVC SAVESOL-4,SAVESOL-8
BR R9
*
BACKOUT2 SAY 'BACKOUT2'
LA R0,2
B BACKOUTA
BACKOUT SAY 'BACKOUT'
LA R0,1
BACKOUTA L R1,SAVESOL-4
C R1,SAVESOL-8
BNH NEXTBASE
L R6,0(R1)
MVI 8(R6),X'FF'
SH R1,=H'20'
LM R6,R8,0(R1)
MVC BOARD,12(R1)
ST R1,SAVESOL-4
BCT R0,BACKOUT+4
BR R9
*
DC 3A(0)
SAVESOL NOP SAVESOLA
OI SAVESOL+1,X'F0'
LA R0,ESOLLIST
LA R1,SOLLIST
LR R2,R1
STM R0,R2,SOLLIST-12
SAVESOLA L R1,SAVESOL-4
STM R6,R8,0(R1)
MVC 12(8,R1),BOARD
LA R1,20(R1)
ST R1,SAVESOL-4
BR R9
*
* BACKUP2 DS 0H
* SAY 'BACKUP2'
* SP ROT#,P1
* CR R6,R12
* BE BUMPBASE
* LR R1,R6
* MVC BOARD,16(R6)
* L R6,4(R6)
* EX R0,ZEROIND1 MVC 4(LINDEX-8,R1),ZEROS
* MVI 8(R1),X'FF'
* * Q678
* BACKUP DS 0H
* SAY 'BACKUP'
* SP ROT#,P1
* SP #PIECES,P1
* LR R1,R6
* LM R6,R8,4(R6)
* CR R6,R12
* BE BUMPBASE
* MVC BOARD,16(R1)
* EX R0,ZEROIND1
* MVI 8(R1),X'FF'
* B NEXTROT
*
FRSTINDX LA R6,INDEX
SAY 'FRSTINDX'
L R7,0(R6)
B TESTROT
*
MAIN LA R10,1(R10)
SAY 'MAIN'
BAL R14,GETASPAC FIND EMPTY SQUARE
*
GETINDEX DS 0H
SAY 'GETINDEX'
LA R6,INDEX
GETINDL LA R6,LINDEX(R6)
CLI 8(R6),X'FF'
BNE GETINDL
L R7,0(R6)
CLI 0(R6),X'FF'
BNE TESTROT
CLC BOARD,FULLBRD
BE FOUND1
BAL R9,BACKOUT
*** B NEXTROT
*
NEXTROT LA R7,$L(R7) BUMP ROTATION?
SAY 'NEXTROT'
CLI 0(R7),X'FF' Q. END OF ROTATIONS?
B GETINDL
FULLBRD DC X'0F',7X'FF'
*
TESTROT DS 0H
SAY 'TESTROT'
LA R14,VALCHAR(R8)
CLI 0(R14),C' '
BH NEXTROT
LM R0,R1,$$BOARD
TESTSLDL SLDL R0,0(R8)
STM R0,R1,DW
NC DW,BOARD
BNZ NEXTROT
*
STM R0,R1,DW
OC BOARD,DW
STM R6,R8,8(R6)
*
BAL R9,SAVESOL
BAL R14,TESTPAGE
B MAIN
* *
*----------------------------------------------------------
*
QPZ MVC GETINDEX-8(8),ZEROS ERASE SAVED ROTATION LOC
GETASPAC EX R0,QPZ
SAY 'GETASPAC'
CLC BOARD,=X'0FFFFFFFFFFFFFFF'
BE FOUND1
SLR R8,R8
LM R0,R1,BOARD
B GETASP3
GETASP2 SRDL R0,1
LA R8,1(R8)
GETASP3 LA R15,1
NR R15,R1
BNZ GETASP2
STM R0,R1,DW
LA R10,1(R10)
BR R14
* -------------------------------------------
CLRPAGE LM R3,R4,APAGE-4
SAY 'CLRPAGE'
CLRZ (R4),(R3),PAD=C' '
BR R9
*
*
DC 10F'0'
SAVEPUZ STM R14,R7,SAVEPUZ-40
SAY 'SAVEPUZ '
LA R6,INDEX
LA R5,12
*
SAVEPA CLI 8(R6),X'FF'
BE SAVEPZ
*
L R7,8(R6)
LA R14,PRTTEST
LM R0,R1,24(R6)
*
SAVEPL LA R15,1
NR R15,R1
BZ *+10
MVC 0(1,R14),$$CHAR
LA R14,1(R14)
SRDL R0,1
C R14,=A(PRTTEST+60)
BL SAVEPL
*
SAVEPZ LA R6,LINDEX(R6)
BCT R5,SAVEPA
LM R14,R7,SAVEPUZ-40
B MVCSOL
** BR R14
*
#SOL DC PL3'0'
DC 8F'0'
MVCSOL STM R14,R5,MVCSOL-32
BAL R14,PRINTPAG
AP #SOL,P1
OI #SOL+2,X'0F'
UNPK WTO#SOL+9(5),#SOL
WTO#SOL WTO ' ..... SOLUTIONS'
CLC APAGE+4,APAGE+8
BL *+8
BAL R14,PRINTPAG
*
ST R2,APAGE+8
MVC 0(0,R15),0(R14)
MVCLINE EX R4,*-6
LA R14,1(R14,R4)
L R15,133(R15)
C R14,=A(PRTTEST+59)
BL MVCLINE
LM R14,R5,MVCSOL-32
BR R14
*
DC 8F'0'
PRINTPAG L R0,APAGE+4
C R0,APAGE+8
BLR R14
STM R14,R5,PRINTPAG-32
MVCSOLA LA R14,PRTTEST
LM R1,R2,APAGE
L R4,WIDTHX
LA R0,3(R14,R4)
ST R0,APAGE+4
C R2,APAGE+8
BL MVCLINE-10
MVC APAGE+4,APAGE
*
L R3,APAGE
WRITELIN MVC LINE,0(R3)
BAL R9,WTOLINE
LA R3,133(R3)
CLC 0(12,R3),SPACES
BNE WRITELIN
*
BAL R9,CLRPAGE
MVC LINE,SPACES
BAL R9,WTOLINE
B MVCSOLA
* =============================================
* HERE WE'RE GOING TO PRINT THE PUZZLE SO FAR.
* SO I CAN SEE WHERE I'VE GONE ASTRAY.
*
DC 64F'0'
TESTPAGE STM R0,R15,TESTPAGE-64
SAY 'TESTPAGE'
PUT OUTFILE,SEPAR-1
LA R6,INDEX
MVC PRTTEST,SPACES
TESTTOP L R7,12(R6)
LM R0,R1,$$BOARD
LA R4,PRTTEST
LA R14,PRTTEST+60
TESTNR LA R3,1
NR R3,R1
BZ *+10
MVC 0(1,R4),$$CHAR
SRDL R0,1
LA R4,1(R4)
CR R4,R14
BL TESTNR
TESTBUMP LA R6,LINDEX(R6)
SAY 'TESTBUMP'
C R6,ENDINDEX
BL TESTTOP
B TESTPRT+4
*
MVC LINE+2(0),0(R3)
TESTPRT STM R0,R15,TESTPAGE-64
L R2,WIDTHX
SAY 'TESTPRT'
L R5,LENGTH
LA R3,PRTTEST
TESTPRTL EX R2,TESTPRT-6
PUT OUTFILE,LINE-1
MVC LINE(12),LINE-1
LA R3,1(R3,R2)
CLC SPACES(6),0(R3)
BE *+8
BCT R5,TESTPRTL
MVC LINE,LINE-1
PUT OUTFILE,LINE-1
LM R0,R15,TESTPAGE-64
BR R14
* =============================================
Z MVC PRINTPAG+4,PRINTPAG+8
BAL R14,PRINTPAG PRINT THE LAST PAGE
CLOSE OUTFILE
LM R0,R1,LGETMAIN
FREEMAIN R,A=(1),LV=(0)
*
L 13,4(13)
LM 14,12,12(13)
SLR 15,15
BR 14
* --------------------------------------
LTORG
P1 DC X'1C'
P0 DC X'0C'
#PIECES DC PL4'0'
*
#FIT DC PL8'0'
#TRIES DC PL8'0'
HEX DC C'0123456789ABCDEF'
DC H'112,0',C' '
IDA DC CL27' '
DC C', SETUP, DEFINES PIECE BIT PATTERNS+VALID LOCATIONS'
LIDA EQU *-IDA
IDB DC C'PUZB, ASM &SYSDATE AT &SYSTIME'
DC C', FITS PIECES INTO THE PUZZLE. BOARD='
LIDB EQU *-IDB
PUSH PRINT
PRINT NOGEN
INFILE DCB DDNAME=INFILE,DSORG=PS,EODAD=ZIN,MACRF=GL,LRECL=3200, X
RECFM=F,BUFNO=1
OUTFILE DCB DDNAME=OUTFILE,DSORG=PS,LRECL=81,RECFM=FT,MACRF=PM
POP PRINT
*
DS 0D
LINDEX EQU 48
LLINDEX EQU 48*12
*
*
@@PAD#0 EQU *-PUZB+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG PUZB+@@PAD#2
*----------------------------------------------------------
* WHEN TESTING, IT'S EASIER IF THE PROGRAM DOES NOT EXCEED 4K,
* SO I MOVED SOME OF THE WORK AREAS DOWN INTO THE GETMAIN AREA.
* THERE IS A SINGLE GETMAIN, WITH 4 SECTIONS.
* INDEX -- IS THE 12 ENTRY PIECE INDEX. ROTATIONS ARE SEPARATE.
* WORKAREAS -- JUST THAT, MOVED FROM PROGRAM.
* PAGE --- 22 LINE, PRINT AREA
* $TABLE -- ROTATION DEFINITIONS.
*----------------------------------------------------------
DSECT DSECT 0
INDEX DS 13XL128,XL4
*----------------------------------------------------------
*
* THIS SECTION COMES FROM PUZA. PUZA PASSES 1 SINGLE RECORD
* THAT CONTAINS THE IDA (PGM NAME, ASSEMBLY DATE+TIME
* THE NXNN RECORD WITH THE HALF DOZEN FIELDS BELOW,
* AND THEN 60 ROTATION DEFINITIONS. 4 ARE OMITTED.
* 3 "L" TO ELIMINATE DUPLICATE SOLUTIONS.
* U UPSIDE DOWN BECAUSE THE PROGRAM WILL NEVER SELECT IT.
* (I MAY HAVE TO DO SOMETHING ABOUT THIS)
*
* ++++++++++++++++++++++++++++++
NXNN DS F DC F'0' THIS SECTION IS PASSED
WIDTH DS F DC F'0' FROM PUZA
LENGTH DS F DC F'0'
WIDTHX DS F DC F'0'
LENGTHX DS F DC F'0'
LRECL DS F DC F'81'
LNXNN EQU *-NXNN
* ++++++++++++++++++++++++++++++
*
ENDINDEX DS F DC A(INDEX+12*128)
SAV678B DS XL28
DS CL2
WTO DS XL4,CL2
LINE DS CL136
SPACES DS CL136
* PARM DS CL100
SEPAR DS CL136
ZEROS DS XL136
DS CL4
SOLLIST DS 12XL20
ESOLLIST DS CL20
*
* MACRO
* &LBL SAY &TEXT
* &LBL BAL R1,SAY
* DC H'-1'
* AIF ('&TEXT' NE '').DC
* DC AL2(*-PUZP)
* MEXIT
* .DC DC CL8&TEXT
* MEND
*
PAGE DS 22CL20 PRINT A ROW OF SOLUTIONS TABLE/DSECT
*----------------------------------------------------------
$TABL DS 80XL180 PIECE ROTATION TABLE 60 ENTRIES+12 ENDS=72
LDSECT EQU *-DSECT
*
$INDEX DSECT 0
IR6 DS A FIRST R7 ROTATION
IR678 DS 3A PRIOR R6, R7, R8
IOLDBORD DS XL8 BOARD INTO WHICH WE PUT PIECE
IBOARD DC XL8 BOARD
IPIECE DS XL8 PIECE BITS SHIFTED
IROTATID DS CL4
DS CL4
ISAVLEN EQU *-IR678
*
ISAVOLD DS XL40 6,7,8, BOARD, SHIFTED PIECE PATTERN
ISAVNEW DS XL40
IL EQU *-$INDEX
*
* THE FILE FROM PUZA IS A SINGLE BLOCK, WITH 48 BYTE LOGICAL RECORDS.
* THE FIRST RECORD IS THE PUZA NAME AND ASSEMBLE DATE
* THE SECOND IS THE NXNN RECORD SHOWN BELOW (NXNN = BOARD WIDTH+LENGTH)
* THE THIRD IS THE START OF THE 60 ROTATION DEFINITION RECORDS,
* WITH $$CHAR AND $$ROTAT IDENTIFICATION.
* PIECEDEF IS 10 BYTES OF PIECE DEF FROM CONTROL CARDS
* PIECEOFF IS THE OFFSET OF EACH OF THE 5 SQUARES.
* COULD HAVE BEEN JUST 1 BYTE EACH, BUT IT'S DONE.
*
$ DSECT 0
DS XL(128)
$L EQU *-$
ORG $
*
* MVC LINE(4),ROTATID
* MVC LINE(1),CARD+1
* MVC LINE+4(16),BOARD + VALID
* MVC LINE+20(4),FIRSTLOC
* MVC LINE+24(4),MAXHEIGH
* MVC LINE+28(20),PIECEDEF
*
$$CHAR DS 0CL1 ALL THIS IS FROM PUZA.
$$ROTAT DS CL4
$$BOARD DS XL8
$$VALID DS XL8
$$MIN DS F
$$MAX DS F
PIECEDEF DS CL10
PIECEOFF DS CL10
$$L EQU *-$ DATA FROM PUZA PROGRAM
*
$SHIFTED DS F
$$MAXMAX DS F
NEWBOARD DS F
ROTATID DS CL6
*
VALCHAR DS CL60
* PUZINDEX DS 2CL60
* PUZLOCS DS 25XL8 X'180' = 384
*
* * THE REST IS WORK AREAS HERE.
* $NEXTOP DS F
* $BOARD DS XL8
* $LASTBOA DS XL8
* $INDEXSV DS 0XL64
* $INDEX DS XL44
* $CURR DS XL4
* $SAVE6 DS 2XL8
* $SAVE DS 2XL8
ORG
*
END PUZB
A