Rewrite progress of my HEXED program that can be used for 3x20, 4x15, 5x12, or 6x10 board sizes.
Note that the first section of the program contains things that I need to use the z390 simulator.
Following that are MACROs and DSECTs that I need within the program.
I (almost) never put comments on instructions as I'm writing, (a) because I'm in a hurry to get the logic written, and (b) I frequently move sections of code around, so any comments would become disjointed at best. Sometimes I go back and add comments, to make sure I remember what that section of code is for.
AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEX
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEX
SET IN=C:\USERS\LIN\DOCUMENTS\BUSHSTUFF.TXT
SET OUT=%G%.OUT.TXT
BAT\ASMLG %G%.MLC TIME(1)
--JUST TEST ------------------------------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEXT
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEX
SET LISTING=%G%.PRN
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\RANDY.MLC
BAT\EZ390 %G%.MLC TEST
PARM(WHATEVER)
--CREATE FILE OF BREAK POINT COMMANDS. --------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEXB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEX
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=PRINTR2,ERR*,MSG*,Z,ZS,GETMAIN,TRY*,SET*,SAV*,QFREQ,QS1*,QS9*
LABEL=TES*,EDIT0*,GETIN,WRITOUT,
LABEL=AGETMAIN,CARD,LINE,
COMMAND=
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEX ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEXT EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\NEWHEXB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
-----------------------------------------------------------
.START ANOP
* -----------------------------------------------------------
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
&LABEL ERR &COND,&MSG
LCLA &L
&L SETA K'&MSG
LCLC &Z
&Z SETC 'SYS&SYSNDX'
&LABEL REVB &Z
STM 0,15,ERRREGS
BAL R14,ERROR
DC AL1(&L),C&MSG
&Z DS 0H
MEND
*
PIECETBL DSECT 0
PTFIRST DS A FIRST ROTATION ENTRY FOR THIS PIECE
PTPRIOR DS A LOCATION IN PRIOR PIECE ROTATION TBL
PTNEXT DS A ??
PTBIT DS XL8 64 BIT PIECE PATTERN
PTDEF DS CL10 SOURCE PIECE DEFINITION
PTCHAR DS C
PRCHAR DS CL25 PRINTABLE PIECE PATTERN
DS
LPTE EQU 71*13
DS
LPT EQU 71*13+????
NEWHEX START 0
YREGS
USING *,13
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R1,0(R1)
LH R2,0(R1)
SH R2,=H'1'
ERR BM,'NO PARM'
MVC PARM(0),2(R1) PARM CAN BE 6X10 5X12 4X15 3X20
EX R2,*-6
ST R2,PARMLEN
MVC TYPE,PARM
BAL R9,OPENOUT
LA R1,ADJ3T
CLC =C'3X20',TYPE
BE SABTYP
LA R1,ADJ4T
CLC =C'4X15',TYPE
BE SAVTYP
LA R1,ADJ5T
CLC =C'5X12',TYPE
BE SAVTYP
CLC =C'6X10',TYPE
ERR BNE,'INVALID PUZZLE SIZE'
B SAVTYP
*
ADJ5T DC H'4,8,12,16'
ADJ4T DC H'9,18,27,36'
ADJ3T DC H'14,28,42,56'
ADJTYPE DC H'0,0,0,0'
*
ABOARD DC F'0'
LBOARD DC A(21*133)
EBOARD DC F'0'
*
CCOLUMN DC F'0'
WCOLUMN DC F'8'
ECOLUMN DC F'0'
*
APT DC F'0'
LPT DC A(60*12*8)
*
MVC 0(0,R2)
PRTBOARD L R14,ABOARD
L R15,WCOLUMN
BCTR R15,0
EX R15,PRTBOARD-6 MOVE
MVC 0(133,R6),LINE CLEAR PRT LINE
LA R14,133(R14) NEXT PRT LINE
*
#COLS DC F'6'
#LINES DC F'10'
SAVTYP MVC ADJTYPE(10),0(R1)
MVC #COLS+3(1),TYPE
NI #COLS+3,X'0F'
PACK DW,TYPE+2(2)
CVB R0,DW
ST R0,#LINES
MH R0,=H'133'
* ---------------------------------------------
ST R0,LBOARD
GETMAIN R,(0)
ST R1,ABOARD
L R0,#LINES
INIBOARD MVC 0(133,R1),LINE
LA R1,133,R1)
BCT R0,INIBOARD
*
L R0,LPT
GETMAIN R,LV=(0)
ST R1,APT START OF PIECE TBL
*
* FIRST, LET'S GET OUR THINKING STRAIGHT. WHEN LOOKING AT THE
* 6X10 BOX, YOU CAN EITHER THINK OF IT AS 6 ROWS, 10 BYTES LONG,
* OR, 10 ROWS, 6 BYTES LONG. WHEN I FIRST DID THIS, I THOUGHT
* THE FIRST WAY, BUT HAVE REALIZED THAT THE LOGIC I USED THERE
* WOULDN'T WORK FOR OTHER SIZES. IF I THINK OF IT AS 6 WIDE,
* AND 10 HIGH, AND CODE IT CORRECTLY, IT WILL ALSO WORK FOR
* 5X12, 4X15, AND 3X20.
*
* AT 83, I DON'T THINK I'LL BE ABLE TO DO THIS, BUT MAYBE
* TRY AND SEE WHAT HAPPENS.
*
* PIECES USED TO BE A FILE, BUT NOW INTERNALLY DEFINED.
* BUT STILL HAVE TO LOAD BINARY AND CHARACTER REPRESENTATIONS
* OF THE PIECES INTO THE GETMAINED PIECE TABLE.
* WE'LL LOAD PIECES FIRST, THEN GO THROUGH AND FIX 'EM
* TO THE REPRESENTATIONS THAT WE NEED.
*
LOADLOOP LR R14,R1
L R15,=A(PIECES-L'PIECES)
USING PIECETBL,14
*
LOADNXT LA R15,L'PIECES(R15)
XC 0(20,R14),0(R14)
MVC PTCHAR,1(R14)
MVC PTDEF,2(R14)
MVC PRCHAR,LINE
LA R15,L'PIECES(R15)
LA R14,LPTE(R14)
CLI 0(15),C' '
BE LOADNXT
MVI 0(R14),X'FF'
MVC 1(256,R14),0(R14)
LA R1,LPT(R1)
CLI 0(R15),C'M'
BE LOADLOOP
ST R1,EPT END OF PIECE TBL
MVI 0(R1),X'FF'
DROP 14
*
* OKAY, THE DEFINITIONS OF THE 12 PIECES ARE LOADED
* INTO THE PIECE TABLE. NOW I HAVE TO CREATE BOTH
* A BIT PATTERN, AND ALSO, A CHARACTER PATTERN,
* FOR EACH PIECE.
*
* THE 6X10 PIECES ARE ALREADY CORRECT, HOWEVER FOR
* ALL THE OTHER PIECES I HAVE TO CHANGE THEIR OFFSETS
* FOR THE OTHER TABLE SIZES. (5X12, 4X15, 3X20)
* ---------------------------------------------
L R6,APT
LR R5,R6
LA R2,PTDEF
* ------------------------------------------
LA R0,5 5 BITS / SQUARES / ????
PACKBIT PACK DW,0(2,R5) PACK LOC/OFFSET
CVB R1,DW
STC R1,RC
* ------------------------------------------
* 6X10 ALL GOOD
* 5X12 0-9 OK 10-19 +2 20-29 +4 30-39 +6 40-49 +8
* 4X15 0-9 OK 10-19 +5 20-29 +10 30-39+15
* 3X20 0-9 OK 10-19+10 20-29 +20
*
* R2 = PIECE
* R5 = SQUARE WITHIN THE PIECE
* R1 = SQUARE IN BINARY
*
* ---------------------------------
CLI TYPE,C'6' 6X10, NO CHANGE
BE NOADJUST
CLI TYPE,C'4'
BH ADJ5
BL ADJ3
B ADJ4
IC 14,TYPE+3 5X12 LOAD 12,15,20
N 14,=F'7' FIX 2.5
CLI TYPE+3,C'0' Q. 20
BNE *+8 NO
LA 14,10 YES, SET ADJUST 10
*
*
IC 15,0(R5) LOAD 5,4,3
N 15,=F'7' CLEAR HI BITS
BZ NOADJUST
AR R1,R14 BUMP LENGTH OF STRING
BCT R15,*-6 1,2,3 TIMES
NOADJUST DS 0H
* --------------------------------
SLIDE LA R15,PTCHAR-1(R1)
MVC 0(1,R15),PTDEF
SR R14,R14
LA R15,1
SLDL R14,0(R1)
SRDL R14,1
STM R14,R15,DW
OC PTBIT,DW
LA R5,2(R5)
BCT R0,PACKPIT
* -------------------------------------
IC R0,TYPE
L R15,A
MVC LINE
* --------------------------------------------------
*
ERRREGS DC 16F'0'
ERROR LR R0,R14
SR R0,R13
ST R0,12(13)
UNPK LINE+4(9),16(5,R13)
TR LINE+4(8),HEX-240
MVC LINE(3),=C'ERR'
MVC LINE+12(4),=C' 0-7'
LA R4,ERRREGS
*
ERRUNPK LA R2,2
LA R15,LINE+17
LA R0,8
*
ERRUNPKU UNPK 0(9,R15),0(5,R4)
TR 0(8,R15),HEX-240
MVI 8(R15),C' '
LA R15,9(R15)
LA R4,4(R4)
BCT R0,ERRUNPKU
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
MVC LINE+12(4),=C' 8-F'
BCT R2,ERRUNPK+4
B Z
* --------------------------------------------------
Z BAL R9,CLOSE
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
LTORG
TYPE DC CL4' '
DW DC 2D'0'
LINE DC CL133' '
LINE2 DC CL133' '
LINE3 DC CL133' '
IDMSG DC CL133' NEWHEX, ASM &SYSDATE AT &SYSTIME'
PUSH PRINT
PRINT NOGEN
OPENOUT TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BOR R9
OPEN (SYSPRINT,OUTPUT)
BR R9
CLOSE CLOSE (SYSPRINT)
BR R9
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM
POP PRINT
*
PIECES DC CL12'M '
DC CL12' -0001020304'
DC CL12' -0010203040'
DC CL12'M '
DC CL12' 80011121314'
DC CL12' 80001102030' X
DC CL12' 80001020313' X
DC CL12' 80010203029' X
DC CL12' 80010203031' *** XX
DC CL12' 80010090807' ***
DC CL12' 80001112131' ***
DC CL12' 80010090807' ***
DC CL12' '
DC CL12'M '
DC CL12' X0001020312' ***
DC CL12' X0001020311'
DC CL12' X0010203019' *** X
DC CL12' X0010203009' X
DC CL12' X0010203012' *** XX
DC CL12' X0010203021' X
DC CL12' X0009101112' ***
DC CL12' X0008091011'
DC CL12'M '
DC CL12' &0010201929' ***
DC CL12' &0010202131'
DC CL12' &1009192900' ***
DC CL12' &0010112131' XX
DC CL12' &0001100908' XXX
DC CL12' &0001111213' ***
DC CL12' &0001020910'
DC CL12' &0001021213' ***
DC CL12'M ' X
DC CL12' L0001021020' X
DC CL12'M ' XXX X
DC CL12' +0009101120' XXX
DC CL12'M ' X
DC CL12' T0010201112' XXX
DC CL12' T0001021121' X
DC CL12' T0010201921' X
DC CL12' T0010201918'
DC CL12'M '
DC CL12' #0010201119'
DC CL12' #0010200921' *** X
DC CL12' #0010200109' XX
DC CL12' #0111210012' *** XX
DC CL12' #0910110019' ***
DC CL12' #0910110022'
DC CL12' #0920220019' ***
DC CL12' #1011120021'
DC CL12'M '
DC CL12' Z0010200119'
DC CL12' Z0001112122' *** XX
DC CL12' Z0405060016' *** X
DC CL12' Z1011120022' XX
DC CL12'M '
DC CL12' W0010091920' X
DC CL12' W0001111222' XX
DC CL12' W0100100919' XX
DC CL12' W0010112122'
DC CL12'M '
DC CL12' o0001101102'
DC CL12' o0001101109'
DC CL12' o0001101112' XX
DC CL12' o0001101119' XX
DC CL12' o0001101121' X
DC CL12' o0001101122'
DC CL12' o0010201121'
DC CL12' o0010200910'
DC CL12'M '
DC CL12' U0001102021' XXX
DC CL12' U0001120021' X
DC CL12' U0010201012' XXX
DC CL12' U0002101112'
DC CL12'Z '
* -----------------------------------------------------------
* DCBD DEVD=DA
*
@@PAD#1 EQU ((*-NEWHEX)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-NEWHEX)
ORG *+@@PAD#2
*
END NEWHEX