utlprint

If you send me an email, I'll be happy to email you the source.


*

* AGO .START

* C:\USERS\LIN\DOCUMENTS\Z390CODE\UTLPRINT

* SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\UTLPRINT

* SET IN=%G%.PRN

* SET OUT=%G%.OUTPUT.OUT.TXT

* ASMLG %G%.MLC TIME(1)

*

* NOTE THAT THIS WEIRD STUFF, AND THE EXTRA DCBS,

* WERE USED TO TEST THE CODE ON Z390.

*

* THIS IS A REWRITE OF A PROGRAM THAT I USED 50+ YEARS AGO.

* WHEN IT'S IN A FIXED FONT FILE, THE PROGRAM WILL LOOK FINE.

*

* .START ANOP

UTLPRINT START 0

USING *,13

YREGS

STM 14,12,12(13)

ST 15,8(13)

ST 13,4(15)

LR 13,15

L R1,0(R1)

LH R2,0(R1)

SH R2,=H'1'

BM OPEN

MVC LINE(0),2(R1)

EX R2,*-6

*

QPARM CLC =C'HEX',LINE

BNE NHEX

MVI FLAGHEX,C'H'

MVC LINE,LINE+4

B QPARM

NHEX CLI LINE,C'0'

BL BADPARM

LA R1,LINE

LA R1,1(R1)

CLI 0(R1),C'0'

BNL *-8

LA R2,1(R1)

S R1,=A(LINE+1)

PACK STOPAFT,LINE(0)

EX R1,*-6

MVC LINE,0(R2)

B QPARM

*

BADPARM CLI LINE,C' '

BE OPEN

MVI FLAGHEX,C'Z'

OI RC,12

MVC BADPARMM+16(9),LINE

*

PUSH PRINT

PRINT NOGEN

OPEN OPEN (IN,INPUT,OUT,OUTPUT)

POP PRINT

*

CLI FLAGHEX,C'Z'

BNE LDCB

LM R2,R3,=A(DOC,ENDDOC-4)

PRINTDOC MVC LINE(64),0(R2)

PUT OUT,LINE-1

LA R2,64(R2)

CR R2,R3

BL PRINTDOC

B EOD

*

LDCB LA R1,IN

BAL R9,LISTDCB

LA R1,OUT

BAL R9,LISTDCB

B GET

*

USING IHADCB,1

LISTDCB MVC DCBM+1(3),DCBDDNAM

UNPK DCBM+11(3),DCBRECFM(2)

TR DCBM+11(2),HEX-240

MVI DCBM+13,C','

LH R0,DCBLRECL

CVD R0,16(R13)

OI 23(R13),X'0F'

UNPK DCBM+21(5),21(3,R13)

LH R0,DCBBLKSI

CVD R0,16(R13)

OI 23(R13),X'0F'

UNPK DCBM+35(5),21(3,R13)

PUT OUT,DCBM

BR R9

DROP 1

DCBM DC CL133' ... RECFM=XX, LRECL=..... BLKSIZE=..... '

GET SP STOPAFT,=P'1'

BM EOD

GET IN

ZAP BYTE,=P'0'

AP REC#,=P'1'

OI REC#+5,X'0F'

UNPK LOC+1(7),REC#+2(4)

LR R2,R1

LH R3,DCBLRECL-IHADCB+IN

BCTR R3,0

B LOOP

PUT100 MVC LINE(100),0(R2)

PUT OUT,LOC

BAL R9,QHEX

MVC LOC,SPACES

LA R2,100(R2)

SH R3,=H'100'

LOOP OI BYTE+2,X'0F'

CLI LOC+3,C' '

BNE *+10

UNPK LOC+3(5),BYTE

AP BYTE,=P'100'

*

CLI BYTE+1,X'10' 00500C

BE PUTDEL

CLI BYTE+1,X'60'

BNE NODEL

PUTDEL PUT OUT,DELIM

*

NODEL CH R3,=H'100'

BH PUT100

MVC LINE,LINE-1

MVC LINE(0),0(R2)

EX R3,*-6

PUT OUT,LOC

BAL R9,QHEX

B GET

*

HEXMVC1 MVC HEXLINE(0),LINE

HEXTR1 TR HEXLINE(0),HEXF0

HEXMVC2 MVC HEXLINE(0),LINE

HEXTR2 TR HEXLINE(0),HEX0F

*

QHEX CLI FLAGHEX,C'H'

BNER R9

LA R4,99

CR R4,R3

BL *+6

LR R4,R3

*

EX R4,HEXMVC1

EX R4,HEXTR1

PUT OUT,HEXLINEP

*

EX R4,HEXMVC2

EX R4,HEXTR2

PUT OUT,HEXLINEP

*

MVC HEXLINE,HEXLINE-1

PUT OUT,HEXLINEP

BR R9

*

HEXF0 DC 16C'0',16C'1',16C'2',16C'3',16C'4',16C'5',16C'6',16C'7'

DC 16C'8',16C'9',16C'A',16C'B',16C'C',16C'D',16C'E',16C'F'

HEX0F DC 16C'0123456789ZBCDEF'

HEXLINEP DC CL9' '

HEXLINE DC CL133' '

*

EOD MVC LINE,LINE-1

OI REC#+5,X'0F'

UNPK LINE+1(11),REC#

MVC LINE+13(13),=C'RECORDS READ'

PUT OUT,LINE

CLOSE (IN,,OUT)

SR R15,R15

IC R15,RC

L 13,4(13)

L 14,12(13)

LM 0,12,20(13)

BR 14

LTORG

FLAGHEX DC C' '

RC DC X'00'

HEX DC C'0123456789ABCDEF'

*

REC# DC PL6'0'

BYTE DC PL3'0'

STOPAFT DC PL8'99999999999999'

LOC DC C' ....... '

LINE DC CL133' '

DELIM DC CL9' '

DC C'....5...10....5...20....5...30....5...40....5...50'

DC C'....5...60....5...70....5...80....5...90....5..100'

SPACES DC CL33' '

*

* PUSH PRINT

* PRINT NOGEN

* IN DCB DDNAME=IN,DSORG=PS,EODAD=EOD,MACRF=GL,LRECL=212,RECFM=FT

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

* POP PRINT

*

IN DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL

OUT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,LRECL=110,RECFM=FB,MACRF=PM

*

DOC DC CL64'UTLPRINT ASM &SYSDATE AT &SYSTIME PRINTS A FILE'

BADPARMM DC CL64' INVALID PARM, (.........) '

DC C'//UTLPRINT EXEC PGM=UTLPRINT ,PARM="HEX,##" '

DC C'//STEPLIB DD DISP=SHR,DSN= '

DC C'//OUT DD SYSOUT=* '

DC C'//IN DD DISP=SHR,DSN= '

DC C' --- OR --- '

DC C'//IN DD DISP=SHR,RECFM=U,LRECL=32767.BLKSIZE=32767,DSN= '

DC C' WOULD PRINT CONTENTS OF FILE W/O FORMATTING '

DC C' '

DC C'PARM=HEX PRINTS THE HEX CHARACTERS '

DC C'PARM=### LIMITS THE OUTPUT. PARM="12" PRINTS THE FIRST 12 RECS'

ENDDOC EQU *

DCBD DEVD=DA

END UTLPRINT