This is the current source code for SAYTRACE. I think this works. Sometimes it stops after the WTOR, and I haven't a clue why. If anyone knows, please tell me. Othet than that, it does seem to work, the way that I'd intended it to.
I don't envy anyone who gets stuck working on my code. I rarely write comments, considering it more important that I maintain my train of thought rather than get distracted. Sometimes I go back later and add comments. Other times, when I have to go back and fix the mess I made, then sometimes I do.
There are a couple pages of stuff I use setting up new programs. Setting up includes creating the .MLC file and the .BAT file to assemble it. The sample I start with is at the front of the program. To assemble your program, you want to either include the SAY and SAYINIT macros in the source of your programs to test, or create SAY.MAC and SAYINIT.MAC members in your source file.
LCLB &QTEST
&QTEST SETB 0 1=TEST CODE
*
AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE
TEST CMD: S FF3FE.!=X'8D' <===
test(path\filename.xxx)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE
BAT\ASMLG %G%.MLC TIME(1)
test(path\filename.xxx)
--JUST TEST ------------------------------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACET
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE
SET LISTING=%G%.PRN
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\RANDY.MLC
BAT\EZ390 %G%.MLC TEST
PARM(WHATEVER)
--CREATE FILE OF BREAK POINT COMMANDS. --------------
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE
SET LISTING=%G%.PRN
SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT
SET BREAK=%G%.BREAK.BREAK.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK.MLC
C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACEB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE
SET LISTING=%G%.PRN
SET ATFILE=%G%.BREAK.ATFILE.TXT
SET COMMANDS=%G%.BREAK.COMMANDS.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
--//SYSIN INPUT TO CREATE BREAKPOINT COMMANDS. ------------
LOADLOC=FF000 13R%
LABEL=PRINTR2,ERR*,MSG*,Z,ZS,GETMAIN,TRY*,SET*,SAV*,QFREQ,QS1*,QS9*
LABEL=TES*,EDIT0*,GETIN,WRITOUT,
LABEL=AGETMAIN,CARD,LINE,
COMMAND=
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACE ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACET EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SAYTRACEB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
-----------------------------------------------------------
.START ANOP
*
MACRO
&LBL SAY &TEXT
LCLC "E
"E SETC ''''
&LBL L R15,=V(SAYTRACE)
SR R1,R1
AIF ('&TEXT'(1,1) EQ '"E').DC
AIF ('&TEXT' EQ 'END').END
AIF ('&TEXT' EQ '').NOTEXT
MNOTE 12,'SAY MACRO ERROR'
.NOTEXT AIF ('&LBL' EQ '').NOLBL
BALR 14,15
DC CL8'&LBL'
` MEXIT
.NOLBL BALR 14,15
DC AL2(0)
MEXIT
.DC BALR 14,R15
DC CL8&TEXT
MEXIT
.END BAL 1,*+12
DC AL4(*+4)
DC CL4'END '
BALR 14,15
MEND
*
MACRO
&LBL SAYINIT &STOP=999999999999999,®S=,&FIELDS=,&CHANGE=, X
&MAXSAY=100,&CSECT=0,&DCB=0
* SAYINIT STOP=0,DCB=0,REGS=(4,5,6),MAXSAY=100,CSECT=NAME, X X
* FIELDS=(SAV,8,SET4,4),CHANGE=(&SYSNDX,1,0,INIT,400,0),
LCLC &L,&A,&B
LCLA &N,&M
&N SETA &SYSNDX
&L SETC 'SYS&N'
.* &N SETA 1
.* &M SETA 2
.* &A SETC '&FIELDS(&N)' <=== WORKS
.* &B SETC '&FIELDS(1+&N)' <== WORKS
.* MNOTE ,'A= &A '
.* MNOTE ,' B=&B '
CNOP 0,4
&LBL BAL 1,&L.Z
DC A(*+4)
DC CL6'SAYINI'
DC AL2(&L.Z-&L.A-5)
&L.A DC PL8'0' SAY#
DC PL8'&STOP' STOP=###
&L.R DC 8X'FF'
AIF ('®S' EQ '').NOREGS
ORG *-8
DC AL1®S MACRO EXPANSION ERROR
ORG &L.R+7
DC X'FF'
.NOREGS DC A(&DCB) DCB
DC A(&CSECT) CSECT ADDRESS
DC A(&MAXSAY) MAX SAY INSTS USED
.*
.*
&L.$ DC A(&L.F,&L.C) FIELDS= AND CHANGE=
AIF ('&FIELDS' EQ '').NOF
&L.F DC A&FIELDS,X'FFFFFFFF'
AGO .TRYC
.NOF ORG &L.$
DC X'FF'
ORG
&L.F DC X'FFFFFFFF'
.*
.*
.TRYC AIF ('&CHANGE' EQ '').NOC
&L.C DC AL4&CHANGE,X'FFFFFFFF'
AGO .PASTC
.NOC ORG &L.$+4
DC X'FF'
ORG
&L.C DC X'FFFFFFFF'
.PASTC DC V(SAYTRACE)
&L.Z L R15,*-4
BALR 14,15
MEND
*
MACRO
&LBL COMONMSG &TEXT
LCLA &N
&N SETA K'&TEXT-3
&LBL DC AL1(&N),C&TEXT
MEND
*
DSECT DSECT 0
DS CL6 IDENTIFIER
DS HL2 LENGTH OF PARAM LIST
SAY# DS PL8 SAY COUNT # OF CALLS
STOP DS PL8 STOP AT SAY # STOP AFTER THIS MANY
REGS DS XL8 REGS LIST
DCB DS A DCB ADDRESS USER DEFINED AND OPENED DCB
CSECTADR DS A CSECT ADDRESS USER PROGRAM LOAD ADDRESS
MAXSAY DS F MAX SAY, SO WE CAN GETMAIN ENOUGH SPACE
FIELDS DS A A(FIELDS) LIST POINTER TO (LOC,LEN,LOC,LEN)
ACHANGE DS A A(CHANGES) LIST POINTER TO (LOC,LEN,0,LOC,LEN,0)
LCHANGE EQU 12
*
SAYTRACE START 0
USING *,12
PUSH PRINT
PRINT NOGEN
YREGS
POP PRINT
B BEGIN-SAYTRACE(15)
IDLINE DC C'SAYTRACE V1.0 &SYSDATE &SYSTIME'
BEGIN STM 14,12,12(13)
STM 0,15,CALLREGS-SAYTRACE(R15)
LR 12,15
LA 2,SAVEAREA
ST 2,8(13)
ST 13,4(2)
LR 13,2
L R10,ADSECT
USING DSECT,10 12=BASE, 11=TEST BASE, 10=SAYINIT
*
LTR 1,1 Q. SAY , OR SAY 'LABEL' OR LABEL SAY
BZ NORM
L R2,0(R1)
AIF (&QTEST EQ 0).NT1
CLI 1(R2),4
BE TEST
.NT1 ANOP
CLC =C'SAYI',0(R2)
BE FIRSTIME
CLC =C'END',0(R2)
BNE *+14
MVC SAYTRACE(4),=X'1BFF07FE'
B RETURN
EX 0,*
* --------------------------------------------------------
SAVEAREA DC 18F'0'
CALLREGS DC 16F'0'
*
* OPTIONS ARE R1=0 CALL W/O LABEL R14=H'0'
* CALL WITH LABEL R14,CL8'LABEL'
* NORMAL PARAM LIST, L R1,0(R1)
* R1=04TEST TEST
* R1=END END
* R1=??? SAYINIT
*
* --------------------------------------------------------
FIRSTIME LA R10,0(R2)
ST R10,ADSECT
BAL R9,INIT
B SAVECH
* --------------------------------------------------------
NORM MVC LINE,LINE-1
BAL R9,DOLABEL
LA R8,LINE+9
BAL R9,DOCOUNTS
BAL R9,DOREGS
BAL R9,DOFIELDS
BAL R9,WTO1LINE
BAL R9,DOCHANGE
SAVECH BAL R9,SAVCHANG
B DONE
* ------------------------------------
DONE CLC SAY#,STOP
BE TRYAGAIN
DONE2 L R13,4(R13)
LM 14,12,12(13)
SR 15,15 (WHO CHECKS RET CODES THESE DAYS?)
LTR R1,R1 Q. PARAM LIST?
BNZ QEND
CLI 0(R14),0
BE 2(R14)
B 8(R14)
*
QEND L R1,0(R1)
CLC =CL6'SAYINI',0(R1)
BER R14
CLC =C'END',0(R1)
BER R14
*
EX 0,*
CLI 0(R14),0
BER R14 YES, RET
CLI 0(14),X'FF' ALL DONE?
BE 2(14)
CLI 0(14),X'20' Q. LOCATION PASSED?
BL 2(14)
B 8(14) LABEL MUST HAVE BEEN PASSED.
*
WTO1LINE WTO MF=(E,LINE-5)
MVC LINE,LINE-1
BR 9
*
DOLABEL CLI STOP,X'FF'
BNE NOTERROR
BAL R1,BAD1
DC H'1'
*
NOTERROR MVC LINE(8),0(R14)
CLI 0(R14),0
BNER R9
*
ADDR MVC LINE(8),LINE-1
L R1,CALLREGS+56
S R1,CSECTADR
ST R1,12(R13)
UNPK LINE+1(5),14(3,R13)
TR LINE+1(4),HEX-240
MVI LINE+5,C' '
BR R9
* --------------------------
SAY#LOC DC A(SAY#+7,0)
DC F'0'
DOCOUNTS ST R9,DOCOUNTS-4
LA R8,LINE+9
AP SAY#,P1
UNPK DW(15),SAY#
OI DW+14,C'0'
LA R15,DW
LA R15,1(R15)
CLI 1(R15),C'0'
BE *-8
LR R14,R15
LR R0,R15
L R15,=A(DW+14)
SR R15,R0
STM R14,R15,SAY#LOC
BAL R9,MVCCOUNT
BAL R9,GETLIST
OI DW+14,C'0'
LM R14,R15,SAY#LOC
BAL R9,MVCCOUNT
L R9,DOCOUNTS-4
BR R9
*
MVC 0(0,R8),0(R14)
MVCCOUNT OI DW+15,C'0'
EX R15,MVCCOUNT-6
LA R8,2(R8,R15)
* WTO MF=(E,LINE-5)
BR R9
*
GETLIST L R14,4(R13)
L R14,12(R14)
LA R14,0(R14) CLEAR HIGH BITS
S R14,CSECTADR
*
L R1,LIST SCAN LIST OF CALL LOCATIONS
LTR R1,R1
BNZ QLIST+4
L R1,AGETMAIN+4
B NEWLIST
QLIST LA R1,LLIST(R1)
C R14,0(R1) Q. THIS SAME ENTRY
BE THISLIST YES, GO COUNT
C R1,LIST-4 Q. END OF SAVED ENTRIES?
BL QLIST NO, LOOP
NEWLIST ST R14,0(R1)
LA R0,LLIST(R1)
ST R0,LIST-4
ZAP 4(8,R1),P0 INIT COUNT
THISLIST AP 4(8,R1),P1 COUNT
UNPK DW(15),4(8,R1)
BR R9
* BAL R9,SAY#EDIT-4
* *
* SAY#MVC MVC 0(0,R8),0(R1)
* LM R14,R15,SAY#LOC
* SAY#EDIT LA R1,DW+15
* SR R1,R15
* EX R15,SAY#MVC
* LA R8,2(R8,R15)
* BR R9
*
ADSECT DC F'0'
DC F'0'
LIST DC F'0'
LLIST EQU 12
* ------------------------------------
* M1 COMONMSG 'STOP= REACHED. ...... IS THE AREA TO CHANGE STOP#'
* COMONMSG 'WHERE YOU CAN SET A NEW STOP=#'
* COMONMSG 'MAKE ANY CHANGES YOU WANT, THEN GO OR SET'
* M3 COMONMSG 'FF???.=C''+123'' OR C''1234'' TO RESET STOP= THEN GO'
* DC CL4' ',X'FFFFFFFF'
*
TRYWTO DC F'0',CL70' '
TRYMVC MVC TRYWTO+5(0),1(R2)
TRYPACK PACK 12(8,13),0(0,R14)
BAD## WTO 'REPLY=C''###'' NOT NUMERIC,TRY AGAIN?'
B TRYAGAIN
*
PACK 12(8,R13),0(R14)
TRYAGAIN MVC DW(16),ZEROS
MVC ECB,ZEROS
B WTOR
*
* LA R0,DW
* LA R1,M3+1
* BAL R14,CONVADDR
* MVC M1+16(6),M3+1
* LA R2,M1
* BAL R9,COMONWTO
* LA R15,DW
* B STOPADR
*
ECB DC F'0'
WTOR WTO 'REPLY ### OR +## TO SET NEW STOP=, OR +##/###,ABEND'
WTOR 'TO SET NEW STOP, AND SET NEW BREAK PT',DW,16,ECB
CLI DW,0
BNE STOPADR
WAIT ECB=ECB
STOPADR CLI DW,0
BE RETURN
OC DW,SPACES
CLI DW,C'G'
BE RETURN
*
LA R1,DW
CLI DW,C'+'
BE *+14
ZAP STOP,P0
B *+8
*
LA R1,1(R1)
*
CLI 0(R1),0
BE TRYLR
CLI 0(R1),C'0'
BL BAD##
TRYLR LR R14,R1
LA R1,1(R1)
CLI 0(R1),C'0'
BNL *-8
LR R15,R1
BCTR R1,0
SR R1,R14
EX R1,TRYPACK
AP STOP,12(8,R13)
CLI 0(R15),0
BE RETURN
CLC =C',ABEND',0(R15)
BNE RETURN
*
LA R0,RETURN
LA R1,WTOAB+10
BAL R14,CONVADDR
LA R15,WTOAB+8
WTOAB WTO 'J ...... <=== TO CONTINUE'
EX 0,*
*
DS 0H
DC C' F1='
DOFIELDS CLI FIELDS,X'FF'
BER R9
L R4,FIELDS
DOFLOOP LM R2,R3,0(R4)
CLI 0(R2),X'FF'
BE DOF90
MVC 0(3,R8),DOFIELDS-3
LA R8,3(R8)
*
* LR R0,R2
* S R0,CSECTADR
* ST R0,12(R13)
* MVC 0(3,R8),DOFIELDS-3
* LA R8,3(R8)
* UNPK 0(5,R8),14(3,R13)
* TR 0(4,R8),HEX-240
* MVI 4(R8),C' '
* LA R8,5(R8)
UNPKFLD UNPK 0(3,R8),0(2,R2)
TR 0(2,R8),HEX-240
LA R8,2(R8)
LA R2,1(R2)
C R8,LINE+120
BNL DOF90
BCT R3,UNPKFLD
*
MVI 0(R8),C' '
LA R8,1(R8)
LA R4,8(R4)
CLI 0(R4),X'FF'
BE DOF90
IC R3,DOFIELDS-2
LA R3,1(R3)
STC R3,DOFIELDS-2
B DOFLOOP
DOF90 MVI DOFIELDS-2,C'1'
BR R9
* ------------------------------------
DOREGS LA R3,REGS
CLI 7(R3),X'FF'
BE REGLOOP-4
WTO 'TOO MANY REGISTERS, 7 MAX'
ABEND 2
LA R8,1(R8)
REGLOOP SR R1,R1
IC R1,0(R3)
LA R15,HEX(R1)
MVI 0(R8),C'R'
MVC 1(1,R8),0(R15)
MVI 2(R8),C'='
SLL R1,2
LA R1,CALLREGS(R1)
UNPK 3(9,R8),0(5,R1)
TR 3(8,R8),HEX-240
MVI 11(R8),C' '
LA R8,12(R8)
C R8,LINE+110
BNL DONE
LA R3,1(R3)
CLI 0(R3),16
BL REGLOOP
BR R9
* ------------------------------------- RETURN SECTION
RETURN L R13,4(R13)
LM 14,1,12(13)
SR 15,15
LTR 1,1
BZ RETLM
LM R2,R12,28(R13)
BR R14
RETLM LM 2,12,28(R13)
CLI 0(R14),0
BE 2(R14)
B 8(R14)
*----------------------------------- INIT SECTION ---------------
BADMAX WTO 'MAX=### TO SMALL'
A R4,4(R5)
LA R5,LCHANGE(R5)
CLI 0(R5),0
BE *-12
S R4,=A(WORKAREA-SAYTRACE-128)
CVD R4,DW
OI DW+7,X'0F'
UNPK NEEDMAX+12(7),DW+4(4)
NEEDMAX WTO 'MAX=....... NEEDED'
ABEND 3
INITBAD LH R3,0(R1)
LA R0,240(R3)
STC R0,BAD0+5
LA R1,0(R1)
SR R1,R13
ST R1,12(R13)
UNPK BAD0+8(5),14(3,R13)
TR BAD0+8(4),HEX-240
MVI BAD0+12,C')'
LA R2,BAD0
BAL R9,COMONWTO
ABEND (3)
*
MVC MSGWTO+5(0),1(R2)
COMONWTO SR R4,4
IC R4,0(R2)
LA R0,10(R4)
STH R0,MSGWTO
EX R4,COMONWTO-6
LA R0,6(R4)
STH R0,MSGWTO
WTO MF=(E,MSGWTO) '
LA R2,2(R2,R4)
CLI 0(R2),99
BL COMONWTO+2
BR R9
MSGWTO DC F'0',CL56' '
*
BAD0 COMONMSG 'ERR . (....)'
BAD1 COMONMSG '1 = MUST DO SAYINIT FIRST'
BAD2 COMONMSG '2 = TOO MANY REGISTERS, 7 MAX'
BAD3 COMONMSG '3 = MAXSAY= NEEDS TO BE HIGHER'
BAD4 COMONMSG '4 = ADDRESS LESS THAN 999, ? DSECT LABEL'
BAD5 COMONMSG '5 = LENGTH GREATER THAN 64K, INVALID'
BAD6 COMONMSG '6 = COMPARE AREA ADDRESS NOT = 0'
DC X'FF'
* BAD7 COMONMSG '7 = COMPARE LENGTH LESS THAN 4, NOT USED'
* USER ABEND CODES.
* 1 = MUST DO SAYINIT FIRST
* 2 = TOO MANY REGISTERS, 7 MAX.
* 3 = MAXSAY= NEEDS TO BE HIGHER
* 4 = ADDRESS LESS THAN 999, INVALID, PROBABLY DSECT LABEL
* 5 = LENGTH GREATER THAN 64K, INVALID
* 6 = COMPARE AREA ADDRESS NOT = 0
* 7 = COMPARE LENGTH LESS THAN 4 NOT USED
*
LGETMAIN DC F'0'
AGETMAIN DC A(WORKAREA,WORKAREA,WORKAREA)
EGETMAIN DC A(END)
CONVADDR ST R0,12(R13)
UNPK 20(9,R13),12(5,R13)
TR 20(9,R13),HEX-240
MVI 28(R13),C'.'
MVC 0(6,R1),23(R13)
BR R14
* ---------------------------- ADD GETMAIN ADDR TO CHANGE= LIST
INIT CLI STOP,X'99'
BE INIT1
LA R0,STOPADR
LA R1,STOPATC+27
BAL R14,CONVADDR
*
* ST R0,12(R13)
* UNPK 20(9,R13),12(5,R13)
* TR 20(9,R13),HEX-240
* MVI 28(R13),C'.'
* MVC STOPATC+26(6),23(R13)
STOPATC WTO 'IN TEST, ISSUE " A ...... " TO STOP AT SAY#'
INIT1 CLI ACHANGE,X'FF' CALC SIZE OF AREA WE NEED TO
BER R9 COPY MEMORY TO SO WE CAN COMPARE.
L R2,ACHANGE ADD IN WHAT WE NEED TO SAVE SAY
SR R1,R1 LOCATIONS TO SAVE COUNT FIELDS.
* ---------------------------- FIRST CALC LENGTH NEEDED.
* IT1L CLC 0(4,R2),=F'999'
INIT1L CLC =F'999',0(R2)
BL *+10
BAL R1,INITBAD
DC H'4'
CLC =H'0',4(R2) THE SAVE LOC MUST BE =0 AND THE
BE *+10
BAL R1,INITBAD
DC H'5'
CLC =F'0',8(R2)
BE *+10
BAL R1,INITBAD
DC H'6'
* CLC 6(2,R2),=H'4'
* BH *+10
* BAL R1,INITBAD
* DC H'7'
A R1,4(R2) LOOKS GOOD, ADD TO TOTAL SO FAR\
LA R2,LCHANGE(R2) BUMP TO NEXT
CLI 0(R2),X'FF' Q. END OF LIST?
BNE INIT1L NO, LOOP
* ---------------------------- THEN ADD SPACE FOR SAY ENTRIES ---
L R0,MAXSAY LOAD MAXSAY=
SLL R0,4 MULT BY 16 (10+ BUFFER)
AR R1,R0 ADD TO TOTAL
C R1,=A(END-WORKAREA) Q. WORKAREA AT END OF PGM BIG
BL INIT2 ENOUGH? YES, JUST USE THAT.
LA R0,300(R1)
SRL R0,4
SLL R0,4
ST R0,LGETMAIN
CVD R0,DW
OI DW+7,X'0F'
UNPK GMWTO+18(7),DW+4(4)
GETMAIN R,LV=(0)
LR R0,R1
ST R1,AGETMAIN
STM R0,R1,LIST-4
A R1,LGETMAIN CALC END TO CHECK FOR OVERFLOW
ST R1,EGETMAIN
*
GMWTO WTO 'GETMAIN = ....... BYTES'
* -------------------------- PUT GETMAIN ADDR INTO LIST------
INIT2 L R4,AGETMAIN
L R3,ACHANGE
ZAP HW,P0
B INITLOOP+4
INITLOOP LA R3,LCHANGE(R3)
ST R4,8(R3)
A R4,4(R3)
C R4,EGETMAIN
BNL BADMAX
AP HW,P1
CLI LCHANGE(R3),X'FF'
BNE INITLOOP
* ---------------------- SAVE NEXT ADDR TO USE FOR SAY CALL ADDRESSES
ST R4,AGETMAIN+4 USED TO KEEP LIST OF SAY ADDRESSES
ST R4,AGETMAIN+8
ST R4,LIST
ST R4,LIST-4
OI HW+1,X'0F'
UNPK INITWTO+8(3),HW
INITWTO WTO '... CHANGE= AREAS SETUP'
BR R9
* ----------------------------COPY MEM TO GETMAIN AREA
SAVCHANG CLI ACHANGE,X'FF'
BER R9
CLI CHNGFLAG,C'N'
BER R9
L R2,ACHANGE
CLI 0(R2),X'FF'
BER R9
SAVCHLM LM R14,R0,0(R2)
LR R1,R15
MVCL R0,R14 MOVE FROM PROGRAM TO GETMAIN AREA
LA R2,LCHANGE(R2) LOOP THRU ALL CHANGE= SETS.
CLI 0(R2),X'FF'
BNE SAVCHLM
BR R9
* ----------------------- HARD PART, COMPARE TO LOOK FOR CHANGES
CHNGFLAG DC C'Y'
DC 8F'0'
DC C' C1='
DOCHANGE CLI ACHANGE,X'FF'
BER R9
STM R2,R9,DOCHANGE-36
L R2,ACHANGE
MVI CHNGFLAG,C'N'
MVI DOCHANGE-2,C'1'
DOCHA LM R14,R0,0(R2)
LR R1,R15
CLCL 14,0
BNE DOCHLIST-4
*
DOCHNEXT LA R2,LCHANGE(R2)
SR R1,R1
IC R1,DOCHANGE-2
LA R1,1(R1)
STC R1,DOCHANGE-2
CLI 0(R2),X'FF'
BNE DOCHA
DOCHEND LM R2,R9,DOCHANGE-36
BR R9
*
MVI CHNGFLAG,C'Y'
DOCHLIST LM R3,R5,0(R2)
DOCHLIC CLC 0(1,R5),0(R3)
BNE DOCHTOP
DOCHLIL LA R5,1(R5)
LA R3,1(R3)
BCT R4,DOCHLIC
B DOCHNEXT
*
DOCHTOP LR R1,R3
S R1,CSECTADR
ST R1,12(R13)
MVC LINE1(3),DOCHANGE-3
MVC LINE1+3(4),=C'NEW '
MVC LINE2+3(4),=C'OLD '
UNPK LINE1+9(5),14(3,R13)
TR LINE1+9(4),HEX-240
MVI LINE1+13,C' '
ST R3,12(R13)
UNPK LINE2+7(7),13(4,R13)
TR LINE2+7(6),HEX-240
MVI LINE2+13,C' '
LA R6,LINE1+14
*
DOCHLOOP UNPK 0(3,R6),0(2,R3)
TR 0(2,R6),HEX-240
MVI 2(R6),C' '
*
UNPK LINE2-LINE1(3,R6),0(2,R5)
TR LINE2-LINE1(2,R6),HEX-240
MVI LINE2-LINE1+2(R6),C' '
*
LA R6,2(R6)
LA R3,1(R3)
LA R5,1(R5)
LA R0,3
NR R0,R3
BNZ *+8
LA R6,1(R6)
*
CLC 0(4,R3),0(R5)
BE DOCHWTO
C R6,=A(LINE1+115)
BNL DOCHWTO
BCT R4,DOCHLOOP
DOCHWTO BAL R9,PRINTCH
LTR R4,R4
BP DOCHLIC
B DOCHNEXT
*
PRINTCH L R6,DCB
LTR R6,R6
BZ WTOCH
PUT (6),LINE1-1
PUT (6),LINE1-2
WTOCH WTO MF=(E,LINE1-5)
WTO MF=(E,LINE2-5)
MVC LINE1,LINE1-1
MVC LINE2,LINE2-1
BR R9
*
AIF (&QTEST EQ 0).PASTSTS
*
TEST MVC TESTSAVE(72),0(13)
BALR 11,0
DROP 12
USING *,11
LA R13,TESTSAVE
SAYINIT REGS=(9,14),CSECT=SAYTRACE, X
FIELDS=(DONE,12,INIT,8), X
STOP=4, X
CHANGE=(LIST-12,40,0,TESTCNT+2,64,0,TESTCNT,1,0)
TESTLOOP MVC DW,SAY#
SAY ,
SAY 'TESTBRK'
MVC DW,SAY#
SAY ,
SP TESTCNT,P1
BP TESTLOOP
SAY END
L 13,TESTSAVE+4
LM 14,12,12(13)
SR 15,15
BR 14
EX 0,*
TESTSAVE DC 18F'0'
TESTCNT DC P'023'
AGO .PASTSTS
* ====1=1============================
* SAYINIT FIELDS=(TEST,12)
SAYINIT FIELDS=(TEST,12)
* ====2=2============================
* SAYINIT FIELDS=(TESTLOOP,24,TEST,12)
SAYINIT FIELDS=(TESTLOOP,24,TEST,12)
* ====3=3============================
* SAYINIT CHANGE=(TEST,12)
SAYINIT CHANGE=(TEST,12)
* ====4=4============================
* SAYINIT CHANGE=(TEST,12,0,TESTLOOP,24,0)
SAYINIT CHANGE=(TEST,12,0,TESTLOOP,24,0)
* ====5=5============================
* SAYINIT CHANGE=(TEST,12,0,TESTLOOP,24,0),CSECT=SAYTRACE
SAYINIT CHANGE=(TEST,12,0,TESTLOOP,24,0),CSECT=SAYTRACE
* ====6=6============================
* SAYINIT REGS=(2,3,4)
SAYINIT REGS=(2,3,4)
* ====7=7============================
* SAYINIT REGS=(2,3,4),STOP=5
SAYINIT REGS=(2,3,4),STOP=5
* ====8=8============================
* SAYINIT REGS=(2,3,4),FIELDS=(TEST,12),CSECT=SAYTRACE, X
* CHANGE=(TEST,12,0,TESTLOOP,80,0)
SAYINIT REGS=(2,3,4),FIELDS=(TEST,12),CSECT=SAYTRACE, X
CHANGE=(TEST,12,0,TESTLOOP,80,0)
* ====9=9============================
* SAYINIT REGS=(2,3,4),FIELDS=(TEST,12),CSECT=SAYTRACE, X
* CHANGE=(TEST,12,0,TESTLOOP,80,0)
SAYINIT REGS=(2,3,4),FIELDS=(TEST,12),CSECT=SAYTRACE, X
CHANGE=(TEST,12,0,TESTLOOP,80,0)
* ===================================
.PASTSTS ANOP
* -----------------------------
LTORG
P1 DC X'1C'
P0 DC X'0C'
DW DC 3D'0'
HW DC 2H'0'
HEX DC C'0123456789ABCDEF'
ZEROS DC XL32'00'
SPACES DC CL133' '
DC H'130,0',C' '
LINE1 DC CL133' '
DC H'130,0',C' '
LINE2 DC CL133' '
DC H'130,0',C' '
LINE DC CL133' '
WORKAREA DS 0F
*
@@PAD#0 EQU *+4095-SAYTRACE
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG SAYTRACE+@@PAD#2
END EQU *-12
*
END SAYTRACE