ADDACOL

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