This is the old code. It uses the name QBREAK. If you want to have both programs, you'll want to change the name of one of them. My suggestion would be this one.
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 TO CREATE
A 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
VER 02.10 WRITE ASSEMBLER ERROR LINES TO NEWLIST 7/17/26
VER 02.11 ALLOW SKIPPING NEWLIST (FIX PRIOR ATTEMPA 10/01/26
VER 02.12 CLOSE FILES INDIVIDUALLY AND LIST 'EM 10/18/26
VER 02.14 PUT 'INTERACTIVE' BACK1(LOST IT BY MISTAKE) 10/19/26
VER 02.15 ADDED CODE TO CREATE MULTIPLE BREAKZ+4+8+10. 10/19/26
VER 02.17 ADDED CODE DISPLAY INSTRUCTION FIELDS 11/07/26
VER 02.18 DISPLAY GETMAIN USE AND LIST DSECT FIELDS 11/08/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.19 ASM &SYSTIME &SYSDATE, RUN'
IDMSGT DC X'4021207A2020'
IDMSGD DC X'4021204B202020' -/ = X'6061'
IDMSGE DC C' COMMENTS, LINLYONS@YAHOO.COM'
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+20(5),IDMSGBF
NC IDMSGE+26(3),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
*
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
BNE SYSINERR
LA R2,NEWLIST
BAL R9,OPENO
LA R9,FIRSTGET
CLC =C'NEWLIST=',CARD
BNE FIRSTGET
BE QNEWLIST
SYSINERR 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 DW,DCBDDNAM-IHADCB(R2)
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(8),DCBDDNAM-IHADCB(R2)
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 CL20' ' THIS PREVENTS DUPLICATE BREAK
PUTBREAK CLC PUTBADDR,LINE POINT LOCATIONS, WHEN A LABEL
BER R9 IS FOUND ON A LABEL + CODE.
MVC PUTBADDR,LINE
PUTBREAP 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 CARD+5(3),SPACES
* ---------------------------------------------------------
MVC CARD+5(3),SPACES
MVC LOADLOC(6),CARD+8-3
CLC =C'R%',CARD+9
BE LOADLMVC
MVC LOADLOC(6),CARD+8-2
CLC =C'R%',CARD+10
BE LOADLMVC
MVC LOADLOC(5),CARD+8
MVI LOADLOC+5,C'.'
LA R1,CARD+14
LOADLMVC MVC ATLINEI+2(6),LOADLOC
TRT CARD+10(8),FINDEND
MVC CARD,1(R1)
B GOTSYSIN
*
DSECT DSECT 0
ADDLOC DS CL4
DCLENG DS CL4
DLOADLOC DS CL5,CL1
LEN DS H
STRING DS CL30
LDSECT EQU *-DSECT
QBREAK CSECT
*
* DSECT DSECT 0
* LEN DS H
* STRING DS CL30
* ADDLOC DS CL4
* DCLENG DS CL4
* DLOADLOC DS CL5,CL1
* 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
MVC DLOADLOC(6),LOADLOC
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
* ---------------------------------------
*
LISTMEM MVC LINE,LINE-1
PUT SYSPRINT,LINE-1
LA R2,2
L R3,ATABLE+4
S R3,ATABLE
L R4,ETABLE
S R4,ATABLE
B MEMCVD
*
LISTMEML MVC LISTMEMM+16(7),=C'ENTRIES'
SR R0,R0
LR R1,R3
D R0,=A(LTABLE)
LR R3,R1
SR R0,R0
LR R1,R4
D R0,=A(LTABLE)
LR R4,R1
*
MEMCVD CVD R3,16(R13)
CVD R4,24(R13)
MVC LINE(L'EDIT5),EDIT5
ED LINE(L'EDIT5),21(R13)
MVC LINE+2+L'EDIT5(2),=C'OF'
MVC LINE+4+L'EDIT5(L'EDIT5),EDIT5
ED LINE+4+L'EDIT5(L'EDIT5),29(R13)
MVC LINE+6+L'EDIT5+L'EDIT5(L'LISTMEMM),LISTMEMM
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BCT R2,LISTMEML
PUT SYSPRINT,LINE-1
BR R9
*
LISTMEMM DC C'AVAILABLE TABLE BYTES USED'
EDIT5 DC X'4020206B202120'
*
ZZ BAL R9,LISTMEM REPORT GETMAIN STATS
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
GOTPRN CLC =C'SYM=',1(R1) Q. IN CASE WE MISSED END?
BE Z YES, EOF OF //PRN
CLC =C'AZ390E',0(R1)
BE PUT390E
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)
*
TM DCBOFLGS-IHADCB+NEWLIST,DCBOFOPN
BZ SKIPNEW
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
B SKIPNEW
* B PUTNEWL
*
PUT390E TM DCBOFLGS-IHADCB+NEWLIST,DCBOFOPN
BZ GET390I
MVC LINE(18),0(R1)
MVC LINE+19(33),53(R1)
PUT NEWLIST,LINE-1
GET390I GET PRN
CLI 0(R1),C'0'
BE GOTPRN
CLI 0(R1),C'A'
BNE GET390I
* MVC LINE(55),0(R1)
MVC LINE,LINE-1
B SKIPNEW PUTNEWL
*
PUTNEWL PUT NEWLIST,LINE-1
MVC LINE,LINE-1
B SKIPNEW
*
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
TESTLBLN LA R7,LTABLE(R7)
CR R7,R8
BNL GETPRN
B TESTLBLL
DC 2F'0'
FOUND STM R7,8,FOUND-8
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(4),DATALEN DEFAULT DATA LENGTH=48
MVC ATLINE+22(12),LABEL WE WRITE DATA DISPLAY TO THE
MVC LINE(L'ATLINE),ATLINE CONSOLE, BUT NOT THE //BREAK FILE
MVC LINE+2(6),DLOADLOC
BAL R9,WTOLINE
B TRYMORE
*** MVC ATLINE+24(12),STRING
INST MVC ATLINE+15(4),ADDLOC
MVC ADDLOC,SPACES
MVC ATLINE+22(8),LABEL
*** MVC ATLINE+31(3),OPCODE WRONG !!!!!
LA R4,ATLINE+32
MVC 0(36,R4),SPACES
CLC ATLINE+15(2),SPACES
MVC ATLINE+2(6),DLOADLOC
BNE *+8
BAL R9,MAKELIST
MVC LINE(L'ATLINE),ATLINE
BAL R9,PUTBREAK
B TRYMORE
*
TRYMORE LM R7,R8,FOUND-8
B TESTLBLN
* -------------------------------------------------
MAKELIST CLI 7(R3),C' '
BER R9
CLI 6(R3),C' '
BNER R9
LA R14,11(R3)
CLI 8(R14),C' '
BNE R9
MVC 31(12,R4),7(R3)
MAKELOOP SR R1,R1
IC R1,0(R14)
CH R1,=H'239'
BH *+8
LA R1,57(R1)
N R1,=F'15'
CVD R1,DW
MVC MAKESAMP(4),ED3
ED MAKESAMP(4),DW+6
MVI MAKESAMP,C'L'
MVC MAKESAMP+7(3),1(R14)
MVC 0(14,R4),MAKESAMP
LA R4,L'MAKESAMP(R4)
LA R14,4(R14)
CLI 0(R14),C' '
BNE MAKELOOP
BR R9
ED3 DC X'40202120'
*
MAKESAMP DC C'L 3R%+123. 32 '
* REGISTER DC C' 0 1 2 3 4 5 6 7 8 9101112131415'
* ============================================
ATLINEI DC CL80'A 80000.+12345.'
ATLINE DC CL80'A 80000.+00000.'
*
LABEL DC CL32' '
OPCODE DC CL8' '
OPERAND DC CL4' '
LLABELS EQU *-LABEL
* -------------------------------------------------
ZDCBLIST DC A(SYSIN,BREAK,PRN,NEWLIST,SYSPRINT,0)
CLOSE LA R3,ZDCBLIST
L R2,0(R3)
MVC LINE+2(5),=C'CLOSE'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLOSETM TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZ NOCLOSE
CLOSE ((2))
CLI 6(R3),0
BZ NOCLOSE
MVC LINE+2(8),DCBDDNAM-IHADCB(R2)
MVC LINE+11(6),=C'CLOSED'
PUT SYSPRINT,LINE-1
NOCLOSE LA R3,4(R3)
L R2,0(R3)
LTR R2,R2
BP CLOSETM
BR R9
* -------------------------------------------------
Z MVC LINE,LINE-1
MVC LINE(11),=C'INTERACTIVE'
BAL R9,PUTBREAP
BAL R9,CLOSE
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
LOADLOC DC CL5' ',C'.'
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
* -------------------------------------------------
FINDCOMA DC XL(C','-C' ')'00'
FINDSPAC DC XL256'00'
ORG FINDSPAC+C' '
DC C' '
ZEROS EQU *
ORG
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