TITLE	PUTLST FOR RPGII 1A(1)
		
SUBTTL	ROUTINES TO WRITE LSTFIL		AL BLACKINGTON/CAM/RBC

;COPYRIGHT 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MA.

;MODIFIED TO RPGII VERSION JUNE,25 1975			BOB CURRIER

TWOSEG
RELOC	400000

ENTRY	PUTLST		;PUT A CHARACTER OUT ONTO LSTFIL
ENTRY	PUTDEC		;PUT A DECIMAL NUMBER IN LISTING
ENTRY	HDROUT		;PRINT OUT PAGE HEADING LINE
ENTRY	LCRLF		;PRINT A CR-LF

EXTERN	LSTBH

;PUT A CHARACTER OUT ONTO LSTFIL

PUTLST:	TSWF	FNOLST		;ANY LISTING FILE?
	POPJ	PP,		;NO--RETURN

	SOSG	LSTBH+2
	JRST	PUTLS2
PUTLS1:	IDPB	CH,LSTBH+1
	POPJ	PP,

;BUFFER IS FULL - WRITE IT OUT

PUTLS2:	AOS	LSTBLK##	;KICK UP BLOCK COUNT
	OUT	LST,
	JRST	PUTLS1		;NO ERRORS -- RETURN

	PUSH	PP,CH		;ERROR -- SAVE CH
	GETSTS	LST,CH
	MOVSS	CH
	HRRI	CH,LSTDEV##	;PUT OUT MESSAGE
	PUSHJ	PP,DEVERA##
	JRST	PUTLS3		;DEVICE IS MTA
	USETO	LST,@LSTBLK
PUTLS4:	SETSTS	LST,0		;CLEAR ERROR FLAGS
	POP	PP,CH		;GET OUTPUT CHARACTER BACK
	JRST	PUTLS2+1	;RETRY
;MAG-TAPE -- BACKSPACE AND ERASE, OR WRITE EOT

PUTLS3:	GETSTS	LST,CH		;END OF TAPE?
	TRNE	CH,$EOT
	JRST	PUTLS5

	MTAPE	LST,7		;NO--BACKSPACE
	MTAPE	LST,13		;ERASE
	JRST	PUTLS4		;TRY AGAIN

PUTLS5:	MTAPE	LST,3		;WRITE 2 EOF'S
	MTAPE	LST,3
	MTAPE	LST,11		;REWIND AND UNLOAD

	MOVEI	CH,LSTDEV
	PUSHJ	PP,EOTAPE##
	POP	PP,CH
	JRST	PUTLS1

;PUT OUT CARRIAGE-RETURN, LINE-FEED ON LISTING

LCRLF:	MOVEI	CH,15
	PUSHJ	PP,PUTLST
	MOVEI	CH,12
	SOSLE	PAGCNT		;PRINTER PAGE FULL?
	JRST	PUTLST		;NO
	JRST	HDROT2		;YES
;PUT OUT HEADING LINE ON NEW PAGE

HDROUT:	MOVE	CH,PAGCNT##	;IF ALREADY
	CAIL	CH,LINPAG##	;  AT TOP OF PAGE,
	POPJ	PP,		;  FORGET IT

	MOVEI	CH,15		;PUT OUT
	PUSHJ	PP,PUTLST	;  CARRIAGE-RETURN

	AOSL	HDRPAG##	;IF PAGE NUMBER IS NOT LETTER,
	SETOM	SUBPAG##	;  SET SUB-PAGE TO MINUS ONE

HDROT2:	MOVEI	CH,14		;PUT OUT
	PUSHJ	PP,PUTLST	;  FORM-FEED

	MOVEI	CH,LINPAG+3	;RESET
	MOVEM	CH,PAGCNT	;  LINES PER PAGE

	MOVE	CH,PHASEN##	;IF WE ARE NOT
	CAIGE	CH,"F"		;  YET TO PHASE F,
	JRST	HDROT8		;  NO HEADER WANTED

	PUSH	PP,TA		;SAVE
	PUSH	PP,TB		;  AC'S

	SKIPA	TA,[POINT 7,HEADER##];PUT
HDROT3:	PUSHJ	PP,PUTLST	;  OUT HEADING
	ILDB	CH,TA		;  THROUGH
	JUMPN	CH,HDROT3	;  'PAGE '

	MOVE	TB,HDRPAG	;PRINT
	PUSHJ	PP,PUTPAG	;  PAGE NUMBER

	AOSG	TB,SUBPAG	;BUMP SUB-PAGE
	JRST	HDROT4		;IT IS NOT YET POSITIVE, DON'T PRINT
	MOVEI	CH,"-"		;PUT OUT
	PUSHJ	PP,PUTLST	;  HYPHEN
	PUSHJ	PP,PUTPAG	;PUT OUT SUB-PAGE

HDROT4:	PUSHJ	PP,LCRLF
	SKIPA	TA,[POINT 7,HEADR2##]
HDROT9:	PUSHJ	PP,PUTLST	;WRITE 2ND LINE OF HEADER
	ILDB	CH,TA
	JUMPN	CH,HDROT9

	POP	PP,TB		;RESTORE
	POP	PP,TA		;  AC'S

HDROT8:	PUSHJ	PP,LCRLF	;PUT OUT TWO LINE-FEEDS
	JRST	LCRLF		;  AND LEAVE
;PUT OUT PAGE NUMBER

PUTPAG:	JUMPL	TB,PUTPG2	;IF LETTER, JUMP

PUTDEC:	IDIVI	TB,^D10		;TA = LOW ORDER DIGIT
	HRLM	TA,(PP)		;SAVE IT ON STACK
	SKIPE	TB		;LOOP UNTIL
	PUSHJ	PP,PUTDEC	;  ALL DIGITS OUT
	HLRZ	CH,(PP)		;GET DIGIT BACK
	ADDI	CH,"0"		;CONVERT TO ASCII
	JRST	PUTLST		;PUT IT OUT

PUTPG2:	LDB	CH,[POINT 7,TB,6]
	JRST	PUTLST

	END