There's a problem with Z390 VB file processing. It doesn't work. But I didn't know that. There are 2 programs here. MAKEVB and TESTVB. TESTVB is the shorter one, and it's first. MAKEVB is more fancy and shows you what it's doing. But TESTVB shows there is a problem. SO, without further adieu, here's the TESTVB program.
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\TESTVB
ASM
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\TESTVB
SET INTEXT=%G%.MLC
SET OUT=%G%.OUT1.TXT
BAT\ASMLG %G%.MLC TIME(1)
RUN-1 TEXT IN, VB OUT
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\TESTVB
SET INTEXT=%G%.MLC
SET OUT=%G%.OUT1.TXT
BAT\EZ390 %G%.MLC TIME(1)
RUN-2 VB IN, VB OUT
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\TESTVB
SET INVB=%G%.OUT1.TXT
SET OUT=%G%.OUT2.TXT
BAT\EZ390 %G%.MLC TIME(1) PARM=(VB.OR.ANYTHING.AT.ALL)
PARM=(V) READ A VB FILE AND WRITE AND IDENTICAL FILE. (ANY PARM AT ALL)
NO PARM READ A CARD IMAGE FILE AND WRITE A VB FILE.
---------------------------------------
.START ANOP
TESTVB START 0
YREGS
USING *,12
STM 14,12,12(13)
LR 12,15
LA 14,SAVEA
ST 13,4(14)
ST 14,8(13)
LR 13,14
L 3,0(1)
CLI 1(3),0
BE MAKEV
* --------------------------- COPY VB SECTION --------------------
LM R2,R3,=A(INVB,OUT)
BAL R9,OPEN
GETV GET INVB
LR R0,R1
PUT OUT,(0)
AP #OUT,P1
B GETV
*
PUSH PRINT
PRINT NOGEN
OPEN OPEN ((2),INPUT,(3),OUTPUT)
BR R9
POP PRINT
* -------------------------- READ TEXT, CREATE VB -----------
MAKEV LM R2,R3,=A(INTEXT,OUT)
BAL R9,OPEN
GETF GET INTEXT,BUFFER
LA R2,BUFFER+L'BUFFER-1
LA R3,L'BUFFER-3
FINDCHAR CLI 0(R2),C' '
BNE GOTCHAR
BCTR R2,0
BCT R3,FINDCHAR
GOTCHAR S R2,=A(BUFFER)
LA R2,5(R2)
SLL R2,16
ST R2,BUFFER-4
PUT OUT,BUFFER-4
AP #OUT,P1
B GETF
* ------------------------------------- DONE, DATA AREAS ------------
DCBLIST DC A(INVB,INTEXT,OUT,0)
SAVEA DC 18F'0'
DC F'0'
BUFFER DC CL80' '
*
P1 DC X'1C'
#OUT DC PL2'0'
*
DC AL2(L'OUTMSG+4,0)
OUTMSG DC C'... RECORDS WRITTEN'
*
Z OI #OUT+1,X'0F'
UNPK OUTMSG(3),#OUT
WTO MF=(E,OUTMSG-4)
*
LA R2,DCBLIST-4
CLONEXT LA R2,4(R2)
L R3,0(R2)
LTR R3,R3
BZ EXIT
TM DCBOFLGS-IHADCB(R3),DCBOFOPN
BZ CLONEXT
CLOSE ((3))
B CLONEXT
*
EXIT L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
LTORG
PUSH PRINT
PRINT NOGEN
INVB DCB DDNAME=INVB,DSORG=PS,MACRF=GL,RECFM=VB,LRECL=84,EODAD=Z, X
BLKSIZE=32760
INTEXT DCB DDNAME=INTEXT,DSORG=PS,MACRF=GM,RECFM=FT,LRECL=80,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=VB,LRECL=84
POP PRINT
*
@@PAD#0 EQU *-TESTVB+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG TESTVB+@@PAD#2
*
END TESTVB
You probably want to change G= to wherever you put your code. and then .....
C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
BAT FILE TO ASSEMBLE MAKEVB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET IN=%G%.PRN
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1)
BAT FILE FOR RUN 1 (READ TEXT FILE, CREATE VB)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET IN=%G%.PRN
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT1.TXT
BAT\EZ390 %G%.MLC TIME(1)
BAT FILE FOR RUN 2, READ VB WRITE VB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET VBIN=%G%.OUT.TXT
SET OUT=%G%.OUT2.TXT
SET SYSPRINT=%G%.SYSPRINT2.TXT
BAT\EZ390 %G%.MLC TIME(1) PARM(READ)
BATFILE TO RUN #2 USING TEST
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET VBIN=%G%.OUT.TXT
SET OUT=%G%.OUT2.TXT
SET SYSPRINT=%G%.SYSPRINT2.TXT
BAT\EZ390 %G%.MLC TIME(1) PARM(READ) TEST
SOURCE PGM ------------------------------------------
AGO .START
I'M NOT AT ALL SURE THAT V/VB WORKS.
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\MAKEVB
SET IN=%G%.PRN
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1)
1) PROGRAM READS A LISTING, STARTS AT THE END OF THE RECORD, AND BACKS
UP UNTIL IT FINDS A NON-BLANK, THEN ADDS 1 TO POINT PAST THE LAST BYTE.
IF IT DOESN'T FIND ANYTHING, THEN IT POINTS 4 PAST THE START OF THE
RECORD (REG-3). FROM THAT IT ADDS 4 AND CREATES THE LL00 THAT IS
THE VB HEADER, AND PUTS THAT IN FRONT OF THE RECORD, AND WRITES THAT.
2) PARM=READ READS THE FILE CREATED IN STEP-1
AND WRITES THOSE RECORDS.
SO FAR IN TESTING, THE VB OUTPUT FROM STEP-1 IS GARBAGE.
IN ADDITION, FOR READING THE VB FILE, I HAVE TO CODE RECFM=GL
IF I CODE RECFM=GM THEN THE PROGRAM ABENDS OPENING THAT FILE.
WHEN RECFM=GL IS CODED, THEN THE FILE SEEMS TO OPEN, HOWEVER
THE PROGRAM ABENDS WITH THE FIRST READ OF THE FILE.
-----------------------------------------------------------
.START ANOP
MAKEVB START 0
YREGS
DC 18F'0'
ORG MAKEVB
USING *,13
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R3,0(R1)
*---
L R0,LGETMAIN
GETMAIN R,LV=(0)
ST R1,AGETMAIN
LA R2,4(R1)
STM R1,R2,BUFFEROU
*---
CLI 1(R3),0
BE START
MVC FLAGTEST,2(R3)
CLI FLAGTEST,C'R'
BE READ
EX 0,*
ORG
DC AL1(L'INITLINE)
INITLINE DC CL64'MAKEVB, V01.01, ASM &SYSDATE, &SYSTIME '
LINE DC CL133'' '
OPEN LA R2,SYSPRINT
BAL R9,OPENOUT
LR R2,R4
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
MVC LINE,LINE-1
BR R8
*
LGETMAIN DC F'400'
AGETMAIN DC F'0'
BUFFEROU DC F'0'
BUFFERIN DC F'0'
*
OPENOUT MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
*
PUSH PRINT
PRINT NOGEN
USING IHADCB,2
OPEN ((2),OUTPUT)
MVC DCBLINE+16(3),=C'OUT'
CLC =C'SYSPRINT',DCBLINE
BNE NOTSYSP
PUT SYSPRINT,INITLINE-1
B NOTSYSP
OPENIN MVC DCBLINE(8),DCBDDNAM-IHADCB(R2)
OPEN ((2),INPUT)
MVC DCBLINE+16(3),=C' IN'
NOTSYSP UNPK DCBLINE+30(3),DCBRECFM(2)
TR DCBLINE+30(2),HEX-240
MVI DCBLINE+32,C' '
*
LH R0,DCBLRECL
CVD R0,12(R13)
OI 19(R13),X'0F'
UNPK DCBLINE+39(5),17(3,R13)
*
LH R0,DCBBLKSI
CVD R0,12(R13)
OI 19(R13),X'0F'
MVC LINE(L'DCBLINE),DCBLINE
UNPK LINE+L'DCBLINE(5),17(3,R13)
*
PUT SYSPRINT,LINE-1
BR R9
DROP 2
POP PRINT
DCBLINE DC C'........ OPENED OUTPUT, RECFM=.. LRECL=....., BLKSIZE='
* =========================================================
READ LA R4,INVB
BAL R8,OPEN
READGET GET INVB
LR R3,R1
LR R14,R3
LA R15,LINE
LA R0,5
BAL R9,DUMPREC
PUT OUT,(3)
B READGET
*
DUMPREC UNPK 0(9,R15),0(5,R14)
TR 0(8,R15),HEX-240
MVI 8(R15),C' '
LA R15,9(R15)
LA R14,4(R14)
BCT R0,DUMPREC
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
*
START LA R4,IN
BAL R8,OPEN
B GET
*
PUT L R14,BUFFEROU
LA R15,LINE+2
MVC LINE+50(16),4(R14)
LA R0,5
BAL R9,DUMPREC
L R0,BUFFEROU
PUT OUT,(0)
*
GET L R3,BUFFERIN
GET IN,(3)
L R14,BUFFERIN
LA R15,LINE+11
MVC LINE+50(16),0(R14)
LA R0,4
BAL R9,DUMPREC
*
LA R2,388(R3)
BCTR R2,0
CLI 0(R2),C' '
BE *-6
CR R2,R3
BNL *+8
LA R2,4(R3)
LA R2,1(R2)
L R1,BUFFEROU
SR R2,R1
SLL R2,16
ST R2,0(R1)
B PUT
*
Z CLOSE ((4))
CLOSE (OUT,,SYSPRINT)
LM R0,R1,LGETMAIN
FREEMAIN R,LV=(0),A=(1)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
LTORG
FLAGTEST DC C' '
HEX DC C'0123456789ABCDEF'
PUSH PRINT
PRINT NOGEN
INVB DCB DDNAME=INVB,DSORG=PS,MACRF=GL,RECFM=VB,LRECL=388,EODAD=Z, X
BLKSIZE=32760
IN DCB DDNAME=IN,DSORG=PS,MACRF=GM,RECFM=FT,LRECL=388,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=VB,LRECL=388
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
POP PRINT
*
END MAKEVB