When parsing control cards, there can be lots of errors. I have a general error routine that displays the location of the problem, and an error msg. But, often similar errors can occur in different places, so I've started coding extended descriptions in comments following the ERR macro, where I can be more verbose with the description while at the same time, not making my program inordinately longer. QERR reads the listing and produces, essentially an error manual for that program, that lists the errors identified, and the extended descriptions, w/o having to look through the code, although, the code location is also displayed so one could go look at the actual listing. This that QERR program, that produces the error manual.
AGO .START start with stuff used during Z390 testing.
C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
QERR ASM, LINK, RUN
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
SET SYSPRINT=%G%.SYSPRINT
SET SYSIN=%G%.SYSIN
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\SPLITNEW.PRN
SET OUT=%G%.OUT
SET BREAK=%G%.BRAKE.BRAKE.TXT
BAT\ASMLG %G%.MLC TIME(2)
TEST WITH BREAK POINTS.
BAT\EZ390 %G%.MLC TEST(BREAK) TIME(2999)
CREATE FILE OF BREAK POINTS
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
SET LISTING=%G%.PRN
SET SYSIN=%G%.BREAK.SYSIN.TXT
SET BREAK=%G%.BREAK.BREAK.TXT
SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
LOADLOC=FF000. BREAK POINTS
LABEL=Z,ZZ
.START ANOP
AGO .START Z390 TEST STUFF IS FIRST.
C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
QERR ASM, LINK, RUN
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
SET SYSPRINT=%G%.SYSPRINT
SET SYSIN=%G%.SYSIN
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\SPLITNEW.PRN
SET OUT=%G%.OUT
SET BREAK=%G%.BRAKE.BRAKE.TXT
BAT\ASMLG %G%.MLC TIME(2)
RUN WITH BREAK POINTS
BAT\ASMLG %G%.MLC TEST(BREAK) TIME(2999)
CREATE THE BREAK POINT FILE
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QERR
SET LISTING=%G%.PRN
SET SYSIN=%G%.BREAK.SYSIN.TXT
SET BREAK=%G%.BREAK.BREAK.TXT
SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
LOADLOC=FF000. BREAK POINT CONTROL CARDS.
LABEL=GETLIST+4,GETIN*,Z+8.
.START ANOP
* ---------------------------------
MACRO
&LBL ERR &BC,&MSG
LCLC &L
LCLA &N
&N SETA K'&MSG-3
&L SETC 'SYS&SYSNDX'
&LBL REVB &BC,&L.Z
BAL R14,ERR
&L.L DC AL1(&N),C&MSG
&L.Z 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
* ---------------------------------
QERR START 0
USING *,13
YREGS
B ERRSTART-*(R15)
DS 17F
IDMSG DC C'QERR V02.01 ASM &SYSDATE &SYSTIME LINLYONS AT YAHOO'
IDMSGED DC X'BFBFBFBFBFBFBFBFFFBFBFFFBFBFBFBFBF'
*
* ERR
**QERR IS USED TO PROVIDE ADDITIONAL EXPLANATION OF ERR MSGS.
**IT READS THE LISTING, AND PRINTS THE LINES THAT START WITH **
**CODED AFTER THE ERR MACRO.
**IT'S A GOOD PLACE TO PUT PROGRAM DESCRIPTIONS FOR OLD PROGRAMMERS
**WHO CANNOT REMEMBER WHAT THEY WERE DOING, OR WHY.
**
**YOU CAN CODE * ERR AND FOLLOW THAT, WITH A DESCROPTION
**OF THE PROGRAM, BUT IT MUST BE CODED EARLY BECAUSE QERR
**PROCESSES THE LISTING SEQUENTIALLY, AND YOU'D WANT THAT TO BE FIRST.
*
ERRSTART STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R3,0(R1)
LA R2,SYSPRINT
BAL R9,OPENOUT
LA R2,IN
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
PUT SYSPRINT,LINE-1
SR R10,R10
SR R11,R11
SR R12,R12
ERR B,' FILES OPEN, GO TO PROCESSING' <== COL-1 BLANK = MSG
**INFORMATIONAL MSG INDICATING START
*
GETSKIP GET IN
AP #IN,P1
LA R10,1(R10)
CLI 0(R1),C'0' SKIP OVER MACRO DEFINITOINS
BNE GETSKIP AND OTHER STUFF BEFORE
CLC =C'000000',0(R1)
BE GETSKIP
MVC DW(6),0(R1)
NC DW(6),=C'000000'
CLC DW(6),=C'000000'
BNE GETSKIP
BGET B GETIN
*
* LA R2,SYSIN
* BAL R9,OPENIN
*
OPENMSG DC C' OPENED FOR OUTPUT, RECFM= LRECL=..... '
USING IHADCB,2
PUSH PRINT
PRINT NOGEN
OPENOUT MVC DW,DCBDDNAM
CLC =H'0',DCBLRECL
BNE OPENO
MVC DCBRECFM,DCBRECFM-IHADCB+IN
MVC DCBLRECL,DCBLRECL-IHADCB+IN
OPENO MVC OPENMSG+12(3),=C'OUT'
OPEN ((2),OUTPUT)
CLI DW,C'S'
BNE LISTDCBM
MVC LINE(L'IDMSG),IDMSG
NC LINE+L'IDMSG-L'IDMSGED(L'IDMSGED),IDMSGED
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B LISTDCBM
OPENIN MVC DW,DCBDDNAM
OPEN ((2),INPUT)
MVC OPENMSG+12(3),=C' IN'
POP PRINT
LISTDCBM MVC LINE(8),DW
UNPK OPENMSG+26(3),DCBRECFM(2)
TR OPENMSG+26(2),HEX-240
MVI OPENMSG+28,C' '
LH R0,DCBLRECL
CVD R0,16(13)
OI 23(13),X'0F'
UNPK OPENMSG+35(5),21(3,13)
MVC LINE+8(L'OPENMSG),OPENMSG
POP PRINT
DROP 2
PUTLINE PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
* ============== THIS IS BOTH A MSG RTN, AND AN ERROR MSG RTN =========
* THERE ARE 3 OPTONS. NORMAL PRINT MSG AND ABEND
* IF MSG STARTS WITH BLANK, PRINT MSG, RETURN
* IF MSG STARTS WITH $, PRINT CARD, MSG, ABEND
DC F'0'
MVC LINE+11(0),1(R14)
ERR LA 14,0(14)
ST 14,ERR-10
LR 15,14
SR 15,13
ST 15,8(13)
MVC LINE,LINE-1
MVC LINE(3),=C'ERR'
UNPK LINE+4(5),10(3,13)
TR LINE+4(4),HEX-240
MVI LINE+8,C' '
IC 15,0(14)
CLI 1(R14),C' '
BNE ERRMSG
MVC LINE(3),=C'MSG'
ERRMSG EX R15,ERR-6
L 14,ERR-10
*
ERR$ CLI 1(R14),C'$' IF ERR MSG STARTS WITH $, THEN
BNE ERRPUT PRINT, THE CURRENT CARD IMAGE.
PUT SYSPRINT,CARD-8
MVI LINE+11,C' '
ERRPUT PUT SYSPRINT,LINE-1
L 14,ERR-10
CLI 1(R14),C' '
BE ERRRET
ABEND 1
ERRRET MVC LINE,LINE-1
LA R15,240
SH R14,=H'8'
EX R15,0(R14)
* ================================================================
*
ERR BE,'TESTMSG'
**THIS IS A TEST ERROR MSG
**THAT CONTAINS
**4 LINES
**THAT SHOULD BE PRINTED
ERR B,'$TEST MSG2'
**THIS IS ANOTHER EST MEG
**THAT ONLY
**CONTAINS 3 LINES.
*
ERR BNE,' ANOTHER TESTMSG;'
**OH MY, HOW MANY OF THESE DO WE HAVE TO HAVE?
**WELL, THERE AE 3 FUNCTIONS.
**IF THE FIRST BYTE OF THE MSG IS BLANK, RETURN TO CALLER AFTER PRINT
**IF THE FIRST BYTE OF HTE MSG IS "$" THEN PRINT THE CURRENT ELEMENT
**IF NOT ONE OF THOSE, IT'S AN ERROR MSG, PRINT, THEN ABEND.
**(AND I CANNOT THINK OF ANY OTHER FUNCTIONS I'D LIKE.)
*
GETLIST AP #IN,P1
GET IN
LA R3,0(R1)
CLI 0(R3),C'0'
BNE GETLIST
BR R9
*
* ERR
**QERR IS USED TO PROVIDE A LIST OF ERR MSGS, AND ADDITIONAL
**TEXT DESCRIBING THE PROBLEM. WHEN * ERR IS USED, THEN
**THE USER CAN PROVIDE AN EXTENDED PROGRAM DESCRIPTION.
**GOOD FOF OLD CODERS WHO CANNOT REMEMBER WHAT THEY WERE DOING, OR WHY.
*
GETIN0 PUT OUT,LINE-1
MVC LINE,LINE-1
GETIN BAL R9,GETLIST
CLC =C' ABEND ',61(R2)
BE GETIN4A
CLC =C'ERR ',62(R3)
BNE GETIN
AP #ERR,P1
LA R11,1(R11)
CLI 53(R3),C'*' THIS IS USED TO PRODUCE PROGRAM
BE GETIN4 DESCRIPTION
GETIN2 BAL R9,GETLIST
* TRAC GETIN2
CLC =C'AL1(',68(R3)
BE GETIN2A
CLC =C'SYS',53(R3)
BNE GETIN2
GETIN2A LA R10,1(R10)
MVC LINE(5),1(R3)
MVC DW(2),7(R3)
TR DW(2),MAKEHEX-193
IC R5,DW
IC R0,DW+1
SLL R5,4
OR R5,R0
N R5,=F'255'
LA R6,1(R3)
*
LA R6,66(R3)
GETIN2L LA R6,1(R6)
CLI 0(R6),C' '
BE GETIN3-2
CLC =C'),C',0(R5)
BNE GETIN2L
B GETIN3M
*
SR R6,R6
*
GETIN3 BAL R9,GETLIST
LA R12,1(R12)
LA R6,68(R3)
* TRAC GETIN3
MVC LINE+6(0),2(R6)
GETIN3M EX R5,*-6
PUT OUT,LINE
MVC LINE,LINE-1
BAL R9,GETLIST
B GETIN4
*
GETIN4A MVC LINE(5),1(R3)
MVC LINE(55),53(R3)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
GETIN4B BAL R9,GETLIST
CLI 52(R2),C'+'
BE GETIN4B
B GETIN4C
*
GETIN4 BAL R9,GETLIST
* TRAC GETIN4
GETIN4C CLC =C'SYS',53(R3)
BE GETIN4
CLC =C'**',53(R3)
BNE GETIN0
MVC LINE+6(69),55(R3)
PUT OUT,LINE
MVC LINE,LINE-1
B GETIN4
* --------------------------------------
EDIT15 DS 0XL20
DC X'40202020',3X'6B202020',X'6B212020'
Z ERR B,' DONE WITH PROCESSING'
LA R2,2
LA R3,#IN
##LOOP MVC LINE(L'EDIT15),EDIT15
LA R1,LINE+L'EDIT15-3
EDMK LINE(L'EDIT15),0(R3)
MVC LINE+L'EDIT15+2(24),8(R3)
MVC LINE(88),0(R1)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R3,32(R3)
BCT R2,##LOOP
* ERR B,'DONE WITH PROCESSING, ABEND U0001 (FOR TESTING)'
**TYPICALLY INDICATES AN ERROR.
**LIST THE LOCATION AND ERROR TEXT, AND ABEND U0001
CLOSE (IN,,OUT,,SYSPRINT)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
*
LTORG
#IN DC PL8'0',CL24'RECORDS READ'
#ERR DC PL8'0',CL24'ERR STATEMENTS FOUND'
P0 DC X'0C'
P1 DC X'1C'
HEX DC C'0123456789ABCDEF'
DC CL9' CARD= '
CARD DC CL133' '
*
SAVE DC 2CL24' '
LINE DC CL133' '
DC H'80,0',C' '
TRACLINE DC CL133' TRACE '
DW DC 2D'0'
* ---------------------------------
PUSH PRINT
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=266,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=80
*SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=80,EODAD=ZZ
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
POP PRINT
* -------------------------------------------------
MAKEHEX DC X'0A0B0C0D0E0F'
SPACES DC 41C' ',X'00010203040506070809'
* -------------------------------------------------
@@PAD#0 EQU *-QERR+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG QERR+@@PAD#2
*
* DCBD DEVD=DA
END QERR