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