TITLE 'PRINT - PC/370 PRINT UTILITY'
*
* AUTHOR.    Don Higgins.
* DATE.      03/29/86. (Copied and modified from DEMOSRC.ALC)
* REMARKS.   PC/370 utility program to read selected text file
*            and print it with page control.
*
* COPYRIGHT. None.  This is a public domain program.
*
* MAINTENANCE.
*
* 05/18/87 CONVERTED TO RELEASE 2 DCB FORMAT
*
* INPUT
*
*  1.  A>PRINT drive:file
*
* OUTPUT
*
*  1.  File will be printed on the standard printer device with
*      page control added via TITLE, EJECT, and SPACE statements as
*      defined in standard OS/VS assembler.
*
PRINT    CSECT
	LR    R13,R15
	USING PRINT,R13
	LA    R2,=C'PC/370 PRINT UTILITY R2.0 05/18/87$'
	SVC   WTO
	LA    R2,=C' $'
	SVC   WTO
	LA    R2,SYSUT1
	USING IHADCB,R2
	L     R1,0(R1)  ADDR PARM LENGTH
	LA    R1,3(R1)  SET R1 = FILENAME IN PARM+1
	ST    R1,DCBDSN SET FILENAME ADDR IN DCB
	DROP  R2
	SVC   OPEN
	LA    R1,ASCTITLE
	LA    R2,L'ASCTITLE+L'ASCEJECT+L'ASCSPACE
	SVC   EBCASC
	LA    R2,=C'ENTER P FOR PRINTER OUTPUT OR ANY KEY FOR CONSOLE$'
	SVC   WTO
	SVC   READKEY
	STC   R0,OPTION
MAINLOOP EQU   *
	BAL   R12,GETREC
	LTR   R15,R15         TEST FOR END OF FILE
	BNZ   EOJ
	BAL   R14,SCAN
	LTR   R15,R15         TEST FOR COMMAND AND SKIP PRINTING IT
	BNZ   MAINLOOP
	AP    LINE,=P'1'
	CP    LINE,MAXLINE
	BNH   NEXTLINE
	BAL   R11,NEWPAGE
NEXTLINE EQU   *
	LA    R0,RECORD
	BAL   R12,PUTREC
	B     MAINLOOP
EOJ      EQU   *
	LA    R2,SYSUT1
	SVC   CLOSE
	SVC   EXIT
	TITLE 'SCAN FOR TITLE, EJECT, AND SPACE COMMANDS'
SCAN     EQU   *
	CLI   RECORD,ASCBLK
	BE    SCANOP
	CLI   RECORD,ASCTAB
	BNE   SCANEXIT        EXIT IF FIRST CHAR. NOT BLANK OR TAB
SCANOP   EQU   *
	LA    R4,RECORD+1
SKIPBLK  EQU   *
	CLI   0(R4),ASCLF
	BE    SCANEXIT
	CLI   0(R4),ASCBLK
	LA    R4,1(R4)
	BE    SKIPBLK
	BCTR  R4,0
	CLC   0(5,R4),ASCTITLE
	BE    TITLE
	CLC   0(5,R4),ASCEJECT
	BE    EJECT
	CLC   0(5,R4),ASCSPACE
	BE    SPACE
SCANEXIT EQU   *
	SR    R15,R15
	BR    R14
TITLE    EQU   *
	LA    R4,5(R4)
FINDQ1   EQU   *
	CLI   0(R4),ASCBLK
	BL    SCANEXIT     IGNORE TITLE IF FIRST QUOTE NOT FOUND
	CLI   0(R4),ASCQ
	LA    R4,1(R4)
	BNE   FINDQ1
	LA    R3,TITLEMSG
