QBR is a z390 program to create break point (AT) commands

Hey, new version. I like this one better. Simpler.

QBR was written to make TEST easier for me. I have ADD and fat fingers, and am 81 years old, and make way too many mistakes. So I use TEST a lot. I'd hoped that z390 would be modified to let me stack commands in the input line, and set several break points at the same time. That's not going to happen, but in addition to a list of all the breakpoints you want, QBR does create a series of breakpoints in one line, that fit on the z390 command line (you have to make it wider) and then you can set the breakpoints fairly easily. For example, put this output on the command line, hit enter, RETRIEVE IT WITH THE UP-ARROW (I never knew that worked) erase the first one and enter the second.

A FE4E0. A FE598. A FE636. A FE63E. A FE644. A FE66A. A FE670. A FE6D0. -paste, then enter, retrieve, erase and ...

A FE598. A FE636. A FE63E. A FE644. A FE66A. A FE670. A FE6D0. -enter, retrieve, erase and ...

A FE636. A FE63E. A FE644. A FE66A. A FE670. A FE6D0. -enter, retrieve, erase and ...

A FE63E. A FE644. A FE66A. A FE670. A FE6D0. -etc.

Occasionally you'll see a ' DUP ' entry. This occurs when 2 lines in the listing contain the same label (ie when there's a label on the macro and on the instruction.) Just skip it. I tried to fix it, but, give me a break, I'm 81. If you were to enter the same address twice, the 2nd would remove the 1st. This is a crummy fix for that.

Input is the SYSIN file. This is the SYSIN file I used to test QBR. It looks better with a fixed font.

Everything with a blank, or "*" in col-1 is a comment. To save a line in case you want to use it, just move it right a bit.

Note that I saved the .BAT file and the Z390 command. QBR assumes that you'll load your program in high memory.

If you do NOT do that, you need to tell it you load location LOADLOC=????? (no period)

* EITHER A BLANK OR AN "*" IN COL-1 IS ALWAYS A COMMENT. THESE ARE CONTROL CARDS I USED TESTING QBR.

* SET LISTING=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.PRN

* SET ATFILE=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.ATFILE.TXT

* SET COMMANDS=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.COMMANDS.TXT

* SET SYSIN=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.SYSIN.TXT

* BAT\ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC

* C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR

* IT'LL CALC LOADLOC, AT HIGH END OF MEMORY, BUT WE CAN DO THIS.

* LOADLOC=FE000

LRECL=90

LABEL=OPEN,CLOSE,THI*,BUMP*,ALLDONE,RECORD,OUTREC,OPCODE,LABEL,#IN,#LBL*

LABEL=BEG*,GET*,PRI*,GETSY*,GOTSY*,EXIT,QLAB*,LABELTBL,EODSYSIN

LABEL=SAVEL*,D*,BU*,GETLENG,

* COMMAND=--

* COMMAND=L,L 3R% 64,L 7R% 64,T1

COMMAND=--

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR ASMLG

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBRT EZ390

COMPRESS=Y (squish spaces from ATFILE)

ATFILE=Y Write AT commands, or LIST commands for all instructions

CMDFILE=Y Write AT commands for labels listed in LABEL= lines.

LABEL= are the business end. NAME will just select that keyword. NAME* will select it and any suffixes.

COMMAND= just puts stuff in the file that I might want.

After you run the program, there are 2 output files, and also what's on the E390 screen. i use the E390 screen. I cut-n-paste it to a NOTEPAD file.

When I'm testing, I generally have 3-4 SPFlite screens open in addition to the NOTEPAD file, and the Z390 screen.

I look at the source, a output file(s) that the program I'm testing created, and the control card that the program uses.


When I'm working, I always put this at the end of a program I'm working on.

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

@@PAD#1 EQU ((*-QBR)/4096+1)*4096

@@PAD#2 EQU @@PAD#1-(*-QBR)

ORG *+@@PAD#2

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

END QBR

What that does is to align my program on a 4k boundary so that locations, and offsets, match.

I only write batch programs these days, so they're not re-entrant. I always start my programs with:

TEST START 0

USING *,13

STM 14,12,12(13) I'VE GOTTEN INTO THE HABIT OF USING

ST 15,8(13) REG13 FOR BOTH BASE AND SAVE AREA.

ST 13,4(15) JUST MAKE SURE THAT THERE'S NOTHING

LA 13,0(15) THAT USES THE SAVE AREA BEFORE WE'RE

Note that I can't do anything needing the save-area for the first 72 bytes, but using 13 for both base and save-area gives me an extra register. I guard them jealously, using 14, 15, 0, and 1 as often as possible. In general, my base registers are high, and work registers are low. BUT the TRT instruction puts a byte in reg-2, so be careful. Also, I often overlay the first work with either X'4400D000' (causes a S0C3) or B INTERNAL-RESTART-ADDRESS so I can try again. It's easy to J 13r%

I ran the QBR program as I was testing QBR. There's extra stuff on the console during setup, and at the end, but the usable file contained AT and LIST commands from the LABEL= records, and then the stacked file at the end, with only AT commands. I make no attempt to get the length for the LIST command. I just use 96.

QBR 12/21/22 14.51 VER 01.03 (4 USE WITH Z390) -LIN LYONS

Then there's lots of stuff from the SYSIN file, and an indication that I'm setting it up correctly. And then the important stuff.

A FE000.+0004CC. THISOPC

A FE000.+0004E0. THISOPCL

A FE000.+000598. EODSYSIN

