I've rewritten QBREAK, again and again, leaving out extraneous code and adding a couple things. Latest change is to put the instruction label, not the LABEL= string on the break command, and also the List command. Okay, maybe a couple small changes after that. But they're minor. Just added //NEWLIST to create a listing file that's narrow, so I can have several windows open, side-by-side.
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
WHEN TESTING ASSEMBLER PGMS, IN BOTH MVS AND Z390 ENVIRONMENTS, YOU
CAN SET BREAK POINTS, OR DISPLAY DATA FIELDS. IN MVS, YOU SET A BREAK
POINT BY THE LABEL. AND YOU HAVE TO TELL THE ASSEMBLER THAT YOU'RE
GOING TO USE THE TEST (TSO-TEST) FUNCTION.
IN Z390, YOU SET BREAK POINTS BY MEMORY LOCATION, AND DON'T HAVE TO
TELL THE ASSEMBLER YOU'RE GOING TO USE TEST.
QBREAK ALLOWS YOU TO DEFINE AT WHICH LABELS YOU WANT TO SET BREAK
POINTS, AND THE PROGRAM LOAD LOCATION, AND QBREAK WILL CREATE THE
BREAK POINT COMMANDS (IN THE //BREAK FILE). THEN WHEN YOU RUN
THE PROGRAM, YOU SPECIFY TEST(BREAK) AND Z390 SETS THE BREAK POINTS
AND THEN GIVES YOU CONTROL TO START THE RUN.
I WROTE QBREAK BECAUSE I'M OLD AND MY CODING SKILLS HAVE DETERIORATED
SIGNIFICANTLY, SO I MAKE MORE MISTAKES THAN I DID 50 YEARS AGO.
THE FIRST 4 COMMANDS MUST BE ON SEPARATE RECORDS. LABEL= COMMANDS
CAN BE STACKED. CONTROL CARDS (SYSIN) LOOK LIKE:
DATALEN=120 DEFAULT LENGTH FOR DISPLAY COMMANDS
MAX=54 # OF LABEL ENTRIES STORED IN GETMAIN
NEWLIST=03,17,54,50 FIELD SELECT LOCATION,LENGTH FOR
NARROW COPY OF LISTING
LOADLOC=FE000 PROGRAM LOAD LOCATION
AND THEM LABEL= COMMANDS
NOTE, IF FIRST BYTE IS BLANK,
THEN THE RECORD IS A COMMENT.
COMMAND= JUST PRINTS WHAT YOU
SPECIFY SO YOU CAN COPY/PASTE IT.
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\(YOUR PROGRAM)
LABEL=GET*,PUT*,PASTIDM
LABEL=START,Z*,FOUND+0C.,DATA,INST,PUTBREAK
LABEL=RC 8,CARD,LIN*,ATLINE 40,DW 8,LABEL 44
THIS IS FROM THE SYSPRINT WHEN I WAS TESTING QBREAK.
THE //BREAK FILE ONLY CONTAINS THE "A" RECORDS (AND INTERACTIVE).
A FE000.+00268. GETMAIN
L FE000.+003D4. 120 PUTBADDR
A FE000.+003E2. PUTBREAK
A FE000.+00400. PUTLINE
A FE000.+00498. GETSYSIN
A FE000.+0074E. ZZ
A FE000.+007C4. ZZLOOP
A FE000.+007E8. GETPRN
A FE000.+008B2. GETSTR
A FE000.+008F8.+0C. FOUND
A FE000.+00922. DATA
A FE000.+00950. INST
L FE000.+009BA. 40 ATLINE
L FE000.+00A0A. 44 LABEL
A FE000.+00A36. Z
A FE000.+00A7C. Z390_CLOSE_E
L FE000.+00B2C. 8 RC
L FE000.+00B30. 8 DW
L FE000.+00B51. 120 LINE
L FE000.+00BD6. 120 CARD
INTERACTIVE
//LISTING (PRN) IS THE INPUT LISTING
//SYSIN IS THE CONTROL CARD FILE
//NEWLIST IS A COPY OF THE LISTING THAT IS NARROW
//SYSPRINT SHOWS WHAT QBREAK IS DOING
//BREAK CONTAINS BREAK POINT REQUESTS
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
SET SYSPRINT=%G%.SYSPRINT
SET SYSIN=%G%.SYSIN
SET PRN=%G%.INPUT
SET BREAK=%G%.BREAK
SET BREAK=%G%.BRAKE.BRAKE.TXT
BAT\ASMLG %G%.MLC TEST(BREAK)
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
COMMAND=
LOADLOC=
LABEL=GET*,PUT*,OPENI,OPENI+12,OPENO-6,DW 16,LINE 80,WTO*
LABEL=Z,CLOSE
VER 02.01 STARTED ABOUT 4/5/26, FINISHED 4/10/26
VER 02.02 MOVE FINDCHAR,FINDEND TABLES UP TO GET UNDER 4K 4/10/26
VER 02.03 MOVE FINDCHAR,FINDEND TABLES BACK TO END 4/10/26
VER 02.04 PUT INST LABEL ON BREAK CMD, NOT LABEL= STRING 4/24/26
VER 02.05 PUT INST LABEL ON DATA CMD 5/5
VER 02.06 CORRECTED DATA DISPLAY OPCODE (CHANGED D L)
VER 02.07 CLEAR PRINT LINE BEFORE INTERACTIVE
VER 02.08 ABANDONED.
VER 02.09 ADD NEWLIST NARROW LISTING AND FIX STUFF. 6/18/26
.START ANOP
MACRO
M &TXT
LCLA &N
&N SETA K'&TXT-3
DC AL1(&N),C&TXT
MEND
* ---------------------------------
MACRO
&LBL ERR &BC,&MSG
LCLA &N
&L SETC 'SYS&SYSNDX'
&LBL REVB &BC,&L.Z
BAL R14,ERR
DC AL1(L'&L.M-1)
&L.M DC C&MSG
&L.Z DS 0H
MEND
* ---------------------------------
MACRO
&LBL $$LA ®,&FLD $$LA REVB ????
AIF ('&FLD(1,1)' NE '(').A
&LBL LA ®,0&FLD
MEXIT
.A ANOP
&LBL LA ®,&FLD
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
* ---------------------------------
QBREAK START 0
USING *,13,12
YREGS
B BEG-QBREAK(15)
DC 17F'0'
*
DC AL1(IDMSGL)
IDMSG DC C'QBREAK V02.09 ASM &SYSTIME &SYSDATE, RUN'
IDMSGT DC X'4021207A2020'
IDMSGD DC X'4021204B202020' -/ = X'6061'
IDMSGE DC C' COMMENTS, LINLYONS@YAHOO'
IDMSGL EQU *-IDMSG
IDMSGBF DC 8X'BF'
BEG STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
LA 12,4095
LA 12,1(12,13) INIT DONE.
L 4,0(1)
TIME DEC ,DATATYPE=MMDDYYYY
STM 0,1,12(13)
ED IDMSGT,12(13)
ED IDMSGD,17(13)
NC IDMSGE+2(7),IDMSGBF
NC IDMSGE+11(8),IDMSGBF
NC IDMSGE+L'IDMSGE-5(5),IDMSGBF
B OPEN
*
QDATALEN MVC DATALEN,CARD+8
BR R9
QNEWLIST MVC ANEWLIST,CARD
BR R9
CNEWLIST MVC CARD,ANEWLIST+8
LA R14,ANEWLIST
CNEWLISL MVC DW(5),CARD
CLC =C'00',CARD
ERR BE,'$NEWLIST=LOC,LEN, LOC CANNOT BE 00'
CLC =C'00',CARD+3
ERR BE,'$NEWLIST=LOC,LEN, LEN CANNOT BE 00'
NC DW(5),=X'F0F0FFF0F0'
CLC =C'00,00',DW
ERR BNE,'$BAD NEWLIST= LOC,LEN 2 CHARS EACH'
PACK 16(8,13),CARD(2)
PACK 24(8,13),CARD+3(2)
CVB R0,16(13)
CVB R1,24(13)
BCTR R0,0
BCTR R1,0
STM R0,R1,0(R14)
CLI CARD+5,C' '
BER R9
CLI CARD+5,C','
ERR BNE,'$NEWLIST SEPARATOR/END WRONG'
LA R14,8(R14)
MVC CARD,CARD+6
B CNEWLISL
*
QMAX CLI CARD+4,C'0'
ERR BL,'$MAX=## NOT NUMERIC'
LA R14,CARD+4
SR R1,R1
QMAXL IC R0,0(R14)
N R0,=F'15'
MH R1,=H'10'
AR R1,R0
LA R14,1(R14)
CLI 0(R14),C'0'
BNL QMAXL
LA R1,12(R1)
ST R1,LGETMAIN
CLI 0(R14),C' '
BER R9
ERR B,'$MAX=## MUST END IN BLANK'
*
GETMAIN L R0,LGETMAIN GETMAIN OF 4K ALLOWS FOR
SLL R0,6
ST R0,LGETMAIN
GETMAIN R,LV=(0) 100 LABEL NAMES
ST R1,AGETMAIN
LR R0,R1
STM R0,R1,ATABLE
L R2,LGETMAIN
AR R2,R1
SH R2,=AL2(LDSECT)
ST R2,ETABLE
BR R9
* ====================== START OF FILE OPEN ROUTINE ============
OPEN LA R2,SYSPRINT
BAL R9,OPENO
LA R2,PRN THESE ARE THE FILE OPEN ROUTINES.
BAL R9,OPENI ONCE DONE, WE COULD USE THIS AREA
LA R2,BREAK FOR WORK AREAS.
BAL R9,OPENO
LA R2,SYSIN
BAL R9,OPENI
LA R2,NEWLIST
BAL R9,OPENO
*
FIRSTGET GET SYSIN
CLI 0(R1),C' '
BE FIRSTGET
MVC CARD,0(R1)
PUT SYSPRINT,CARD-1
LA R9,FIRSTGET
*
CLC =C'DATALEN=',CARD
BE QDATALEN
CLC =C'MAX=',CARD
BE QMAX
CLC =C'MAX-',CARD
BE QMAX
CLC =C'NEWLIST=',CARD
BE QNEWLIST
MVC LINE(80),CARD
BAL R9,CNEWLIST
MVC CARD,LINE
BAL R9,GETMAIN
B GOTSYSIN
*
PUSH PRINT
PRINT NOGEN
USING IHADCB,2
OPENMSG DC C'........ OPENED FOR OUTPUT, RECFM= LRECL=..... '
OPENO MVC DW,DCBDDNAM
MVC OPENMSG(8),DW
MVC OPENMSG+20(3),=C'OUT'
OPEN ((2),OUTPUT)
CLC =C'SYSP',DW
BNE OPENM
MVC LINE(IDMSGL),IDMSG
* TR LINE+IDMSGL-26(26),MAKELOW
* TR LINE+IDMSGL-L'IDMSGE+2(L'IDMSGE-2),MAKELOW
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B OPENM
OPENI MVC OPENMSG(8),DCBDDNAM
MVC OPENMSG+20(3),=C' IN'
OPEN ((2),INPUT)
OPENM UNPK OPENMSG+34(3),DCBRECFM(2)
TR OPENMSG+34(2),HEX-240
MVI OPENMSG+36,C' '
LH R0,DCBLRECL
CVD R0,16(13)
OI 23(13),X'0F'
UNPK OPENMSG+43(5),21(3,13)
* CLC OPENMSG(4),=C'SYSP'
* BNE NOTSYSP
* MVC LINE(L'IDMSG),IDMSG
* PUT SYSPRINT,LINE-1
* MVC LINE,LINE-1
NOTSYSP MVC LINE(L'OPENMSG),OPENMSG
B PUTLINE
DROP 2
POP PRINT
* ========================= END OF FILE OPEN ROUTINE ============
* ========================= COMMON WRITE ROUTINES ===============
PUTBADDR DC CL14' ' THIS PREVENTS DUPLICATE BREAK
PUTBREAK CLC PUTBADDR,LINE POINT LOCATIONS, WHEN A LABEL
BER R9 IS FOUND ON A LABEL + CODE.
MVC PUTBADDR,LINE
PUT BREAK,LINE
WTOLINE WTO MF=(E,LINE-5)
PUTLINE PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
* -------------------------------------------------
* ERROR ROUTINE CAN BE USED FROM SEVERAL TESTS.
* IT LISTS THE PROGRAM LOCATION, ALONG WITH THE ERROR MSG.
* -------------------------------------------------
DC F'0'
ERR LA R1,0(R14)
ST R1,ERR-4
SR R1,R13
ST R1,12(R13)
UNPK ERRMSG+13(5),14(3,R13)
TR ERRMSG+13(4),HEX-240
MVI ERRMSG+17,C' '
MVC LINE+1(L'ERRMSG),ERRMSG
SR R1,R1
IC R1,0(R14)
MVC LINE+1+L'ERRMSG(0),1(R14)
EX R1,*-6
TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BO ERRWRITE
OPEN (SYSPRINT,OUTPUT)
ERRWRITE BAL R9,WTOLINE
OI RC,12
L R1,ERR-4
CLI 1(R1),C'$'
BNE GETSYSIN
MVC LINE+1(6),=C'SYSIN='
MVC LINE+7(30),CARD
BAL R9,WTOLINE
B GETSYSIN
ERRMSG DC C'SYSIN ERR AT .... '
*
GETSYSIN GET SYSIN
MVC CARD(80),0(R1)
GOTSYSIN CLI CARD,C' '
BE GETSYSIN SKIP
MVC LINE(100),CARD
BAL R9,PUTLINE
CLC =C'COMMAND=',CARD
BNE NOTCOMM
MVC LINE(80),CARD+8
BAL R9,WTOLINE
B GETSYSIN
*
NOTCOMM CLC =C'LABEL=',CARD
BE QQLABEL
CLC =C'LOADLOC=',CARD
ERR BNE,'$BAD SYSIN KEYWORD, COMMAND=,LOADLOC=,LABEL='
* ---------------------------------------------------------
* ORIGINALLY LOADLOC COULD BE EITHER ADDRESS OR REGISTER.
* HOWEVER, SINCE BREAK POINTS ARE CREATED BEFORE EXECUTION,
* THE STARTING LOC CANNOT BE A REGISTER.
* MUST BE 5 HEX DIGITS. LIKE LOADLOC=80000
* 80000 IS THE DEFAULT, AND DOES NOT NEED TO BE SPECIFIED.
* ---------------------------------------------------------
MVC ATLINEI+2(5),CARD+8
MVC CARD,CARD+14 LOADLOC=80000.,LABEL=
CLI CARD,C' '
BE GETSYSIN WE CAN HAVE LOADLOC=80000,LABEL=...
B NEXTLBL SO THE ENTIRE CONTROL CAN BE IN PARM.
*
DSECT DSECT 0
LEN DS H
STRING DS CL30
ADDLOC DS CL4
DCLENG DS CL4
LDSECT EQU *-DSECT
QBREAK CSECT
*
* OKAY, HERE WE SAVE A LABEL= PARAMETER.
* SAVE THE LENGTH FIRST, THEN THE LABEL.
* WE COULD HAVE LABEL=GET,GET*,GET 96,GET+12,GET-14.
*
QQLABEL MVC CARD,CARD+6 LABEL=GET*,
USING DSECT,7
NEXTLBL L R7,ATABLE+4
MVC LINE(60),CARD
BAL R9,PUTLINE
MVC 0(LDSECT,R7),SPACES
LA R0,LTABLE(R7)
ST R0,ATABLE+4
C R0,ETABLE
ERR BNL,'TOO MANY LABEL= ENTRIES'
TRT CARD(L'STRING),FINDEND
ERR BZ,'$LABEL= STRING TOO LONG'
LR R3,R1
S R3,=A(CARD+1) LABEL=GET LENGTH=4 (WELL 3 AND 2)
LA R0,1(R3)
CLI 0(R1),C'*' LABEL=GET* LENGTH=3
BNE *+6
BCTR R0,0
STH R0,LEN
MVC STRING(0),CARD
EX R3,*-6
CLI 0(R1),C'*'
BNE *+8
LA R1,1(R1)
*
CLC =C' ',0(R1) Q. END OF LABEL=
BE GETSYSIN YES, GO READ.
*
CLI 0(R1),C',' Q. SPECIAL CONTINUATION?
BNE SPECIAL YES, GO DO THAT.
MVC CARD,1(R1) MOVE LEBEL TO FRONT OF CARD
* MVC LINE(80),CARD SET UP TO PRINT IT.
* BAL R9,PUTLINE PRINT IT
B NEXTLBL AND LOOP.
*
* HERE WE SAVE THE +12. OR -14.
* NOBODY WILL EVER USE IT, BUT WE PROMISED.
*
MVC ADDLOC(0),CARD
SAVELOC MVC CARD,0(R1)
TRT CARD+1(4),FINDEND
ERR BZ,'$ERR IN +/- LOCATION OFFSET'
LR R3,R1
S R3,=A(CARD+1)
CH R3,=H'32'
ERR BNL,'$+/- LOCATION VALUE EXCESSIVE, 31 MAX'
EX R3,SAVELOC-6
QNEXT CLI 0(R1),C' '
BE GETSYSIN
CLI 0(R1),C','
ERR BNE,'$UNKNOWN SYSIN ELENMENT'
MVC CARD,1(R1)
B NEXTLBL
*
SPECIAL CLI 0(R1),C'+'
BE SAVELOC
CLI 0(R1),C'-'
BE SAVELOC
CLI 0(R1),C' '
ERR BNE,'$BAD DC LABEL + / -'
CLI 1(R1),C'0'
ERR BL,'$BAD DC LABEL + / - LENGTH'
*
MVC CARD,1(R1)
TRT CARD+1(4),FINDEND
ERR BZ,'$INVALID DC LABEL LENGTH'
LR R3,R1
S R3,=A(CARD+1)
CH R3,=H'5'
ERR BNL,'$DC LABEL LENGTH TOO LONG'
MVC DCLENG(0),CARD
EX R3,*-6
B QNEXT
* ---------------------------------------
ZZ CLI RC,0 Q. ERROR
BNE Z YES, EXIT
* ---------------------------------------
LISTABLE LM R7,R8,ATABLE
LH R1,LEN
CVD R1,DW
OI DW+7,X'0F'
UNPK LINE(3),DW+6(2)
MVC LINE+4(LDSECT-2),2(R7)
BAL R9,PUTLINE
LA R7,LTABLE(R7)
CR R7,R8
BL LISTABLE+4
MVI LINE,C'-'
MVC LINE+1(40),LINE
BAL R9,PUTLINE
* ---------------------------------------
*
* HERE WE'RE GOING TO SET UP A TABLE OF ONLY THE
* FIRST CHARACTERS OF EACH OF THE LABELS.
* THAT ALLOWS US TO NOT TEST IF THE LABEL CANNOT BE IN THE LIST.
*
* IN PROCESSING, FIRST WE LOOK FOR END OF PRN, AND EXIT
* THEN WE LOOK FOR A REASONABLE LOCATION, AND SKIP IF NOT.
* THEN WE LOOK FOR A LABEL, AND SKIP IF BLANK.
* THEN WE TEST THE FIRST CHAR OF THE LABEL, AND SKIP IF NOT =
*
* FIRST SET UP THE TABLE OF FIRST CHARACTERS OF ALL THE LABELS.
*
LM R7,R8,ATABLE LOAD BEG/END OF LABEL TABLE
SR R3,R3
ZZLOOP IC R3,STRING
LA R4,LBLTBL(R3)
MVI 0(R4),4
LA R7,LTABLE(R7)
CR R7,R8
BL ZZLOOP
SLR R10,R10
LR R11,R10
B GETPRN
* -----------------------------------------
* READ A REC. EXIT IF SYM= IS FOUND (END OF ACTIVE LISTING)
* SKIP RECORD IF:
* FIRST CHAR NOT 0 (NOT AN ADDRESS)
* ADDRESS = 000000 (JUNK AT START OF PGM)
* LOC-3 = : (TIME STAMP HEADER)
* LABEL FIELD = BLANK (DUH)
* FIRST CHAR OF LABEL NOT IN LIST OF LABELS.
* -----------------------------------------
MVCFLD MVC 0(0,R1),0(R14)
*
GETPRN GET PRN
LA R11,1(R11) ==== COUNT RECORDS, USED TO FIND ERROR WHEN TESTING
CLC =C'SYM=',1(R1) Q. IN CASE WE MISSED END?
BE Z YES, EOF OF //PRN
CLI 0(R1),C'0' Q. LOCATION?
BNE GETPRN NO.
CLC =C'000000',0(R1) Q. DUMB FIRST RECORDS?
BE GETPRN YES, SKIP
CLI 2(R1),C':'
BE GETPRN
LR R3,R1 POINT TO RECORD
LA R4,53(R1)
*
CLI 53(R3),C'*'
BE SKIPNEW
LA R1,LINE
LA R2,ANEWLIST
CLC =C'EQU ',62(R3)
BNE *+10
MVC 22(18,R3),24(R3)
MVCFLM LM R14,R15,0(R2)
LA R14,0(R14,R3)
EX R15,MVCFLD
LA R2,8(R2)
LA R1,2(R1,R15)
CLI 0(R2),0
BE MVCFLM
PUT NEWLIST,LINE-1
MVC LINE,LINE-1
*
SKIPNEW CLI 53(R3),C' '
BE GETPRN
TRT 0(1,R4),LBLTBL A. VALID FIRST CHAR
BZ GETPRN NO.
SAVLABEL MVC LABEL(LLABELS),SPACES YES, SET UP TO SAVE VALUES
*
* HERE WE'RE GOING TO SAVE THE LABEL, OPCODE, AND 2 BYTES OF OPERAND
* JUST MAKES PROCESSING EASIER.
*
LA R5,LABEL
LA R1,31
BAL R14,GETSTR GET THE LABEL, MAX LENG=31
LA R5,OPCODE
LA R1,8
BAL R14,GETSTR GET THE OPCODE, MAX LENG=8
MVC OPERAND(3),0(R4) SAVE 3 BYTES OF OPERAND (FOR DS 0H)
B TESTLBL
* -------------------------------------------
MVC 0(0,R5),0(R4)
TRT 0(0,R4),FINDEND
GETSTR EX R1,GETSTR-6 THIS ROUTINE SAVES A STRING,
BZ GETPRN AND POINTS TO THE NEXT ONE.
LR R2,R1 LABEL, THEN OPCODE,
SR R2,R4 AND SAVE ADDR OF OPERAND
EX R2,GETSTR-12
TRT 0(15,R1),FINDCHAR
BZ GETPRN
LR R4,R1
BR R14
* -------------------------------------------
* OKAY, GOT THE LABEL, SEE IF IT'S IN THE TABLE.
* IF NOT, GO READ
* IF YES, SET UP THE COMMAND,
* AND DETERMINE IF IT'S DATA OR INSTRUCTION.
* -------------------------------------------
CLC LABEL(0),STRING
TESTLBL LM R7,R8,ATABLE
LA R10,1(R10)
TESTLBLL LH R1,LEN
EX R1,TESTLBL-6
BE FOUND
LA R7,LTABLE(R7)
CR R7,R8
BNL GETPRN
B TESTLBLL
FOUND MVC ATLINE,ATLINEI AH HAH, FOUND ONE
MVC ATLINE+9(5),1(R3) INIT THE INSTRUCTION
CLC =C'DC',OPCODE Q. DATA OR INST.
BE DATA GO TO EITHER DATA OR INST
CLC =C'DS',OPCODE ROUTINE.
BNE INST CONSIDER DS 0H TO BE INST.
CLC =C'0H',OPERAND
BE INST
DATA MVI ATLINE,C'L'
MVC ATLINE+16(4),DCLENG
CLC ATLINE+16(4),SPACES
BNE *+10
MVC ATLINE+17(3),DATALEN DEFAULT DATA LENGTH=48
MVC ATLINE+24(12),LABEL WE WRITE DATA DISPLAY TO THE
MVC LINE(L'ATLINE),ATLINE CONSOLE, BUT NOT THE //BREAK FILE
BAL R9,WTOLINE
B GETPRN
INST MVC ATLINE+15(4),ADDLOC
*** MVC ATLINE+24(12),STRING
MVC ATLINE+24(12),LABEL
MVC LINE(L'ATLINE),ATLINE
BAL R9,PUTBREAK
B GETPRN
* -------------------------------------------------
ATLINEI DC CL80'A 80000.+12345.'
ATLINE DC CL80'A 80000.+00000.'
*
LABEL DC CL32' '
OPCODE DC CL8' '
OPERAND DC CL4' '
LLABELS EQU *-LABEL
* -------------------------------------------------
Z MVC LINE,LINE-1
MVC LINE(11),=C'INTERACTIVE'
BAL R9,PUTBREAK
CLOSE (PRN,,SYSPRINT,,BREAK,,SYSIN,,NEWLIST)
FREEMAIN LM R0,R1,LGETMAIN
FREEMAIN R,LV=(0),A=(1)
SR 15,15
IC 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
* -------------------------------------------------
LTORG
LTABLE EQU LDSECT
ATABLE DC 2A(0)
ETABLE DC A(0)
*
LGETMAIN DC F'400'
AGETMAIN DC F'0'
RC DC X'00'
P0 DC X'0C'
P1 DC X'1C'
DW DC D'0'
HEX DC C'0123456789ABCDEF '
DATALEN DC C'48 '
* ---------------------------------
DC H'80,0',C' '
LINE DC CL133' '
CARD DC CL80' ',CL54' '
ANEWLIST DC CL80'NEWLIST=03,17,54,50'
PUSH PRINT
PRINT NOGEN
DS 0D
PRN DCB DDNAME=LISTING,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=366,EODAD=Z
BREAK DCB DDNAME=BREAK,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
NEWLIST DCB DDNAME=NEWLIST,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
POP PRINT
* -------------------------------------------------
FINDCHAR DC CL256' '
ORG FINDCHAR+C' '
DC X'00'
SPACES EQU *
ORG
*
FINDEND DC XL256'00'
ORG FINDEND+C' '
DC C' '
ORG FINDEND+C','
DC C','
ORG FINDEND+C'+'
DC C'+'
ORG FINDEND+C'-'
DC C'-'
ORG FINDEND+C'*'
DC C'*'
ORG
*
LBLTBL DC XL256'00' THE FIRST CHAR OF EACH LABEL IS KEPT,
* SO WHEN WE FIND A LABEL, A TRT WILL TELL
* US IF THE FIRST CHAR OF THE LISTING LABEL
* MATCHES ANY FIRST CHAR IN A LOADED LABEL.
* YEAH, I'M OLD. AND REMEMBER WHEN IT MATTERED.
*
* -------------------------------------
* UNFORTUNATELY, GONE OVER 4K. THAT'S THE WAY IT GOES.
* -------------------------------------
@@PAD#0 EQU *-QBREAK+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG QBREAK+@@PAD#2
*
* DCBD DEVD=DA
END QBREAK