FINDQ2   EQU   *
	CLI   0(R4),ASCBLK
	BL    SETTITLE     TRUNCATE IF SECOND QUOTE NOT FOUND
	CLI   0(R4),ASCQ
	BE    SETTITLE
	CL    R3,=A(TITLEMSG+L'TITLEMSG)
	BNL   SETTITLE     TRUNCATE IF TOO LONG
	MVC   0(1,R3),0(R4)  COPY TITLE
	LA    R3,1(R3)
	LA    R4,1(R4)
	B     FINDQ2
SETTITLE EQU   *
	CL    R3,=A(TITLEMSG+L'TITLEMSG)
	BNL   EJECT
	MVI   0(R3),ASCBLK    PAD WITH BLANKS
	LA    R3,1(R3)
	B     SETTITLE
EJECT    EQU   *
	BAL   R11,NEWPAGE
	LA    R15,1
	BR    R14
SPACE    EQU   *
	LA    R0,SPACEMSG
	BAL   R12,PUTREC
	LA    R0,SPACEMSG
	BAL   R12,PUTREC
	AP    LINE,=P'2'
	LA    R15,1
	BR    R14
	TITLE 'NEWPAGE - PRINT HEADING'
NEWPAGE  EQU   *
	AP    PAGE,=P'1'
	ZAP   LINE,=P'0'
	MVC   DPAGE,MASK
	ED    DPAGE,PAGE
	MVC   PAGEMSG,PAGEWORK
	LA    R1,PAGEMSG
	LA    R2,L'PAGEMSG
	SVC   EBCASC
	LA    R0,HEADING
	BAL   R12,PUTREC
	MVI   HEADCC,ASCFF   FORCE FORM FEED AFTER FIRST PAGE
	LA    R0,SPACEMSG
	BAL   R12,PUTREC     SKIP SPACE AFTER TITLE
	BR    R11
	TITLE 'GETREC - GET NEXT TEXT RECORD OR SET EOF'
GETREC   EQU   *
	LA    R2,SYSUT1
	LA    R1,RECORD
	SVC   GET
	SR    R15,R15
	BR    R12
EOFRTN   EQU   *
	LA    R15,1
	BR    R12
SYNRTN   EQU   *
	LA    R2,=C'IO ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	TITLE 'PUTREC - PUT RECORD TO STD. PRINT DEVICE'
PUTREC   EQU   *
	LR    R4,R0
PUTLOOP  EQU   *
	IC    R2,0(R4)
	CLI   0(R4),ASCTAB
	LA    R3,1
	BNE   PUTCHAR
	LA    R3,9
	LA    R2,ASCBLK
PUTCHAR  EQU   *
	SVC   CONSOLEC       PRINT ON CONSOLE
	CLI   OPTION,ASCP
	BE    ISUSVC
	CLI   OPTION,ASCPL
	BE    ISUSVC
	B     PUTSKPP
ISUSVC   SVC   PRINTC         PRINT ON STD. OUTPUT DEVICE ALSO
PUTSKPP  EQU   *
	BCT   R3,PUTCHAR
	CLI   0(R4),ASCLF
	LA    R4,1(R4)
	BNE   PUTLOOP
PUTEXIT  EQU   *
	SR    R15,R15
	BR    R12
	TITLE 'DATA SECTION'
	LTORG
*
* REGISTER USAGE
*
R0       EQU   0 SVC RETURN CODE
R1       EQU   1 SVC ARGUMENT
R2       EQU   2 SVC ARGUMENT (DCB ADDRESS, DMA, MSG, ETC.)
R3       EQU   3 POINTER FOR MOVING TITLE
R4       EQU   4 OUTPUT BYTE PTR FOR PUTREC
R11      EQU   11 LINK FOR NEWPAGE
R12      EQU   12 LINK FOR GETREC AND PUTREC
R13      EQU   13 BASE
R14      EQU   14 LINK FROM MAINLINE TO ROUTINES
R15      EQU   15 RETURN CODE FROM ROUTINES
*
* PC/370 SVC'S
*
EXIT     EQU   0
OPEN     EQU   1
CLOSE    EQU   2
GET      EQU   5
PUT      EQU   6
TRACE    EQU   9
GMAIN    EQU   10
FMAIN    EQU   11
ASCEBC   EQU   12
EBCASC   EQU   13
READKEY  EQU   200+1  MS-DOS SVC 1 READ KEY
CONSOLEC EQU   200+2  MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
PRINTC   EQU   200+5  MS-DOS SVC 5 PRINT CHAR IN R2 ON STD. PRINTER
WTO      EQU   200+9  MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
*
* DATA AREAS
*
TBUFF    EQU   X'80'  BUFFER FOR DIRECTORY SEARCH
RECORD   DS    XL256   LOGICAL RECORD AREA
ASCLF    EQU   X'0A'   ASCII LINE FEED
ASCCR    EQU   X'0D'   ASCII CARRIAGE RETURN
ASCASK   EQU   X'2A'   ASCII ASTERISK FOR ALC COMMENT CHECK
ASCBLK   EQU   X'20'   ASCII SPACE
ASCQ     EQU   X'27'   ASCII QUOTE
ASCTAB   EQU   X'09'   ASCII TAB
ASCFF    EQU   X'0C'   ASCII FORM FEED
ASCP     EQU   X'50'   UPPERCASE ASCII P
ASCPL    EQU   X'70'   LOWER CASE ASCII P
OPTION   DC    X'00'
ASCTITLE DC    C'TITLE'
ASCEJECT DC    C'EJECT'
ASCSPACE DC    C'SPACE'
PAGE     DC    PL2'0'
LINE     DC    PL2'50'
MAXLINE  DC    PL2'50'
MASK     DC    X'40202020'  EDIT MASK FOR PL2
HEADING  EQU   *
HEADCC   DC    AL1(ASCBLK)
TITLEMSG DC    0CL65' ',65AL1(ASCBLK),2AL1(ASCBLK)
PAGEMSG  DC    0CL8' ',9AL1(ASCBLK)
SPACEMSG DC    AL1(ASCCR,ASCLF)     END OF HEADING
WORK     DC    0CL20' '
PAGEWORK DC    0CL8' ',C'PAGE'
DPAGE    DC    CL4' ZZZ'
	COPY  CPY/IHADCB
*
* END OF DSECT
*
PRINT    CSECT
SYSUT1   DC    0F'0',C'ADCB'
	DC    A(TBUFF+7)           PATH/FILE NAME IN OS/VS PARM
	DC    X'FFFF'
	DC    X'00'
	DC    C'SGT'               SEQ. GET TEXT
	DC    X'0A1A'
	DC    H'255'               LRECL
	DC    H'8192'              BLKSZ
	DC    A(EOFRTN)            EODAD
	DC    A(SYNRTN)            SYNAD
	DC    A(RECORD)            RECORD AREA
	DC    XL(SYSUT1+LDCB-*)'00'
	END   PRINT