Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 722 on 1/10/83 at 11:47 PM by NIXON                           
TITLE	PUTLST FOR COBOL V13
SUBTTL	ROUTINES TO WRITE LSTFIL		AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;********************


IFE TOPS20,<
ENTRY	PUTLST		;PUT A CHARACTER OUT ONTO LSTFIL
>
ENTRY	PUTDEC		;PUT A DECIMAL NUMBER IN LISTING
ENTRY	LSTMES		;PUT AN ASCII STRING ONTO LISTING FILE
ENTRY	HDROUT		;PRINT OUT PAGE HEADING LINE
ENTRY	LCRLF		;PRINT A CR-LF

IFN TOPS20,<
EXTERN	PUTLST
>
EXTERN	LSTBH

IFE TOPS20,<
;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 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 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 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

;PRINT ASCII TEXT
;ENTER WITH A BYTE POINTER TO THE TEXT STRING IN "TE".

	PUSHJ	PP,PUTLST
LSTMES:	ILDB	CH,TE
	JUMPN	CH,LSTMES-1
	POPJ	PP,

	END