AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
SET LISTING=%G%.PRINT.TXT
SET SYSIN=%G%.SYSIN.TXT
SET BREAK=%G%.BREAK.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1)
BAT\EZ390 %G%.MLC TEST
---------CHANGES-------------------------------------------
V01.01
PRINT AND WTO COMMAND=
ELIMINATED DUPLICATE BREAK COMMANDS FOR DUPLICATE LABELS.
V01.02
SKIP OPCODES AT ODD LOCATIONS
WHEN A MACRO LABEL OCCURS AT AN ODD LOCATION, SKIP THE
INSTRUCTION AND PROCESS THE REAL LOCATION.
V01.08
FIX ERR WITH BREAKS AT ODD ADDRESSES.
REDUCE LISTING LINES ANALYZED
(INTERMEDIATE VERSIONS ALL HAD ERRORS.)
V01.09 FIXED WTO LOC ERROR
-----------------------------------------------------------
.START ANOP
*
QBREAK START 0
DS 18F
ORG QBREAK
YREGS
USING *,13
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R7,0(R1)
L R0,ATABLE-4
Q3 GETMAIN R,LV=(0)
LR R0,R1
Q4 STM R0,R1,ATABLE
LR R11,R1
*
LA R3,DCBLIST
LA R4,OPENOUT
LA R5,2
B OPENL
ORG
OPENL L R2,0(R3)
MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
BALR R9,R4
L R2,4(R3)
MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
BALR R9,R4
LA R3,8(R3)
LA R4,OPENIN
MVC DCBLINE+20(3),=C' IN'
BCT R5,OPENL
*
LH R1,0(R7)
SH R1,=H'1'
BM GETSYSIN
MVC PARM(0),2(R7)
EX R1,*-6
B GOTSYSIN
*
DCBLIST DC A(SYSPRINT,BREAK,SYSIN,LISTING,0)
*
DCBLINE DC C'12334568 OPENED FOR OUTCUT, RECFM=?? LRECL=.....'
*
PUSH PRINT
PRINT NOGEN
OPENIN OPEN ((2),INPUT)
B LISTDCB
OPENOUT OPEN ((2),OUTPUT)
CLC =C'SYSPRINT',DCBLINE
BNE LISTDCB
NC LINE+49(17),=20X'BF'
MVI LINE+57,C' '
MVI LINE+60,C' '
PUT SYSPRINT,LINE
WTO MF=(E,LINE-5)
MVC LINE+1,LINE
POP PRINT
*
LISTDCB UNPK DCBLINE+34(3),DCBRECFM-IHADCB(2,R2)
TR DCBLINE+34(2),HEX-240
MVI DCBLINE+36,C' '
LH R0,DCBLRECL-IHADCB(R2)
CVD R0,16(R13)
OI 23(R13),X'0F'
UNPK DCBLINE+43(5),21(3,R13)
MVC LINE+1(L'DCBLINE),DCBLINE
B PUTSYS
*
BADSIN MVC PARM+16(20),=CL20' <== INVALID SYSIN'
LA R9,GETSYSIN
MVC LINE,PARM
TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN
BOR R9
PUTWTO WTO MF=(E,LINE-5)
PUTSYS PUT SYSPRINT,LINE
WTO MF=(E,LINE-5)
CLC =C'A ',LINE
BNER R9
CLC =C'+0A123',LINE+8
BER R9
PUT BREAK,LINE
BR R9
*
BAL R9,PUTSYS
MVC LINE,LINE-1
LM R5,R6,ATABLE
GETSYSIN GET SYSIN
MVC PARM,0(R1)
GOTSYSIN CLI PARM,C' '
BE GETSYSIN
*
CLC =C'COMMAND=',PARM
BNE *+14
MVC LINE(66),PARM+8
B GETSYSIN-14
*
MVC LINE,PARM
BAL R9,PUTSYS
MVC LINE,LINE-1
CLC =C'LABEL=',PARM
BE GETLABEL
CLC =C'LOADLOC=',PARM
BE QLOADLOC
B BADSIN
*
GETLABEL MVC PARM,PARM+6
B LBLLOOP
LBLAST MVC PARM,2(R1)
B *+10
LBLNORM MVC PARM,1(R1)
CLI PARM,C' '
B GETSYSIN
LBLLOOP MVC LINE,PARM
BAL R9,PUTSYS
*
SR R15,R15
IC R15,PARM
LA R14,LABEL1ST(R15)
STC R15,0(R14)
*
SR R2,R2
TRT PARM(20),FINDEND
BZ BADSIN
LR R3,R1
LR R4,R1
L R6,ATABLE+4 -------------
LA R0,LTABLE(R6)
ST R0,ATABLE+4
LR R8,R1
S R8,=A(PARM)
CH R8,=H'16'
BH BADSIN
LR R7,R8
BCTR R7,0
*
MVC 0(LTABLE,R6),SPACES
STH R8,0(R6)
MVC 2(0,R6),PARM
EX R7,*-6
CLI 0(R1),C'*'
BNE *+12
STH R7,0(R6)
LA R1,1(R1)
*
CLI 0(R1),C' '
BNE QPLUSM
CLI 1(R1),C'0'
BL QPLUSM
MVC LTABLE-6(4,R6),0(R1)
B GETSYSIN
*
QPLUSM CLI 0(R1),C'+'
BE PLUSMINU
CLI 0(R1),C'-'
BE PLUSMINU
*
BCTR R1,0
LA R1,1(R1)
PASTR1 CLI 0(R1),C' '
BE GETSYSIN
CLI 0(R1),C','
BNE BADSIN
MVC PARM,1(R1)
B LBLLOOP
*
PLUSMINU MVC LTABLE-6(6,R6),0(R1)
LA R15,LTABLE-2(R6)
CLI 0(R15),C','
BNE *+10
MVC 0(2,R15),SPACES
CLI 1(R15),C','
BNE *+8
MVI 1(R15),C' '
*
LA R1,1(R1)
CLI 0(R1),C' '
BE GETSYSIN
CLI 0(R1),C','
BNE PLUSMINU+6
MVC PARM,1(R1)
B LBLLOOP
*
LABELLOC DC F'53'
LOADLOC DC C'A FF000.+0A123.'
LOADLOC# DC CL6' ',C' '
LOADLOCL DC CL16' '
LLOADLOC EQU *-LOADLOC
LXLOADL EQU *-LOADLOC#
* C'A 9R%+000123. '
*
* LABEL=AB,CD*,EF+??,GH-??
*
* NORM LA R14,3(R5,R7)
* MVI 0(R14),C' '
* LA R1,0(R3,R7)
* MVC PARM,0(R1)
* B LBLLOOP
*
QLOADLOC CLI PARM+8,C'('
BE LOADLOCR
MVC LOADLOC+2(5),PARM+8 LOADLOC=FF000.+.....
MVC LINE(L'LOADLOC),LOADLOC
B GETSYSIN-14
LOADLOCR MVC DW(16),SPACES
MVC DW+8(5),PARM+8 LOADLOC=(3)%+.....
LA R1,DW+8
*
FINDPAR MVI 0(R1),C' '
LA R1,1(R1)
CLI 0(R1),C' '
BE BADSIN
CLI 0(R1),C')'
BNE FINDPAR+4
BCTR R1,0
CLI 0(R1),C'R'
LA R1,1(R1)
BE *+12
*
MVI 0(R1),C'R'
LA R1,1(R1)
*
MVI 0(R1),C'%'
SH R1,=H'6'
MVC LOADLOC+2(7),0(R1)
MVC LINE(L'LOADLOC),LOADLOC
B GETSYSIN-14
*
Y CLOSE (SYSIN)
MVI LINE,C'='
MVC LINE+1(30),LINE
BAL R9,PUTSYS
MVC LINE,LINE-1
B GET
*
PUTBREAK PUT SYSPRINT,LINE
WTO MF=(E,LINE-5)
CLI LINE,C'A'
BNE GET-6
PUT BREAK,LINE
MVC LINE,LINE-1
GET GET LISTING
MVC PARM,0(R1)
*
CLC PARM(4),=C'SYM='
BE Z
CLC PARM(4),=C'ESD='
BE Z
*
CLI 0(R1),C'0'
BL GET
CLC =C'000000',0(R1)
BE GET
LR R3,R1
LR R4,R1
A R3,LABELLOC
TRT 0(6,R4),TESTHEX DO WE HAVE A LOCATION?
BNZ GET NO.
CLI 0(R3),C'*' Q. IS THERE A LABEL
BE GET
CLI 0(R3),C' '
BE GET
*
SR R15,R15
IC R15,0(R3)
LA R14,LABEL1ST(R15)
CLI 0(R14),0
BE GET
*
MVC LOADLOC#(LXLOADL),SPACES
*
NOTEND TRT 0(16,R3),FINDSPAC
BZ GET
LR R2,R1
SR R2,R3
MVC LABEL,SPACES
MVC LABEL(0),0(R3)
EX R2,*-6
*
TRT 0(8,R1),FINDCHAR
BZ GET
LR R3,R1
*
MVC OPCODE,SPACES
TRT 0(9,R3),FINDSPAC
BZ GET
LR R2,R1
SR R2,R3
MVC OPCODE(0),0(R3)
EX R2,*-6
*
TRT 0(16,R1),FINDCHAR
BZ GET
LR R3,R1
*
* LABEL=INST LABEL
* OPCODE = INST OPCODE
* R3 = ADDR OF OPERAND
*
LM R6,R7,ATABLE
QLBL LH R1,0(R6)
EX R1,CLCLABEL
BE FOUND
LA R6,LTABLE(R6)
CR R6,R7
BL QLBL
B GET
CLCLABEL CLC LABEL(0),2(R6)
*
PREVLBL DC CL16' '
LABEL DC 2CL16' '
OPCODE DC 2CL16' '
*
LTABLE EQU 48
DC A(100*100)
ATABLE DC 2F'0'
*
FOUND CLC LABEL,PREVLBL
BE GET
MVC PREVLBL,LABEL
*
MVI LOADLOC,C'A'
MVC LINE,LINE-1
MVC LOADLOCL,LABEL
CLC =C'DC ',OPCODE
BE DSDC
CLC =C'DS ',OPCODE
BE DS0H
*
MVC DW(1),5(R4)
TR DW(1),MAKEHEX
TM DW,1
BZ INST
B GET
*
DS0H CLC =C'0H ',0(R3)
BE INST
DSDC MVI LOADLOC,C'L'
* B INST
* ----------------------------V01.02 SKIP ODD LOCATIONS---------
INST MVC LOADLOC+9(5),PARM+1
MVC LOADLOCL,LABEL
MVC LOADLOC#,LTABLE-6(R6)
*
CLI LOADLOC,C'L'
BNE MVC2LINE
CLC LOADLOC#,SPACES
BNE MVC2LINE
MVC LOADLOC#+2(2),=C'96'
*
MVC2LINE MVC LINE(LLOADLOC),LOADLOC
B PUTBREAK
*
Z MVC LINE,LINE-1
MVC LINE(11),=C'INTERACTIVE'
PUT BREAK,LINE
WTO MF=(E,LINE-5)
CLOSE (LISTING,,BREAK,,SYSPRINT)
LM R0,R1,ATABLE-4
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
RC DC X'00'
HEX DC C'0123456789ABCDEF'
FINDRPAR DC XL256'00'
ORG FINDRPAR+C')'
DC C')'
ORG
FINDEND DC XL256'00'
ORG FINDEND+C' '
DC X'04'
ORG FINDEND+C','
DC X'08'
ORG FINDEND+C'*'
DC X'12'
ORG FINDEND+C'+'
DC X'16'
ORG FINDEND+C'-'
DC X'20'
ORG
PUSH PRINT
PRINT NOGEN
SYSIN DCB DDNAME=SYSIN,DSORG=PS,EODAD=Y,MACRF=GL,LRECL=100,RECFM=FT
LISTING DCB DDNAME=LISTING,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=390,RECFM=FT
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=100,RECFM=FT,MACRF=PM
BREAK DCB DDNAME=BREAK,DSORG=PS,LRECL=80,RECFM=FT,MACRF=PM
POP PRINT
*
DW DC 4D'0'
WTO DC H'60,0',C' '
LINE DC CL100' QBREAK, V01.08 ASM &SYSDATE AT &SYSTIME, COMMENTSX
, LINLYONS AT YAHOO'
PARM DC CL100' '
SPACES DC CL56' '
*
TESTHEX EQU *-193
DC 6X'00',41C' ',10X'00',6C' '
MAKEHEX EQU *-193
DC X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'
*
FINDSPAC DC XL256'00'
ORG FINDSPAC+C' '
DC C' '
ORG
FINDCHAR DC CL256' '
ORG FINDCHAR+C' '
DC X'00'
ORG
LABEL1ST DC XL256'00'
*
@@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