AGO
This is the PUZA program that reads the piece/rotation file, and creates teh pirce/rotation definition file that's used by PUZB to find solutions. PUZP check the output of this file to see if I've done it right. So far, I have. The output of PUZA is binary and unreadable. But I did write PUZP to read the output and show what it looks like.
AGO .START
THIS PROGRAM IS RIGHT AT THE 4K BOUNDARY.
IF YOU WANT 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