Short program to add 1 col to a file. Been working on this, idea randomly, for a while.
This program is a 1 day effort to write. 1 more day for debugging. But getting the registers straight was tough.
The program is short. Less than 1k. Good for LRECL less than 256. (You know, just one MVC instruction,)
Doesn't do hex, but should do both fixed and variable. You'll want to use WTO ROUTCDE=(11) to not bother operators.
Look at the ADDACOL WTO to see what bits need to be set for ROUTCDE=(11) and put 'em in the error msgs.
You'll want to take out the @@pad statements at the end, and use the MVS DCB rather than the Z390 DCB.
And take out the LRECL copy in the OPEN section, and use the OPEN EXIT to soft-code LRECL and RECFM.
//ADD EXEC PGM=ADDACOL,PARM='23, YOUR TEXT TO ADD' <== Starting in col-23 on all records.
*23456789ABCDEFGHIJKLMNOPQRSTUVWXYZ <== LINE TO SEE THE ADD FIELD.
MACRO
&LABEL ERR &BC,&MSG
LCLC &L
&L SETC 'SYS&SYSNDX'
&LABEL &BC &L.G
BAL R14,ERRMSG
DC AL2(L'&L.M+4,0)
&L.M DC C&MSG
&L.G DS 0H
MEND
*
* WHEN YOU'RE THINKING ABOUT THIS, YOU NEED A REG FOR THE LENGTH
* OF THE 1ST SECTION OF THE INPUT RECORD.
* YOU CAN PUT THE STRING IN THE OUTPUT BUFFER BEFORE READING
* ANYTHING, BECAUSE THAT DOES NOT CHANGE.
* BUT YOU NEED 2 REGS, FOR THE LOCATION, AND LENGTH OF THE 2ND
* HALF OF THE INPUT RECORD.
*
ADDACOL START 0 THIS IS THE KISS PROGRAM TO MOVE A STRING
USING *,13 INTO A RECORD, BASED ON PARM INPUT.
STM 14,12,12(13) UNFOTUNATELY, KEEPING THE REGISTERS
ST 15,8(13) STRAIGHT IS PRETTY COMPLICATED FOR AN OLD
ST 13,4(15) GUY. SOMETIMES YOU NEED LENGTH-1 FOR MVC,
LR 13,15 OTHER TIMES YOU NEED LENGTH FOR LOC IN
L R2,0(R1) THE BUFFER. PARTICULARLY LOC OF THE 2ND
LH R3,0(R2) HALF OF THE RECORD.
CH R3,=H'3'
ERR BNL,'PARM MISSING OR TOO SHORT'
SR R4,R4 R4 WILL BE THE OFFSET FOR THE ADDED
PARMLOOP IC R15,2(R2) FIELD. THIS ROUTINE TURNS DIGITS
N R15,=F'15' INTO BINARY.
MH R4,=H'10'
* ----------<< THE OUTPUT BUFFER STARTS HER. TO SAVE 256 BYTES. >>---- -75---80
BUFFER EQU *
AR R4,R15 256 BYTES MAX.
LA R2,1(R2) 4=LOC TO PUT STRING
BCTR R3,0 3=DATA LENGTH+1
CLI 2(R2),C'0' (PARM LENG - EVERYTHING ELSE)
BNL PARMLOOP
*
LA 12,BUFFER
SH R3,=H'2' 3=DATA LENGTH-1
ERR BNM,'STRING LENGTH=0'
SH R4,=H'2' 4=OFFSET TO PUT STRING
ERR BP,'LOC CANNOT BE 1'
STC R4,MOVE1+1 STORE STR LENGTH IN MVC INST
*
LA R10,BUFFER+1(R4) R10=LOC TO PUT STRING
LA R11,1(R10,R3) R11=LOC FOR END OF RECORD
LA R0,1(R3)
ST R0,ADDLRECL SAVE AMT TO ADD TO LRECL
LA R6,2(R3,R4) 6= OFFSET TO MOVE END
*
WTO 'ADDACOL, ASM &SYSDATE AT &SYSTIME',ROUTCDE=(11)
PUSH PRINT
PRINT NOGEN CU
LA R12,IN
MVC DCBMSG+2(3),DCBDDNAM-IHADCB(R12)
OPEN OPEN (IN,INPUT)
BAL R9,DODCBMSG
*
LH R0,DCBLRECL-IHADCB+IN IN MVC, LEAVE THIS OUT AND USE
A R0,ADDLRECL THE OPEN EXIT TO COPY LRECL
STH R0,DCBLRECL-IHADCB+OUT AND RECFM.
*
LA R12,OUT
MVC DCBMSG+2(3),DCBDDNAM-IHADCB(R12)
OPEN (OUT,OUTPUT)
BAL R9,DODCBMSG
POP PRINT
*
LH R8,DCBLRECL-IHADCB+IN
A R8,ADDLRECL
CH R8,=H'256'
ERR BL,'//IN LRECL +STRING TOO LONG'
LA R7,0(R8)
SR R7,R4 THIS IS SO WE DON'T TRY TO
* OF THE BUFFER AND ABEND.
MVI BUFFER-1,C' '
MVC BUFFER(256),BUFFER-1
MVC 0(0,R10),3(R2)
EX R3,*-6 MOVE STRING (STAYS SAME)
*
* LOTS OF SETUP, NOT MUCH MOVE. 3/4 OF MOVE IS TO ACCOMODATE
* RECFM=VB. AND I CAN'T EVEN TEST THAT BECAUSE THERE IS NONE
* ON Z390.
*
GET GET IN
MOVE1 MVC BUFFER(0),0(R1) MOVE 1ST HALF
LA R9,1(R1,R4) CALC INPUT LOC OF 2ND HALF
*
TM DCBRECFM-IHADCB+IN,X'80'
BO RECFMFB
LH R7,BUFFER LOAD RECFM=VB LENGTH
LR R0,R7
A R0,ADDLRECL
STH R0,BUFFER
SR R7,R4 THIS IS SO WE DON'T TRY TO
BM PUT
*
MVC 0(0,R11),0(R9) MOVE 2ND HALF
RECFMFB EX R7,*-6
PUT PUT OUT,BUFFER AND WRITE
B GET
ERRMSG WTO MF=(E,(14))
TM DCBOFLGS-IHADCB+IN,DCBOFOPN
BZ NOCLOSE
*
E CLOSE (IN,,OUT)
NOCLOSE L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
*
DC AL2(L'DCBMSG+4,0)
DCBMSG DC C'// RECFM=.. LRECL=... BLKSI=..... '
DODCBMSG UNPK DCBMSG+12(3),DCBRECFM-IHADCB(2,R12)
TR DCBMSG+12(2),HEX-240
MVI DCBMSG+14,C' '
LH R0,DCBLRECL-IHADCB(R12)
CVD R0,16(R13) THIS SECTION PRINTS (WTO)
OI 23(R13),X'0F' DDNAME, RECFM, AND LRECL,
UNPK DCBMSG+21(3),22(2,R13) BECAUSE I WAS SEEING TRASH
LH R0,DCBBLKSI-IHADCB(R12) DURING TESTING.
CVD R0,16(R13)
OI 23(R13),X'0F'
UNPK DCBMSG+31(5),21(3,R13)
WTO MF=(E,DCBMSG-4)
BR R9
*
LTORG
HEX DC C'0123456789ABCDEF'
X DC 0F'0',X'85',AL3(X+4) THIS IS AN OPEN EXIT RTN THAT
PUSH USING COPIES //IN LRECL+INSERT LENGTH
DROP 13 TO THE //OUT DCB. I LIKE USING
USING *,15 NO-THINK PROCESSING.
USING IHADCB,1
CLI DCBRECFM,0 Q. RECFM ALREADY THERE?
BNER R14 YES, SKIP THIS
MVC DCBRECFM,DCBRECFM-IHADCB+IN
LH R0,DCBLRECL-IHADCB+IN
A R0,ADDLRECL
STH R0,DCBLRECL
BR R14
POP USING
ADDLRECL DC F'0'
PRINT NOGEN SAVE A BIT OF PAPER (AND MY EYES)
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=80,EODAD=E
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=84,EXLST=X
@@PAD#1 EQU ((*-ADDACOL)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-ADDACOL)
ORG *+@@PAD#2
*N DCB DDNAME=IN,DEVD=DA,DSORG=PS,MACRF=GL,RECFM=FB,LRECL=80,EODAD=E
*UT DCB DDNAME=OUT,DEVD=DA,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=84,EXLST=X
* DCBD DEVD=DA
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
END ADDACOL