L FE000.+000633. 96 GET#FLAG

A FE000.+000636. GET#HEX

A FE000.+00063E. GET#DEC

A FE000.+000644. GET#IC

A FE000.+00066A. GET#D

A FE000.+000670. GET#NEXT

A FE000.+0006D0. GETSYSIN

A FE000.+0006E2. GOTSYSIN

A FE000.+0006E2. GOTSYSIN

A FE000.+0007C2. BUMPCMDL

L FE000.+00088E. 96 SAVELAST

A FE000.+000924. SAVELBL

A FE000.+000A6E. QLABEL

A FE000.+000A72. QLABEL2

A FE000.+000A7A. QLABEL3

L FE000.+000EEB. 96 OPCODE

L FE000.+000F17. 96 LABEL

L FE000.+000F3E. 96 OUTREC

L FE000.+000F47. 96 RECORD

L FE000.+001530. 96 LABELTBL

L FE000.+00163C. 96 DOC

A FE6E2. DUP A FE7C2. A FE924. A FEA6E. A FEA72. A FEA7A.

A FE4E0. A FE598. A FE636. A FE63E. A FE644. A FE66A. A FE670. A FE6D0.

A FE282. A FE330. DUP A FE3BE. A FE458. A FE45E. A FE4B0. A FE4CC.

A FE09A. A FE0A2. A FE0BE. A FE0EA. A FE13C. A FE244. DUP A FE282.

As I said, I'm old. I started with punch cards. That's where I learned to type, on a keypunch. We run everything from our terminal today, but, if I were to run QBR in batch, I'd code: .............. (yeah, from memory, I was good at JCL.)

//TESTING EXEC PGM=QBR

//STEPLIB DD DISP=SHR,DSN=

//LISTING DD DISP=SHR,DSN=

//SYSRINT DD -- THERE ISN'T ONE. I USE WTO. IF YOU REALLY WANT TO DO THIS, TALK TO ME.

//CMDFILE DD SYSOUT=*

//ATFILE DD SYSOUT=*

//SYSIN DD *

BLANK IN COL-1 IS ALWAYS A COMMENT. THESE ARE CONTROL CARDS I USE

SET LISTING=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.PRN

SET ATFILE=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.ATFILE.TXT

SET COMMANDS=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.COMMANDS.TXT

SET SYSIN=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.SYSIN.TXT

BAT\ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC TEST PARM(SYSIN)

C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR

IT'LL CALC LOADLOC, AT HIGH END OF MEMORY, BUT WE CAN DO THIS.

LOADLOC=FE000

LRECL=90

LABEL=OPEN,CLOSE,THI*,BUMP*,ALLDONE,RECORD,OUTREC,OPCODE,LABEL,#IN,#LBL*

LABEL=BEG*,GET*,PRI*,GETSY*,GOTSY*,EXIT,QLAB*,LABELTBL,EODSYSIN

LABEL=SAVEL*,D*,BU*,GETLENG,

COMMAND=--

COMMAND=L,L 3R% 64,L 7R% 64,T1

COMMAND=--

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR ASMLG

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBRT EZ390

COMPRESS=Y

CMDFILE=Y

ATFILE=Y

Source ----- QBR.MLC ----------- looks way better with fixed font ---------

=================================================================

AMODE 24

RMODE 24

AGO .PAST


I HAVE DYXLEXIA, ATTENTION DEFICIT, AND OTHER HANDICAPS. HENCE QBR,

WHICH MAKES USING TSO TEST EASIER FOR ME ON Z390.


IF YOU SET UP THESE SYSIN AND BAT FILES, YOU'LL SEE HOW QBR WORKS.


WHAT I DO, WHEN I START TESTING, MAYBE FOR PROGRAM RACHAEL,

IS SET UP THE BAT AND SYSIN FILES TO READ THE RACHAEL.PRN FILE

THEN I HAVE A COUPLE SPFLITE (OR ???) WINDOWS OPEN WITH THE

RACHAEL SOURCE, AND THE ATFILE.

I USUALLY KEEP THE COMMAND FILE IN NOTEPAD, BECAUSE I FIND IT EASIER.

AND, OF COURSE, THE Z390 WINDOW, MADE FULL SCREEN HIGH.

SO I HAVE 3-4-5 WINDOWS OPEN. A LARGE MONITOR HELPS A LOT.


----- BAT FILE, USED FOR TESTING THIS PGM -----------

SET LISTING=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.PRN

SET ATFILE=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.ATFILE.TXT

SET COMMANDS=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.COMMANDS.TXT

SET SYSIN=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.SYSIN.TXT

BAT\ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC TEST


C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR


---- SYSIN FILE FOR TESTING, COL-1 BLANK = COMMENT

IT'LL CALC LOADLOC, BUT WE COULD USE LOADLOC=13R% OR LOADLOC=FF000

NOTE LABEL=O WILL ONLY LIST THAT EXACT LABEL

LABEL=O* WILL LIST ALL LABELS STARTING WITH O

LRECL=90 ATFILE (LISTING) LRECL

LABEL=OPEN,CLOSE,THI*,BUMP*,ALLDONE

LABEL=RECORD,OUTREC,OPCODE,LABEL,#IN,#LB

LABEL=BEG*,GET*,PRI*,GETSY*,GOTSY*,EXIT,QLAB*,LABELTBL,EODSYSIN,SAVEL*

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR ASMLG

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBRTT EZ390

COMPRESS=Y MAKE THE LISTING NARROWER

CMDFILE=Y WRITE THE COMMANDS FILE

