Previous Post: ACSL AGRAM Card Game Exercise - Just for fun
My last post was about my daughter's recent computer lab assignment. It looked like a fun exercise so I created two quick solutions - one in SQR and another in WinBatch. Fun, but not enough fun. I realized I had to create a version using PC/370 Assembler. PC/370 is an emulation package (developed in the 1980's by Donald Higgins) that enables MVS/370 (mainframe) Assembler programs to be assembled, linked & executed on a Windows PC. More information HERE.
I hadn't written a PC/370 Assembler program since the end of the last century. One reason being it no longer worked on later Windows operating systems. This year I discovered the freeware product DOSBOX which is a DOS-emulator. It allows older PC-based games & software to run on multiple platforms - including Windows 10. Now I can run my old PC/370 programs & create new ones.
Above: DOSBOX Session - Primed & ready to Assemble, Link & Execute my PC/370 AGRAM program.
MODULE: TDAGRAM.ALC
The Module TDAGRAM will read an input file (similar to the SQR version) & create formatted output to display the results. The full DOSBOX & PC/370 steps are below:
Z:\>MOUNT C C:\
Z:\>C:
C:\>CD PC370
C:\PC370>A370 TDAGRAM/LX
C:\PC370>L370 TDAGRAM/LX
C:\PC370>TDAGRAM
The first 3 steps MOUNT the C: drive & navigates to the PC370 directory.
Then the module TDAGRAM is assembled (A370), linked (L370) & executed.
(Assemble/Link only occur after a program change)
INPUT - C:\PC370\TDAGRAM.TXT
5D,2D,6H,9D,TD,6H
TC,AC,KC,QH,JS,TD
3D,4H,5C,6S,2D,7H
KS,TH,QC,7H,9H,3H
AC,AD,KH,JS,KS,QS
3H,2D,AC,9S,AH,QH,KH,AH,AS,AH,TD,3C,KC,2H,5H,6H,6S,9D,9D,9D,4H,KS
KH,2H,4C,5S,AH,KD
KH,2H,4C,5S,3H,KD
OUTPUT - C:\PC370\TDAGRAM.OUT
OPPONENT: 5D
DEALER HAND: 2D,6H,9D,TD,6H
SELECTION: 9D
OPPONENT: TC
DEALER HAND: AC,KC,QH,JS,TD
SELECTION: KC
OPPONENT: 3D
DEALER HAND: 4H,5C,6S,2D,7H
SELECTION: 2D
OPPONENT: KS
DEALER HAND: TH,QC,7H,9H,3H
SELECTION: 3H
OPPONENT: AC
DEALER HAND: AD,KH,JS,KS,QS
SELECTION: AD
OPPONENT: 3H
DEALER HAND: 2D,AC,9S,AH,QH,KH,AH,AS,AH,TD,3C,KC,2H,5H,6H,6S,9D,9D,9D,4H,KS
SELECTION: 4H
OPPONENT: KH
DEALER HAND: 2H,4C,5S,AH,KD
SELECTION: AH
OPPONENT: KH
DEALER HAND: 2H,4C,5S,3H,KD
SELECTION: 2H
As the INPUT / OUTPUT reveal the process ended successfully with the proper cards selected for each hand.
Key Routine - Setting the Face Value
In the SQR & WinBatch versions I set the weighted value of each face (Ace, Jack, Queen, King, etc.) using a string that represents the "Order of Magnitude". I extracted the position using either the Instr() or StrIndex() functions. I'll do something similar in the PC/370 version.
***********************************************************************
* SET FACE VALUE R4=CARD ENTRY *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
VALUE EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVI 3(4),X'00' INITIALIZE VALUE
*
LA 3,VALTAB LOAD TABLE ADDRESS
VALUE1 EQU *
CLI 0(3),X'FF' END OF TABLE?
BE VALUEX YES - EXIT ROUTINE
CLC 0(1,3),0(4) CARD FACE MATCH???
BE VALUE2 YES - EXIT LOOP
LA 3,1(,3) BUMP TO NEXT ENTRY
B VALUE1 TEST NEXT ENTRY
VALUE2 EQU *
S 3,=A(VALTAB-1) SUBTRACT TABLE ADDRESS
STCM 3,B'0001',3(4) STORE BIT VALUE
VALUEX EQU *
L 6,VALUE-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
VALTAB DC C'A23456789TJQK' CARD VALUE TABLE
DC X'FF' END OF TABLE
***********************************************************************
I use register 3 to loop through each position of the VALTAB string until it finds the address of the "FACE" character. Register 4 contains a 4-byte template for the card I'm looking for - 2 characters for the card (Face/Suit combination), 1 for the suit & the last for the face value (in hexadecimal). I could use the full address as a weighted value but that's cumbersome. By subtracting the starting address of the table (minus one) I'm left with the values 1 thru 13 - or X'01' thru X'0D'. That single hex value is transferred to my template using a STCM instruction (Store Characters Under Mask). The mask B'0001' is set to the last portion of bits in register 3 - then copied to the value bucket.
Card Selection Routine:
Assembler is very compact, cryptic & doesn't have indentation that may help visually. It's interesting comparing the logical constructs in PC/370 with the SQR & WinBatch versions.
***********************************************************************
* SELECT CARD *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SELECT EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC XXXDATA,DEALER SELECT FIRST CARDS
*
LA 4,DEALER+4 LOAD NEXT DEALER ADDRESS
USING DLRTAB,4 USE DEALER TABLE DSECT
SELLOOP EQU *
CLI DLRVAL,X'00' END OF CARDS???
BE SELECTX YES - EXIT ROUTINE
*
CLC XXXSUIT,OPPSUIT PRIOR SUIT MATCH?
BE SELSUIT YES - IGNORE OTHERS
CLC DLRVAL,XXXVAL DEALER LOWER VALUE?
BL SELMOVE YES - SELECT DEALER
CLC DLRSUIT,OPPSUIT SUIT MATCH DETECTED?
BE SELMOVE YES - SELECT DEALER
B SELBUMP BUMP DEALER POINTER
SELSUIT EQU *
CLC XXXSUIT,DLRSUIT MATCHING SUITS?
BNE SELBUMP NO - BUMP DEALER
*
CLC XXXVAL,OPPVAL HI PRIOR VALUE?
BNH SELUNDER NO - TRY UNDER
CLC DLRVAL,OPPVAL HI DEALER VALUE?
BNH SELBUMP NO - BUMP DEALER
CLC DLRVAL,XXXVAL DEALER < PRIOR?
BNL SELBUMP NO - BUMP DEALER
B SELMOVE MOVE DEALER ENTRY
SELUNDER EQU *
CLC XXXVAL,DLRVAL PRIOR < DEALER??
BNL SELMOVE NO - MOVE DEALER
CLC OPPVAL,DLRVAL OPPONENT LESS?
BNL SELBUMP NO - BUMP DEALER
SELMOVE EQU *
MVC XXXDATA,DLRDATA MOVE DEALER ENTRY
SELBUMP EQU *
MVC DLRDATA,=XL4'00' CLEAR DEALER ENTRY
LA 4,4(,4) BUMP DEALER POINTER
B SELLOOP TEST NEXT ENTRY
SELECTX EQU *
L 6,SELECT-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
When a new card is selected it copies data from the DLRDATA field to the XXXDATA field (highlighted in yellow above). DLRDATA represents the current DEALER entry which consists of the card, suit & value. When all cards in the hand have been evaluated the XXXDATA field contains the selected card information.
Full Source Code - TDAGRAM.ALC
TITLE 'TDAGRAM - PC/370 4.2 // DELIA'
***********************************************************************
* *
* MODULE: TDAGRAM. *
* AUTHOR: TONY DELIA. *
* DATE: 11/10/2019. *
* DESC: PC/370 AGRAM CARD GAME. *
* NOTE: PC/370 RELEASE 4.2 *
* *
***********************************************************************
EJECT
***********************************************************************
* T D A G R A M P R O G R A M *
***********************************************************************
TDAGRAM START 0 START PROGRAM
STM 14,12,12(13) SAVE REGISTERS
LR 12,15 LOAD PROGRAM ENTRY POINT
USING TDAGRAM+0*4096,12 BASE REGISTER 1
L 11,BASE2 LOAD BASE REGISTER 2
USING TDAGRAM+1*4096,11 TELL ASSEMBLER ABOUT BASE2
ST 13,SAVE+4 SAVE EXTERNAL SAVE ADDRESS
LR 14,13 XFER ADDRESS TO TEMP R14
LA 13,SAVE LOAD INTERNAL SAVE ADDRESS
ST 13,8(14) SAVE IN EXTERNAL SAVE AREA
B GO BRANCH TO PROCESSING RTN
***********************************************************************
RETURN EQU * TIME TO RETURN
L 13,SAVE+4 RESTORE REGISTER 13
LM 14,12,12(13) RESTORE REMAINING REGS
SR 15,15 CLEAR RETURN CODE
BR 14 BRANCH TO CALLING PROGRAM
***********************************************************************
SAVE DC 18F'0' S A V E A R E A
***********************************************************************
BASE2 DC A(TDAGRAM+1*4096) BASE2 DISPLACEMENT
***********************************************************************
GO EQU * BEGIN PROCESSING ...
***********************************************************************
EJECT
***********************************************************************
* MAINLINE PROCEDURE *
***********************************************************************
PRINT NOGEN
*
XFILI STDWKI OPEN INPUT FILE
XFILO STDWKO OPEN OUTPUT FILE
GETI EQU *
XREAD IREC,256 READ INPUT RECORD
BNZ EOFI EOF - EXIT ROUTINE
*
BAL 6,PARSE PARSE RECORD
BAL 6,SELECT SELECT CARD
BAL 6,RESULT PRINT RESULT
*
B GETI READ NEXT RECORD
EOFI EQU *
B RETURN EXIT PROGRAM PLEASE
***********************************************************************
EJECT
***********************************************************************
* PARSE RECORD *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
PARSE EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC OPPCARD,IREC MOVE OPPONENT CARD
MVC OPPSUIT,OPPCARD+1 MOVE OPPONENT SUIT
LA 4,OPPCARD LOAD XLATE ADDRESS
BAL 6,VALUE MOVE OPPONENT VALUE
*
LA 4,DEALER LOAD DEALER ADDRESS
LA 5,IREC+3 LOAD INPUT POINTER
PARSE1 EQU *
CLI 0(5),X'FF' END OF TABLE??
BE PARSEX YES - EXIT LOOP
MVC 0(2,4),0(5) MOVE DEALER CARD
MVC 2(1,4),1(5) MOVE DEALER SUIT
BAL 6,VALUE MOVE DEALER VALUE
CLI 2(5),C',' MORE DEALER CARDS?
BNE PARSEX NO - EXIT LOOP
LA 4,4(,4) BUMP DEALER POINTER
LA 5,3(,5) BUMP INPUT POINTER
B PARSE1 PROCESS NEXT ENTRY
PARSEX EQU *
L 6,PARSE-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* SET FACE VALUE R4=CARD ENTRY *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
VALUE EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVI 3(4),X'00' INITIALIZE VALUE
*
LA 3,VALTAB LOAD TABLE ADDRESS
VALUE1 EQU *
CLI 0(3),X'FF' END OF TABLE?
BE VALUEX YES - EXIT ROUTINE
CLC 0(1,3),0(4) CARD FACE MATCH???
BE VALUE2 YES - EXIT LOOP
LA 3,1(,3) BUMP TO NEXT ENTRY
B VALUE1 TEST NEXT ENTRY
VALUE2 EQU *
S 3,=A(VALTAB-1) SUBTRACT TABLE ADDRESS
STCM 3,B'0001',3(4) STORE BIT VALUE
VALUEX EQU *
L 6,VALUE-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
VALTAB DC C'A23456789TJQK' CARD VALUE TABLE
DC X'FF' END OF TABLE
***********************************************************************
EJECT
***********************************************************************
* SELECT CARD *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SELECT EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC XXXDATA,DEALER SELECT FIRST CARDS
*
LA 4,DEALER+4 LOAD NEXT DEALER ADDRESS
USING DLRTAB,4 USE DEALER TABLE DSECT
SELLOOP EQU *
CLI DLRVAL,X'00' END OF CARDS???
BE SELECTX YES - EXIT ROUTINE
*
CLC XXXSUIT,OPPSUIT PRIOR SUIT MATCH?
BE SELSUIT YES - IGNORE OTHERS
CLC DLRVAL,XXXVAL DEALER LOWER VALUE?
BL SELMOVE YES - SELECT DEALER
CLC DLRSUIT,OPPSUIT SUIT MATCH DETECTED?
BE SELMOVE YES - SELECT DEALER
B SELBUMP BUMP DEALER POINTER
SELSUIT EQU *
CLC XXXSUIT,DLRSUIT MATCHING SUITS?
BNE SELBUMP NO - BUMP DEALER
*
CLC XXXVAL,OPPVAL HI PRIOR VALUE?
BNH SELUNDER NO - TRY UNDER
CLC DLRVAL,OPPVAL HI DEALER VALUE?
BNH SELBUMP NO - BUMP DEALER
CLC DLRVAL,XXXVAL DEALER < PRIOR?
BNL SELBUMP NO - BUMP DEALER
B SELMOVE MOVE DEALER ENTRY
SELUNDER EQU *
CLC XXXVAL,DLRVAL PRIOR < DEALER??
BNL SELMOVE NO - MOVE DEALER
CLC OPPVAL,DLRVAL OPPONENT LESS?
BNL SELBUMP NO - BUMP DEALER
SELMOVE EQU *
MVC XXXDATA,DLRDATA MOVE DEALER ENTRY
SELBUMP EQU *
MVC DLRDATA,=XL4'00' CLEAR DEALER ENTRY
LA 4,4(,4) BUMP DEALER POINTER
B SELLOOP TEST NEXT ENTRY
SELECTX EQU *
L 6,SELECT-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* RESULTS *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
RESULT EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC OPRT(13),LIT1 MOVE LITERAL STRING
MVC OPRT+13(2),OPPCARD MOVE OPPONENT CARD
XPRNT OREC,100 WRITE OUTPUT RECORD
MVC OPRT,OREC CLEAR OUTPUT LINE
*
MVC OPRT(13),LIT2 MOVE LITERAL STRING
MVC OPRT+13(85),IREC+3 MOVE DEALER HAND
XPRNT OREC,100 WRITE OUTPUT RECORD
MVC OPRT,OREC CLEAR OUTPUT LINE
*
MVC OPRT(13),LIT3 MOVE LITERAL STRING
MVC OPRT+13(2),XXXCARD MOVE SELECTED CARD
XPRNT OREC,100 WRITE OUTPUT RECORD
MVC OPRT,OREC CLEAR OUTPUT LINE
*
XPRNT OREC,100 WRITE BLANK RECORD
RESULTX EQU *
L 6,RESULT-4 RESTORE LINK REGISTER
BR 6
***********************************************************************
* WORKING STORAGE *
***********************************************************************
CNOP 0,4
DEALER EQU * DEALER CARDS
DC 55XL4'00000000' CARD(2)/SUIT(1)/VALUE(1)
DEALERX EQU *
DC XL1'FF' END OF TABLE
*
OPPDATA DS 0CL4 OPPONENT
OPPCARD DC CL2'OO' OPPONENT - CARD
OPPSUIT DC CL1'O' OPPONENT - SUIT
OPPVAL DC XL1'00' OPPONENT - VALUE
XXXDATA DS 0CL4 SELECT
XXXCARD DC CL2'XX' SELECT - CARD
XXXSUIT DC CL1'X' SELECT - SUIT
XXXVAL DC XL1'00' SELECT - VALUE
*
LIT1 DC CL13' OPPONENT: ' RESULT LITERAL 1
LIT2 DC CL13'DEALER HAND: ' RESULT LITERAL 2
LIT3 DC CL13' SELECTION: ' RESULT LITERAL 3
***********************************************************************
* DATA CONTROL BLOCK SET UP *
***********************************************************************
STDWKI DC CL64'C:\PC370\TDAGRAM.TXT'
STDWKO DC CL64'C:\PC370\TDAGRAM.OUT'
***********************************************************************
* OUTPUT RECORD *
***********************************************************************
OREC DC CL1' ' OUTPUT RECORD
OPRT DC CL132' ' OUTPUT RECORD LINE
***********************************************************************
* INPUT RECORD *
***********************************************************************
IREC DS CL256 INPUT RECORD
***********************************************************************
LTORG LITERAL POOL
***********************************************************************
* COPYBOOKS *
***********************************************************************
COPY CPY/TDSVC.CPY COPYBOOK - SUPERVISOR
***********************************************************************
* DEALER TABLE DSECT *
***********************************************************************
DLRTAB DSECT
DLRDATA DS 0XL4
DLRCARD DS CL2
DLRSUIT DS CL1
DLRVAL DS XL1
***********************************************************************
END TDAGRAM
Not much else to say except this was another fun exercise & I'm happy to get the PC/370 emulation package back up & running via DOSBOX.
