AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK
SET BREAK=%G%.BREAK.TXT
SET LISTING=%G%.PRN
SET SYSIN=%G%.SYSIN.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1)
BAT\EZ390 %G%.MLC TEST
-----------------------------------------------------------
.START ANOP
*
QBREAK START 0
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
OPENL L R2,0(R3)
BALR R9,R4
L R2,4(R3)
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 OUTPUT, RECFM=?? LRECL=.....'
*
PUSH PRINT
PRINT NOGEN
OPENIN OPEN ((2),INPUT)
B LISTDCB
OPENOUT OPEN ((2),OUTPUT)
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(L'DCBLINE),DCBLINE
B PUTSYS
*
BADSIN MVC PARM+16(20),=CL20' <== INVALID SYSIN'
LA R9,GETSYSIN
MVC LINE,PARM
PUTSYS PUT SYSPRINT,LINE
TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN
BOR R9
WTO MF=(E,LINE-4)
CLC =C'A ',LINE
BNER R9
PUT BREAK,LINE
BR R9
*
BAL R9,PUTSYS
MVC LINE,SPACES
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-10
*
MVC LINE,PARM
BAL R9,PUTSYS
MVC LINE,SPACES
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 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.+00123.'
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-10
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-10
*
Y CLOSE (SYSIN)
MVI LINE,C'='
MVC LINE+1(30),LINE
BAL R9,PUTSYS
MVC LINE,SPACES
B GET
BAL R9,PUTSYS
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,R1),TESTHEX DO WE HAVE A LOCATION?
BNZ GET NO.
CLI 0(R3),C'*' Q. IS THERE A LABEL
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)
*
LABEL DC 2CL16' '
OPCODE DC 2CL16' '
*
LTABLE EQU 48
DC A(100*100)
ATABLE DC 2F'0'
*
FOUND MVI LOADLOC,C'A'
MVC LINE,SPACES
MVC LOADLOCL,LABEL
CLC =C'DC ',OPCODE
BE DSDC
CLC =C'DS ',OPCODE
BNE INST
CLC =C'0H ',0(R3)
BE INST
DSDC MVI LOADLOC,C'L'
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 GET-4
*
Z MVC LINE,SPACES
MVC LINE(7),=C'INTERACTIVE'
PUT BREAK,LINE
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 2D'0'
WTO DC H'100,0'
LINE DC CL100' QBREAK, ASM &SYSDATE AT &SYSTIME'
SPACES DC CL100' '
PARM DC CL100' ',CL300' '
*
TESTHEX EQU *-193
DC 6X'00',41C' ',10X'00',6C' '
*
FINDSPAC DC XL256'00'
ORG FINDSPAC+C' '
DC C' '
ORG
FINDCHAR DC CL256' '
ORG FINDCHAR+C' '
DC X'00'
ORG
*
* @@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