FIXHEXO

Someone asked if they could change x'00' to x'40 on every record of a file.

So I wrote a program.  Just for exercise.  And I rewrote it.  And I rewrote it.  I'm happy with how it works now.  Okay, I changed it again.  Now it just does a translate for the entire record, rather than looking for X'00'  And you can change several different characters in one pass.  Why?  I don't know, just because you can.  The cost is the same.

The //SYSPRINT  file tells you how it worked.  EG

 EDITONE, V02.01, ASM 04/16/26, 18.19 

       PARM=C"A",X"C2",C"C",C"D",X"C5",X"C6"

 SYSPRINT OPENED OUTPUT, RECFM=A0 LRECL=00133

 IN       OPENED  INPUT, RECFM=A0 LRECL=00399

 OUT      OPENED OUTPUT, RECFM=A0 LRECL=00133

 PARM=C"A",X"C2",C"C",C"D",X"C5",X"C6"

 PARM=X"C2",C"C",C"D",X"C5",X"C6"

 PARM=C"C",C"D",X"C5",X"C6"

 PARM=C"D",X"C5",X"C6"

 PARM=X"C5",X"C6"

 PARM=X"C6"

              462 RECORDS WRITTEN

 And the source code of the day is:

         AGO   .START

THE ORIGINAL REQUEST WAS TO CHANGE  X'00'  TO  X'40' (MAKE 'EM BLANKS)

NOW THERE ARE NUMEROUS WAYS TO SKIN A CAT.  AND I TRIED 'EM ALL.

I THINK THIS IS MY LAST TRY,  BUT THEN I THOUGHT THE SAME LAST TIME.

PREVIOUSLY, I LOOKED FOR X'00' AND CHANGED IT.

BUT IF YOU JUST TRANSLATE EVERYTHING, BUT PUT X'40' AT THE X'00'

LOCATION, YOU DO THE SAME THING, WITH LESS FOOLING AROUND.

YOU DON'T KNOW HOW MANY YOU CHANGED, BUT WHO CARES.

TO RUN THIS, CODE  PARM='FROM,TO,FROM,TO,FROM,TO' TO CHANGE WHATEVER.

EG,  PARM='C"A",C"B",X"C3",X"C4",C"E",X"C6"'  ETC.

YOU COULD USE ANY SPECIAL CHAR FOR BOTH THE QUOTES AND THE COMMA.

(BECAUSE Z390 PARM PROCESSING IS MORE THAN A LITTLE SQUIRRELY.

KEEP IN MIND, IT ONLY CHANGES 1 CHARACTER TO A DIFFERENT CHARACTER.

IT CANNOT DO A STRING.

--ASSEMBLE, LINK, AND GO -----------------------

C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONE

SET  G=C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONE

SET       IN=%G%.PRN

SET      OUT=%G%.OUT.TXT

BAT\ASMLG %G%.MLC TIME(1)    PARM(C$A$ X$C2$)

BAT\EZ390 %G%.MLC TIME(1)    PARM(C$A$ X$C2$)

BAT\EZ390 %G%.MLC TIME(2000) PARM(C$A$ X$C2$)  TEST

------------QBREAK------------------

SET  G=C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONE

SET  LISTING=%G%.PRN

SET SYSPRINT=%G%.BREAK.SYSPRINT.TXT

SET    BREAK=%G%.BREAK.BREAK.TXT

SET    SYSIN=%G%.BREAK.SYSIN.TXT

BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBREAK.MLC

--//SYSIN INPUT TO CREATE BREAKPOINT COMMANDS. ------------

LOADLOC=FF000   13R%

LABEL=PRINTR2,ERR*,MSG*,Z,ZS,GETMAIN,TRY*,SET*,SAV*,QFREQ,QS1*,QS9*

LABEL=TES*,EDIT0*,GETIN,WRITOUT,

LABEL=AGETMAIN,CARD,LINE,

COMMAND=

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONE ASMLG

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONET EZ390

COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\EDITONEB BK PTS

COMPRESS=Y

  CMDFILE=Y

  ATFILE=Y

-----------------------------------------------------------

.START   ANOP

* -----------------------------------------------------------

         MACRO

&LABEL   REVB  &COND,&TO

         LCLC  &C,&B

         LCLA  &LEN

         AIF   ('&COND' NE 'B').ADDREM

&LABEL   NOP   &TO

         MEXIT

.ADDREM  ANOP

&LEN     SETA  K'&COND

         AIF   ('&COND'(2,1) NE 'N').ADD

&B       SETC  '&COND'(3,&LEN-2)

         AGO   .DOIT

.ADD     ANOP

&B       SETC  '&COND'(2,&LEN-1)

&B       SETC  'N&B'

.DOIT    ANOP

&LABEL   B&B    &TO

         MEND

* -----------------------------------------------------------

         MACRO

         ERR   &BC,&MSG

         LCLA  &A

         LCLC  &L

&L       SETC  'SYS&SYSNDX'

&A       SETA  K'&MSG

         REVB  &BC,&L.Z

         BAL   R14,ERR

         DC    AL1(&A-3),C&MSG

&L.Z     DS    0H

         MEND

* -----------------------------------------------------------

*

EDITONE  START 0

         YREGS

         USING *,13

         STM   14,12,12(13)

         ST    13,4(15)

         ST    15,8(13)

         LR    13,15

         L     R3,0(R1)

         LH    R2,0(R3)          C' ',X'02'

         SH    R2,=H'1'

         ERR   BM,'PARM MISSING'

         MVC   PARM(0),2(R3)

         EX    R2,*-6

         CLI   1(R3),8

         ERR   BL,'PARM TOO SHORT, EG X"00",C" "'

         LA    R8,PARMANAL

         B     OPEN

*

ANAL     PUT   SYSPRINT,PARM-6

         CLI   PARM,C'C'

         BE    ANALC

         CLI   PARM,C'X'

         ERR   BNE,'PARM=C"C",X"??" ONLY CHAR OR HEX'

         CLC   PARM+1(1),PARM+4

         ERR   BNE,'NON MATCHING X QUOTES'

         TRT   PARM+2(2),TESTHEX-193

         ERR   BNZ,'INVALID HEX DATA'

         TR    PARM+2(2),MAKEHEX-193

         PACK  3(2,R2),PARM+2(3)

         MVI   4(R2),0

         MVC   PARM,PARM+6

         BR    R9

*

ANALC    CLC   PARM+1(1),PARM+3

         ERR   BNE,'NON MATCHING C QUOTES'

         MVC   3(1,R2),PARM+2

         MVC   PARM,PARM+5    C"C",C"C"

         BR    R9

PARMANAL XC    DW,DW

         LA    R2,DW

         BAL   R9,ANAL

         CLI   PARM,C' '

         ERR   BE,'PARM= MUST BE IN FROM/TO PAIRS'

         LA    R2,DW+4

         BAL   R9,ANAL

         LM    R1,R2,DW

         LA    R3,TRTBL(R1)

         STC   R2,0(R3)

         CLI   PARM,C' '

         BE    GETIN

         PUT   SYSPRINT,LINE-1

         B     PARMANAL

*

PUT      PUT   OUT,(0)

         AP    #PUT,P1

GETIN    GET   IN

         LR    R0,R1

         LH    R2,DCBLRECL-IHADCB+IN

LOOP     CH    R2,=H'256'

         BL    SHORT

         TR    0(256,R1),TRTBL

         LA    R1,256(R1)

         SH    R2,=H'256'

         BNM   LOOP

         B     PUT

         TR    0(0,R1),TRTBL

SHORT    EX    R2,SHORT-6

         B     PUT

*

OPEN     LA    R2,SYSPRINT

         BAL   R9,OPENOUT

         LA    R2,IN

         BAL   R9,OPENIN

         LA    R2,OUT

         BAL   R9,OPENOUT

         MVC   LINE,LINE-1

         PUT   SYSPRINT,LINE-1

         BR    R8

*

OPENOUT  MVC   DCBLINE(8),DCBDDNAM-IHADCB(R2)

         CLI   DCBRECFM-IHADCB(R2),0

         BNE   *+16

         MVC   DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN

         MVC   DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN

*

         PUSH  PRINT

         PRINT NOGEN

         OPEN  ((2),OUTPUT)

         MVC   DCBLINE+16(3),=C'OUT'

         CLC   =C'SYSPRINT',DCBLINE

         BNE   NOTSYSP

         PUT   SYSPRINT,LINE-1

         PUT   SYSPRINT,PARM-12

         MVC   LINE,LINE-1

         B     NOTSYSP

OPENIN   MVC   DCBLINE(8),DCBDDNAM-IHADCB(R2)

         OPEN  ((2),INPUT)

         POP   PRINT

         MVC   DCBLINE+16(3),=C' IN'

NOTSYSP  UNPK  DCBLINE+30(3),DCBRECFM-IHADCB(2,R2)

         TR    DCBLINE+30(2),HEX-240

         MVI   DCBLINE+32,C' '

         LH    R0,DCBLRECL-IHADCB(R2)

         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

DCBLINE  DC    C'........ OPENED OUTPUT, RECFM=.. LRECL='

*

         MVC   LINE+14(0),1(R14)

ERR      MVC   LINE,LINE-1

         SR    R1,R1

         IC    R1,0(R14)

         EX    R1,ERR-6

         LA    R15,LINE+17(R1)

         MVC   0(5,R15),=C'PARM='

         MVC   5(16,R15),PARM

*

         LA    R14,0(R14)

         SR    R14,R13

         STH   R14,12(R13)

         UNPK  16(5,R13),12(3,R13)

         TR    16(4,R13),HEX-240

         MVC   LINE(9),=C'ERROR AT '

         MVC   LINE+9(4),16(R13)

         TM    DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN

         BO    ERRPUT

         OPEN  (SYSPRINT,OUTPUT)

ERRPUT   PUT   SYSPRINT,LINE-1

         ABEND 1

*

Z        MVC   LINE(L'ED15),ED15

         ED    LINE(L'ED15),#PUT

         MVC   LINE+L'ED15+1(16),#PUT+8

         PUT   SYSPRINT,LINE-1

*

         CLOSE (IN,,OUT,,SYSPRINT)

         L     13,4(13)

         LM    14,12,12(13)

         SR    15,15

         BR    14

         LTORG

ED15     DC    X'40202020202020202020202020202120'

P1       DC    X'1C'

#PUT     DC    PL8'0',CL16'RECORDS WRITTEN',X'FF'

HEX      DC    C'0123456789ABCDEF'

DW       DC    2D'0'

         DC    C'        PARM='

PARM     DC    CL100' ',CL33' '

LINE     DC    CL133'EDITONE, V02.01, ASM &SYSDATE, &SYSTIME ',CL60' '

TESTHEX  DC    6X'00',41C' ',10X'00',6C' '

MAKEHEX  DC    X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'

XL       DC    A(XL+4+X'97000000')

         LA    R0,0

         CH    R0,DCBLRECL-IHADCB+OUT

         BNER  14

         MVC   DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN

         MVC   DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN

         BR    14

         PUSH  PRINT

         PRINT NOGEN

IN       DCB   DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=399,         X

               EODAD=Z

*UT      DCB   DDNAME=OUT,DSORG=PS,MACRF=PM,EXLST=XL

OUT      DCB   DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133

SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133

         POP   PRINT

*

TRTBL    DC    256AL1(*-TRTBL)

*

@@PAD#0  EQU   *-EDITONE+4095

@@PAD#1  EQU   @@PAD#0/(4097)

@@PAD#2  EQU   (@@PAD#1*4096)

         ORG   EDITONE+@@PAD#2

*

*        DCBD  DEVD=DA

*

         END   EDITONE