ATFILE=Y WRITE THE ATFILE FILE

-------------------------------------------------------


ATFILE = COMPRESSED LISTING, WITH BREAK/LIST COMMANDS ON EVERY INST.

COMMANDS = BREAK/LIST COMMANDS REQUESTED IN LABEL= SYSIN

-- AT THE END OF THE COMMANDS FILE ARE THE COMMAND= RECORDS

TO MAKE THEM EASIER TO FIND



C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR ASMLG

C:\USERS\LIN\DOCUMENTS\Z390CODE\QBRT EZ390


.PAST ANOP

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

* MACRO

* D &TXT

* LCLA &N

* &N SETA (K'&TXT)

* &N SETA &N-3

* DC AL1(&N),C&TXT

* MEND

* MACRO

* &LABEL PUTREG &R

* &LABEL $$LA 1,&R

* BAL R14,PUTD

* MEND

* MACRO

* &LABEL PUTMSG &M

* LCLC &L

* &L SETC 'SYS&SYSNDX'

* &LABEL BAL R1,&L.Z

* D &M

* &L.Z BAL R14,PUTD

* MEND

*

* MVC RECORD+1(0),RECORD

* MVC RECORD+1(0),1(R1)

* PUTD SR R15,R15

* IC R15,0(R1)

* EX R15,PUTD-6

* STM R14,R1,DW

* PUT COMMANDS,RECORD

* LM R14,R1,DW

* EX R15,PUTD-12

* LR R1,2(R1,R15)

* BR R14

*

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

QBR START 0

R0 EQU 0 SIMPLE CREATE BREAK POINTS, USING Z390 LISTING

R1 EQU 1 ADD A PREFIX TO EACH RECORD THAT CREATES THE

R2 EQU 2 BREAK POINT AND WRITE THE LISTING,

R3 EQU 3 WITHOUT NON INSTRUCTION RECORDS.

R4 EQU 4

* R5 EQU 5

* R6 EQU 6

* R7 EQU 7

* R8 EQU 8

BR EQU 9

* R10 EQU 10

* R11 EQU 11

R12 EQU 12 ALSO WTO BREAK POINT COMMANDS FOR LABELS

R13 EQU 13 AND PREFIXES SPECIFIED IN THE //SYSIN FILE.

R14 EQU 14

R15 EQU 15

* DC CL8'&SYSECT' IT'D BE NICE IF THIS WORKED.

* ORG QBR

* DC 18F'0'

* ORG QBR

USING *,13,12

STM 14,12,12(13) I'VE GOTTEN INTO THE HABIT OF USING

ST 15,8(13) REG13 FOR BOTH BASE AND SAVE AREA.

ST 13,4(15) JUST MAKE SURE THAT THERE'S NOTHING

LA 13,0(15) THAT USES THE SAVE AREA BEFORE WE'RE

CNOP 0,8 DONE WITH IT.

DW DS 0D

LA 12,4095

LA 12,1(12,13)

MVC 0(4,13),=X'4400D000' S0C3 ABEND, MIGHT BE USED TESTING

L R2,0(R1)

WTO 'QBR &SYSDATE &SYSTIME VER 01.03 (4 USE WITH Z390) -LINLYONS@YAH

HOO.COM'

CLI 1(R2),0

BE OPNSYSIN

LH R3,0(R2) YOU REALLY HAVE TO HAVE PARM(SYSIN)

BCTR R3,0

MVC RECORD(0),2(R2)

EX R3,*-6

CLC =C'SYSIN ',RECORD

BE OPNSYSIN

CLI 1(R2),9

BL GOTSYSIN

TR RECORD,PARMTR

B GOTSYSIN

* ORG

*

PRINTDOC L R2,=A(DOC) DO THIS WHEN PARM IS OMITTED.

EX 0,*

PRINTDOL MVC OUTREC(61),0(R2)

WTO MF=(E,OUTREC-4)

LA R2,61(R2)

CLI 0(R2),C' '

BNL PRINTDOL

B EXIT

*

USING IHADCB,2 CLOSE OPEN FILE IN REG-1

CLOSE TM DCBOFLGS,DCBOFOPN

BZR BR

CLOSE ((2))

MVC CLOSEWTO+4(8),DCBDDNAM

WTO MF=(E,CLOSEWTO)

BR BR

DROP 2

CLOSEWTO DC H'19,0',C' CLOSED'

*

ALLDONE BAL R14,ADDHEX5P

BAL R14,ADDHEX5Y

BAL BR,LISTCMDS

ERRDONE LA R2,SYSIN POINT TO EACH DCB

BAL BR,CLOSE AND GO DO THE CLOSE ROUTINE

LA R2,LISTING

BAL BR,CLOSE

LA R2,ATFILE

BAL BR,CLOSE

LA R2,COMMANDS

BAL BR,CLOSE

*

LA R2,### WTO THE VARIOUS COUNTS

WTO#LOOP OI 3(R2),X'0F' MAINLY FOR TESTING

UNPK WTO#+4(7),0(4,R2)

MVC WTO#+12(28),4(R2)

WTO MF=(E,WTO#)

LA R2,32(R2)

CLI 0(R2),C'9'

BL WTO#LOOP

*

EXIT L 13,4(13)

LM 14,12,12(13)

SR 15,15

BR 14

*

WTO# DC H'48,0',CL44' '

### DS 0F

#LOOKEND DC PL4'0',CL28'RECS READ, LOOKING FOR END'

#IN DC PL4'0',CL28'LISTING RECORDS READ'

#ANAL DC PL4'0',CL28'LISTING RECORDS ANALYZED'

#OUT DC PL4'0',CL28'AT RECORDS WRITTEN'

* #LABELS DC PL4'0',CL28'LABELS SPECIFIED'

#LBLFND DC PL4'0',CL28'LABELS FOUND IN LISTING'

#LBLOUT DC PL4'0',CL28'A/L LABEL RECS WRITTEN'

DC X'FF'

*

PRINT NOGEN

OPENOUT OPEN ((2),OUTPUT)

PRINT GEN

BR BR

BEGIN OPEN (LISTING,INPUT)

WTO MF=(E,FLAGS)

LA R2,ATFILE LISTING WITH BREAK POINTS

CLI FLAGATF,C'Y'

BNE *+8

BAL BR,OPENOUT

LA R2,COMMANDS BREAK PT COMMANDS

CLI FLAGCMDS,C'Y'

BNE *+8

BAL BR,OPENOUT

MVC RECORD,RECORD-1

*

CLI AT+2,C'Z' OKAY, 'Z' INDICATES WE HAVE TO READ

BNE GET THE LISTING FIRST, JUST TO FIND THE

GETLENG GET LISTING,RECORD END COMMAND, AND GET MODULE LENGTH

AP #LOOKEND,=P'1'

BAL BR,GETOPCOD ONCE WE HAVE MODULE LENGTH, WE CAN

CLI RECORD,0 CALCULATE THE LOAD POINT IN Z390,

BE GETLENG BECAUSE THE END OF THE PROGRAM

CLC =C'END ',OPCODE IS AT 000FFFFF UNLESS YOU CHANGE

BNE GETLENG THAT, BUT WHY!!!

*

*

SR R3,R3

LA R1,RECORD-1

BAL BR,GET#HEX

AH R0,=H'7'

SRL R0,3

SLL R0,3

*

L R1,=X'00100000' SUBT PGM LENGTH FROM 000FFFFF +1

SR R1,R0 YOU COULD ALSO USE BASE-REG

ST R1,DW+12 + INSTRUCTION LOCATION,

UNPK DW(9),DW+12(5) PROVIDING THAT THE BASE-REG

TR DW(8),HEXCHAR-240 POINTS TO THE START OF THE

MVC AT+2(5),DW+3 PROGRAM.

*

PRINT NOGEN

CLOSE LISTING

OPEN (LISTING,INPUT)

PRINT GEN

B GET

HEXCHAR DC C'0123456789ABCDEF'

*

USING IHADCB,1

PUTREC TM DCBOFLGS,DCBOFOPN

BZR BR

PUT (1),(0)

BR BR

DROP 1

*

WRITE CLI FLAGCOMP,C'Y'

BNE *+14

MVI OUTREC+29,C' '

MVC OUTREC+30(90),OUTREC+62

*

LA R1,ATFILE

LA R0,OUTREC

BAL BR,PUTREC

*

* LA R1,COMMANDS

* LA R0,RECORD

* BAL BR,PUTREC

AP #OUT,=P'1'

B GET

*

GET GET LISTING,RECORD GET A RECORD.

AP #IN,=P'1'

CLC =C' SYM',RECORD

BE ALLDONE

CLI RECORD,C'0' MAKE SURE IT'S A VALID LISTING REC.

BNE GET

CLI RECORD+51,C'0'

BL GET

CLC =C'000000',RECORD

BE GET

CLI RECORD+2,C':'

BE GET

CLC =C'+DCB',RECORD+52

BE GET

CLI RECORD+53,C'*'

BE GET

*

AP #ANAL,=P'1'

MVC OUTREC(L'AT),AT

MVI AT,C'A' SET 'AT' COMMAND OP-CODE

BAL BR,GETOPCOD

CLI RECORD,0 Q. RECORD REJECTED?

BE GET YES, SKIP IT.

MVC DW(32),RECORD+6

MVI RECORD+6,C'.'

MVC RECORD+7(31),DW

BAL BR,TESTDSDC

CLI LABEL,C' '

BE WRITE

BAL BR,QLABEL

B WRITE

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

GETOPCOD MVC LABEL,SPACES SPACE OUT THE LABEL AND OPCODE

MVC OPCODE,SPACES

MVC OPERAND,SPACES

*

LA R1,RECORD+53

CLI 0(R1),C' ' Q. IS THERE A LABEL?

BE NOLABEL NO, GO LOOK FOR OPCODE

TRT 0(22,R1),FINDSPAC Q. DID WE FIND END OF LABEL?

BZ GETOPCZ NO, JUST SKIP THE RECORD.

LR R2,R1 YES, CALC LABEL LENGTH

S R2,=A(RECORD+53)

*

CH R2,=H'14' FIX FOR BUG THAT I DON'T KNOW WHERE

BH GET TO LOOK FOR TO FIND IT.

*

MVC LABEL(0),RECORD+53 AND MOVE IT TO LABEL W/A

EX R2,*-6

AP #LBLFND,=P'1'

*

NOLABEL TRT 0(22,R1),FINDCHAR NEXT WE'LL GET THE OP-CODE

BZ GETOPCZ Q. NONE? (STRANGE)

LR R3,R1 JUST SKIP THE RECORD

TRT 0(9,R3),FINDSPAC YES, FIND END OF OPCODE

BZ GETOPCZ Q. MORE THAN 8 CHARS? YES SKIP REC

ST R1,DW

LR R2,R1 CALC LENGTH OF OPCODE

SR R2,R3

MVC OPCODE(0),0(R3) SAVE OP-CODE

EX R2,*-6

STM R1,R3,DW

*

TRT 0(6,R1),FINDCHAR AND GET OPERAND FOR DS 0H

BZ GETOPCY Q. NONE? (STRANGE)

LR R3,R1

TRT 0(L'OPERAND,R1),FINDSPAC

BZ GETOPCY

LA R1,8(R3)

LR R2,R1

SR R2,R3

MVC OPERAND(0),0(R3)

EX R2,*-6

*

GETOPCY LM R1,R3,DW

BR BR

GETOPCZ MVI RECORD,0

BR BR

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

DCDS DC CL10'LDC',CL10'LDS',CL10'DDSECT',CL10'CCSECT',CL10'ZEQU'

DC CL10'OORG',CL10'UUSING',C' '

*

TESTDSDC LA R14,DCDS-10 NEXT DETERMINE WHAT KIND OF OPCODE

BUMPDSDC LA R14,10(R14) BUMP TO FIRST/NEXT NON-INST OPCODE

EX R2,CLCOPCOD Q. IN THE NON-INST TABLE?

BE THISOPC YES, GO CHANGE OUTPUT OPCODE

CLI 10(R14),C' ' Q. END OF TABLE?

BNE BUMPDSDC NO, LOOP.

BR BR YES, WRITE THE RECORD.

CLCOPCOD CLC 0(0,R3),1(R14)

*

THISOPC CLC =C'0H ',OPERAND

BNE THISOPCL

CLC =C'DS ',OPCODE

BE NOTDCDS

*

THISOPCL CLI 0(R14),C'L'

BNE NOTDCDS

MVI OUTREC,C'L'

*

MVC DW(31),RECORD+7

MVC RECORD+7(04),=C' 96 '

MVC RECORD+11(26),DW+1

BR BR

*

NOTDCDS BR BR

*

* EXPECTING LOADLOC=FE244 OR ???

* LABEL=OPEN,CLOSE,*THI,*BUMP

*

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

EODLISTG WTO 'EODAD ON LISTING, INTERNAL ERROR'

B ALLDONE

BADSYSIN WTO 'INVALID SYSIN, LOADLOC= LRECL= OR LABEL= ONLY'

B ALLDONE

BADSYS01 WTO 'INVALID LABEL=, LONGER THAN 14'

B ALLDONE

EODSYSIN MVC OUTREC(L'RECORD),SPACES

* BAL BR,LISTLBLT

* MVC OUTREC(L'RECORD),SPACES

LM R14,R15,LABELTBL

L R0,CMDLIST

LTR R0,R0

BZ *+6

LR R15,R0

SR R15,R14

CVD R15,DW

OI DW+7,X'0F'

UNPK TBLENGW(3),DW+6(2)

S R14,=A(ENDDOC-64)

CVD R14,DW

OI DW+7,X'0F'

UNPK TBLENGW+18(5),DW+5(3)

WTO MF=(E,TBLENGW-4)

B BEGIN

DC AL2(L'TBLENGW+4,0)

TBLENGW DC C' BYTES USED OF ..... AVAILABLE, FOR LABEL= +COMMAND='

, (COMMANDS USE 60 BYTES EACH)'

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

GET#FLAG DC C' '

GET#HEX MVI GET#FLAG,C'H'

B *+8

GET#DEC MVI GET#FLAG,C'D'

SR R0,R0

GET#IC IC R14,0(R1)

N R14,=F'15'

CLI GET#FLAG,C'D'

BE GET#D

CLI 0(R1),C'0'

BNL *+8

LA R14,9(R14)

SLL R0,4

OR R0,R14

B GET#NEXT

GET#D MH R0,=H'10'

AR R0,R14

GET#NEXT LA R1,1(R1)

CLI 0(R1),C'A'

BNL GET#IC

CVD R0,DW

BR BR

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

OPNSYSIN OPEN (SYSIN,INPUT)

B GOTSYSIN

NXTSYSIN CLI RECORD,C' '

BE GETSYSIN

CLI RECORD,C','

BNE NXTSYSIB

MVC RECORD,RECORD+1

CLC RECORD(11),SPACES

BNE GOTSYSIN

B GETSYSIN

NXTSYSIB TRT RECORD(66),FINDCOMA

BZ GETSYSIN

CLI 1(R1),C' '

BE GETSYSIN

MVC RECORD,1(R1)

B GOTSYSIN

*

GETSYSIN TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN

BZ BEGIN

GET SYSIN,RECORD

GOTSYSIN WTO MF=(E,OUTREC-4)

CLI RECORD,C' '

BE GETSYSIN

CLI RECORD,C'*'

BE GETSYSIN

CLC =C'SYSIN',RECORD

BE NXTSYSIN

*

CLC =C'FLAGS=',RECORD

BNE *+14

MVC FLAGCOMP(3),RECORD+6

B NXTSYSIN

*

CLC =C'LRECL=',RECORD

BNE NOTLRECL

LA R1,RECORD+6

BAL BR,GET#DEC

STH R0,DCBLRECL-IHADCB+ATFILE

B NXTSYSIN

*

NOTLRECL CLC =C'COMMAND=',RECORD

BNE NOTCMD

L R1,CMDLIST

LTR R1,R1

BNZ *+8

L R1,CMDLIST-4

C R1,=A(ENDDOC-64)

BL SAVCMD

WTO 'TOO MANY LABEL= +COMMAND= REQUESTS'

B ERRDONE

SAVCMD MVC 0(60,R1),RECORD+8

LA R1,60(R1)

MVI 0(R1),C' '

ST R1,CMDLIST

* BAL BR,LISTCMDS

B GETSYSIN

*

LISTCMDS LM R2,R3,CMDLIST-4

LTR R3,R3

BZR BR

LISTCMDL MVC OUTREC(99),SPACES

MVC OUTREC(60),0(R2)

WTO MF=(E,OUTREC-4)

TM DCBOFLGS-IHADCB+COMMANDS,DCBOFOPN

BZ BUMPCMDL

PUT COMMANDS,OUTREC

BUMPCMDL LA R2,60(R2)

CR R2,R3

BL LISTCMDL+6

MVC OUTREC(99),SPACES

BR BR

*

SYSIF DC A(FLAGCOMP,8),CL12'COMPRESS='

DC A(FLAGATF,6),CL12'ATFILE='

DC A(FLAGCMDS,7),CL12'CMDFILE='

DC X'FF'

*

CLC RECORD(0),8(R1)

NOTCMD LA R1,SYSIF-20

LA R1,20(R1)

CLI 0(R1),0

BNE NOTFLAG

LM R14,R15,0(R1)

EX R15,NOTCMD-6

BNE NOTCMD+4

LA R15,RECORD(15)

MVC 0(1,R14),1(R15)

B GETSYSIN

*

NOTFLAG LA R4,RECORD

CLC =C'LOADLOC=',RECORD

BNE SYSINLBL

CLC =C'R%',RECORD+9 LOADLOC=9R%

BNE *+20

MVC REGAT+5(1),RECORD+8

MVC AT,REGAT

B NXTSYSIN

CLC =C'R%',RECORD+10 LOADLOC=12R%

BNE *+20

MVC REGAT+4(2),RECORD+8

MVC AT,REGAT

B NXTSYSIN

*

MVC AT+2(5),RECORD+8

B NXTSYSIN

*

SAVELAST DC C'*'

*

SYSINLBL CLC =C'LABEL=',RECORD

BNE BADSYSIN

MVC RECORD,RECORD+6

*

TRT RECORD,FINDSPAC

BCTR R1,0

CLI 0(R1),C','

BE *+8

MVI 1(R1),C','

*

L R0,CMDLIST

LTR R0,R0

BZ NEXTLBL

WTO 'MUST SPECIFY ALL LABEL= BEFORE COMMAND='

B ERRDONE

NEXTLBL DS 0H

MVI RECORD-1,C'>'

* WTO MF=(E,OUTREC-4)

TRT RECORD(17),FINDCOMA

BZ BADSYS01

LA R3,1(R1) SAVE NEXT LBL

MVI 0(R1),C' '

BCTR R1,0

MVC SAVELAST,0(R1)

CLI 0(R1),C'*'

BNE *+8

MVI 0(R1),C' '

LR R4,R1 POINT TO LAST CHAR OF LBL

S R4,=A(RECORD) CALC LBL LENGTH

*

SAVELBL L R2,LABELTBL+4

MVC 0(20,R2),SPACES

MVC 2(0,R2),RECORD

EX R4,*-6 MOVE LABEL TO TBL

LA R4,1(R4)

*

CLI SAVELAST,C'*'

BNE *+8

BCTR R4,0

BCTR R4,0

*

STH R4,0(R2) YES, SAVE LENGTH-1

BAL BR,LISTENT

LA R1,3(R4,R2)

ST R1,LABELTBL+4

CH R4,=H'26'

BH TOOLONG

*

C R1,=A(ENDDOC-44)

BH TOOMANY

MVC RECORD,0(R3) BUMP NEXT UP TO FRONT

CLI RECORD,C' ' Q. END OF LIST?

BH NEXTLBL NO, LOOP'

MVC OUTREC(L'RECORD),SPACES

B GETSYSIN YES, GET NEXT REC.

*

DC AL2(L'LABELMSG+4,0)

LABELMSG DC 2C'LABEL=...,............................'

LISTENT MVC LABELMSG(L'LABELMSG),LABELMSG+L'LABELMSG

CVD R4,DW

OI DW+7,X'0F'

UNPK LABELMSG+6(3),DW+6(2)

MVC LABELMSG+10(0),2(R2)

EX R4,*-6

WTO MF=(E,LABELMSG-4)

BR BR

*

DC F'0'

LISTLBLT LM R2,R3,LABELTBL

CR R2,R3

BER BR

ST BR,LISTLBLT-2

LISTLBL2 LH R4,0(R2)

BAL BR,LISTENT

LA R2,3(R4,R2)

CR R2,R3

BL LISTLBL2

L BR,LISTLBLT-2

BR BR

*

TOOMANY WTO 'TOO MANY LABELS'

B EODSYSIN

TOOLONG WTO 'LABEL SPECIFIED IS TOO LONG'

B EODSYSIN

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

CLC LABEL(0),2(R2)

QLABEL LM R2,R3,LABELTBL

* EX 0,*

QLABEL2 LH R1,0(R2)

EX R1,QLABEL-6

QLABEL3 BE SAVEIT

LA R2,3(R1,R2)

CR R2,R3

BL QLABEL2

BR BR

*

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

* CLC LABEL(0),2(R14)

* QLABEL LA R14,LABELTBL-16

* QLABEL2 LA R14,16(R14)

* CLI 0(R14),0

* BNER BR

* LH R15,0(R14)

* EX R15,QLABEL-6

* BNE QLABEL2

*

SAVEIT MVC SAVEITW+4(66),SPACES

MVC SAVEITW+4(16),OUTREC

MVC SAVEITW+24(12),LABEL

MVC SAVEITW+21(2),SPACES

CLI OUTREC,C'L'

BNE *+10

MVC SAVEITW+21(2),=C'96'

*

LA R2,SAVEITW+4

BAL R14,ADDHEX5

WTO MF=(E,SAVEITW)

TM DCBOFLGS-IHADCB+COMMANDS,DCBOFOPN

BZ ADDCMDS

PUT COMMANDS,SAVEITW+4

ADDCMDS AP #LBLOUT,=P'1'

BR BR

SAVEITW DC H'40,0',CL36' ',CL40' '

*

ADDHEX5 STM R14,R3,12(R13)

CLI 0(R2),C'A'

BNER R14

MVC 64(16,R13),0(R2)

SR R1,R1

LA R15,66(R13)

BAL R14,CONVERT

LA R15,74(R13)

BAL R14,CONVERT

*

ST R1,28(R13)

UNPK 36(9,R13),28(5,R13)

TR 36(8,R13),HEX-240

MVC ADDHEX5W+6(5),39(R13)

MVI ADDHEX5W+11,C'.'

B SKIPW

* WTO MF=(E,ADDHEX5W) WRITE A BREAK POINT

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

SKIPW LM R14,R0,ADDHEX5S HERE WE'RE GOING TO SAVE AN ENTIRE

LTR R14,R14 LINE OF BREAK POINTS

BNZ ADDHEX5M

L R14,=A(ENDDOC-90) START TABLE

LA R15,4(R14) FIRST BREAK POINT LOC

LA R0,72(R14) END OF LIST

MVC 0(4,R14),=X'00540000' WTO LLBB

MVC 4(80,R14),SPACES SPACES

STM R14,R0,ADDHEX5S SAVE TWICE

STM R14,R0,ADDHEX5S+12

ADDHEX5M MVC 0(8,R15),ADDHEX5W+4 ADD A BREAK POINT TO LIST

* MVC 8(2,R15),SPACES INSERT COMMA AFTER

MVI 8(R15),C' ' INSERT COMMA AFTER

LA R15,09(R15) POINT TO NEXT LOC

ADDHEX5C ST R15,ADDHEX5S+4 SAVE

CR R15,R0 Q. END OF LINE?

BL ADDHEX5Z NO, EXIT

BNL ADDHEX5P+4 YES, PRINT THE LINE

*

ADDHEX5P STM R14,R3,12(R13)

LM R2,R3,ADDHEX5S LOAD ADDR

BCTR R3,0 POINT TO END, BACK UP 1

CLI 0(R3),C',' Q. IS THERE A COMMA

* BNE ADDHEX5Z NO, EXIT

* MVI 0(R3),C' ' YES, ERASE IT

B ADDHEX5N

*** WTO MF=(E,(2)) @@@@ AND WRITE THE LINE

*

ADDHEX5N LR R14,R2 HERE, WE'RE GONNA SAVE THAT LINE AND

SH R14,=H'84' THEN PRINT 'EM ALL AT THE END.

LA R15,4(R14) SAVE FIRST LOC

LA R0,72(R14) AND END ADDR

STM R14,R0,ADDHEX5S AND SAVE 'EM THEN EXIT.

MVC 0(4,R14),=X'00540000'

MVC 4(80,R14),SPACES

*

* MVI 4(R2),C' '

* MVC 5(80,R2),4(R2)

* LA R0,4(R2)

* ST R0,ADDHEX5S+4

ADDHEX5Z LM R14,R3,12(R13)

BR R14

ADDHEX5S DC 6F'0'

*

ADDHEX5Y L R2,ADDHEX5S

LA R1,4(R2)

LA R0,6

ADDHEX5$ CLI 0(R1),C' '

BE ADDHEX5#

CLC 0(8,R1),09(R1)

BNE ADDHEX5#

MVC 09(8,R1),=CL8' DUP '

ADDHEX5# LA R1,09(R1)

BCT R0,ADDHEX5$

*

WTO MF=(E,(2))

MVC RECORD+1(80),4(R2)

PUT COMMANDS,RECORD+1

MVC RECORD+1(80),RECORD

*

LA R2,84(R2)

C R2,ADDHEX5S+20

BL ADDHEX5Y+4

BR R14

*

* LR R15,R0

* MVC 0(5,R15),39(R13)

* LM R14,R3,12(R13)

* BR R14

*

LM R14,R15,LABELTBL

CONVERT LA R0,5

SR R2,R2

SR R3,R3

CONVERTI IC R2,0(R15)

CLI 0(R15),C'0'

BNL *+8

LA R2,9(R2)

N R2,=F'15'

SLL R3,4

OR R3,R2

LA R15,1(R15)

BCT R0,CONVERTI

AR R1,R3

BR R14

*

* CONVERT MVC 32(5,R13),0(R15)

* TR 32(5,R13),MAKEHEX

* MVI 48(R13),0

* PACK 49(4,R13),33(7,R13)

* A R1,48(R13)

* BR R14

HEX DC C'0123456789ABCDEF'

ADDHEX5W DC H'12,0',CL8'A'

LTORG

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

PRINT NOGEN

SYSIN DCB DDNAME=SYSIN,DSORG=PS,RECFM=FT,MACRF=GM,LRECL=100, XXXXX

EODAD=EODSYSIN

LISTING DCB DDNAME=LISTING,DSORG=PS,RECFM=FT,MACRF=GM,LRECL=190, XXXXX

EODAD=EODLISTG

ATFILE DCB DDNAME=ATFILE,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=190

COMMANDS DCB DDNAME=COMMANDS,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=72

PRINT GEN

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

FLAGS DC H'40,0',C'3 FLAGS THEN FIELDS'

FLAGCOMP DC C' '

FLAGATF DC C'Y'

FLAGCMDS DC C'Y'

WIDENARO DC C'W'

OPCODE DC CL12' '

OPERAND DC CL32' '

LABEL DC CL16' '

AT DC C'A Z0000.+'

REGAT DC C'A 9R%+'

*

DC H'80,0'

OUTREC DC C' '

RECORD DC CL190' ' <-- MUST BE FOLLOWED BY SPACES

* FOR MVC RECORD,RECORD+##

FINDCHAR DC 64C' ',X'00'

SPACES DC CL191' '

* FOR MVC RECORD,RECORD+##

TEMPREC DS 0CL99 WORK AREA GETTING LABELS

TESTHEX DC 193C' ',6X'00',41C' ',10X'00',6C' '

FINDSPAC DC 64X'00',C' ',XL191'00'

FINDCOMA DC XL64'00',C' ',XL191'00'

ORG FINDCOMA+C','

DC C','

ORG

* FOR MVC RECORD,RECORD+##

MAKEHEX EQU *-193

DC X'FAFBFCFDFEFF',CL9' ',CL32' ',C'0123456789'

*

DC 4CL60' ',X'00'

LABELTBL DC A(LABELTBL+12,LABELTBL+12)

CMDLIST DC F'0'

*

PARMTR DC 256AL1(*-PARMTR)

ORG PARMTR+C'+'

DC C','

ORG PARMTR+C'-'

DC C'='

ORG

*

* NOTE, I BUILD THE LABEL= TABLE ON TOP OF DOC + PARMTR,

* SO THIS SPACE IS NOT WASTED.

*

DOC DC CL61'QBR ASM &SYSDATE AT &SYSTIME CREATES BREAK PTS '

*DC CL61'PARM(SYSIN) MISSING. IF PROVIDED, SKIP ALL OF THIS. '

*DC CL61'. '

*DC CL61'INPUT IS Z390 ASSEMBLY LISTING AND SYSIN CONTROL CARD FILE. '

*DC CL61'YOU CAN ALSO SPECIFY LABELS IN THE PARM FIELD, SUBSTITUTING '

*DC CL61'"+" FOR COMMA AND "-" FOR "=". (PROBABLY NOT WORTH IT.) '

DC CL61'OUTPUT ARE BREAK COMMANDS AND, OPTIONALLY, 2 FILES. '

DC CL61'ATFILE CONTAINS THE LISTING WITH BREAK COMMANDS INSERTED. '

DC CL61'COMMANDS CONTAINS THE Z390 "AT" AND "L" COMMANDS. '

DC CL61'INPUT IS THE LISTING AND THE SYSIN FILE. '

DC CL61'. '

DC CL61'CODE THE FOLLOWING AT THE END OF YOUR PROGRAM, AND IT WILL BE'

DC CL61'ROUNDED UP TO THE NEXT 4K BOUNDARY. WHAT THAT DOES IS MAKE '

DC CL61'PROGRAM OFFSET ADDRESSES MATCH (SORT OF) MEMORY LOCATIONS. '

DC CL61'. '

DC CL61'@@PAD#1 EQU ((*-QBR)/4096+1)*4096 '

DC CL61'@@PAD#2 EQU @@PAD#1-(*-QBR) '

DC CL61' ORG *+@@PAD#2 '

DC CL61' DS 0F '

DC CL61'. '

DC CL61'L FE000.+000826. 96 SAVELAST SAMPLE OF THE OUTPUT '

DC CL61'A FE000.+0008A8. SAVELBL '

DC CL61'A FE000.+0009F2. QLABEL '

DC CL61'A FE000.+0009F6. QLABEL2 '

DC CL61'A FE000.+0009FE. QLABEL3 '

DC CL61' '

DC CL61'A FEA6E. A FEA72. A FEA7A. '

DC CL61'A FE66A. A FE670. A FE6D0. A FE6E2. DUP A FE7C2. '

DC CL61'A FE4B0. A FE4CC. A FE4E0. A FE598. A FE636. A FE63E. '

DC CL61' '

DC CL61'WHAT YOU CAN DO IS TAKE ONE OF THOSE LINES AND PUT IT IN THE '

DC CL61'Z390 COMMAND LINE IN TEST MODE AND HIT ENTER. THEN ERASE THE'

DC CL61'FIRST 10 BYTES, MOVING THE NEXT COMMAND UP AND HIT ENTER. '

DC CL61'6 TIMES DOES THE WHOLE LINE. '

DC CL61'NOT NEARLY MULTILE COMMANDS AT ONCE, BUT IT IS THE BEST THAT '

DC CL61'IS AVAILABLE TODAY. '

DC CL61' '

DC CL61'-- '

DC CL61'L,L 3R% 64,L 7R% 64,T1 <== NOT GOING TO WORK YET. '

ENDDOC DC X'00'

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

@@PAD#1 EQU ((*-QBR)/4096+1)*4096

@@PAD#2 EQU @@PAD#1-(*-QBR)

ORG *+@@PAD#2

*

DS 0F

ORG *-4

$$LOAD DC A(1048572-(*-QBR))

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

END QBR