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

; UPD ID= 2867 on 5/22/80 at 5:05 PM by NIXON                           
TITLE	PUTCPY FOR COBOL V12B
SUBTTL	WRITE OUT A CPYFIL CHARACTER	AL BLACKINGTON/CAM



;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, 1981 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P

;EDITS
;V12*****************
;NAME	DATE		COMMENTS
;DMN	 9-FEB-79	[633] GIVE BETTER WARNING ON LINE NUMBER WRAP-AROUND
;DMN	 9-OCT-78	[571] FINALLY FIX 531 & 517
;EHM	28-MAR-78	[531] FIX 517 TO COMPILE COPIES CORRECTLY
;MDL	03-OCT-77	[517] IMPROVE READABILITY FOR .LST FILES
;********************


TWOSEG
RELOC	400000
SALL

ENTRY PUTCPY,PUTFEL,PUTCIF
EXTERNAL DEVDED

PUTCIF:	TSWF	FNOCPY		;ARE WE READING SOURCE BUT NOT OUTPUTTING?
	POPJ	PP,		;YES--DON'T WRITE

PUTCPY:	AOS	CP,SAVECP

	CAIE	CH,$LF		;END OF LINE?
	CAIN	CH,$FF
	JRST	PUTEOL		;YES

	CAILE	CP,CPMAXN	;ARE WE BEYOND PRINT PAGE?
	POPJ	PP,		;YES--RETURN

	CAIG	CP,6		;ARE WE IN SEQUENCE NUMBER FIELD?
	JRST	PUTSEQ		;YES

	CAIN	CH,$HT		;IS THIS A TAB?
	PUSHJ	PP,BMPCP	;YES

	CAIN	CP,7
	JRST	PUTCON

PUTCP0:	TSWF	FNOCPY		;ANY NEED FOR THE FILE?
	POPJ	PP,		;NO--RETURN
	SOSG	CPYBHO+2
	JRST	PUTCP2

PUTCP1:	IDPB	CH,CPYBHO+1
	POPJ	PP,

PUTCP2:
IFN ANS74,<
	SKIPLE	DCCFLG		;ANYTHING SPECIAL FOR DATE-COMPILED?
	JRST	PUTCP3		;YES, DON'T PRINT THIS LINE
>
	OUT	CPY,
	  JRST	PUTCP1
	MOVEI	CH,CPYDEV
	JRST	DEVDED

IFN ANS74,<
PUTCP3:	SWON	FNOCPY		;DON'T PRINT THE REST OF THIS LINE
	POPJ	PP,
>

;PUT SOMETHING INTO COLUMN 7
; [517] TREAT BLANKS AND TABS SAME AS OTHER CHARACTERS (EXCEPT
; "*" OR "-") IF IN COLUMN 7.
PUTCON:
IFN ANS74,<
	SKIPN	DCCFLG##	;ARE WE IN DATE-COMPILED PARAGRAPH?
	JRST	PUTCN0		;NO
	CAIE	CH,"*"		;YES, ONLY COMMENT LINES ARE SPECIAL
	CAIN	CH,"/"
	JRST	PUTCN0		;ALLOW THEM TO BE PRINTED
	HRRZS	DCCFLG		;SIGNAL LINE IS NOT TO BE PRINTED

PUTCN0:>
	CAIE	CH," "		;[571] CHECK FOR SPACE
	CAIN	CH,"/"		;OR SLASH
	JRST	PUTCP0		;[571]
	CAIE	CH,"-"
	CAIN	CH,"*"
	JRST	PUTCP0
IFN ANS74,<
	TSWF	FSEQ		;SEQUENCED INPUT?
	JRST	PUTCN1		;YES
	CAIE	CH,"\"		;IS IT \D
	JRST	PUTCN2		;NO
	JRST	PUTCP0		;POSSIBLY

PUTCN1:	CAIE	CH,"D"		;LOOK FOR D
	CAIN	CH,"d"
	JRST	PUTCP0		;YES
PUTCN2:>
	PUSH	PP,CH
	MOVEI	CH," "
	PUSHJ	PP,PUTCP0
;[517]	MOVEI	CH,10
;[517]	MOVEM	CH,SAVECP
	POP	PP,CH
	CAIN	CH,$HT		;[517] IF CHAR = TAB, SAVECP HAS ALREADY
	JRST	PUTCP0		;[517] BEEN BUMPED UP
	MOVEI	TE,10		;[531] [517] INCREMENT CHARACTER COUNT
	MOVEM	TE,SAVECP	;[531] [517] AND SAVE IT
	JRST	PUTCP0


;PUT A CHARACTER INTO SEQUENCE NUMBER

PUTSEQ:	CAILE	CH,137
	JRST	PUTSQ2
	CAIGE	CH," "
	JRST	PUTSQ3
	JRST	PUTCP0

PUTSQ2:	CAIG	CH,"z"
	CAIGE	CH,"a"
	JRST	PUTSQ3
	JRST	PUTCP0

PUTSQ3:	PUSH	PP,CH
	MOVEI	CH," "
	PUSHJ	PP,PUTCP0
	POP	PP,CH
	POPJ	PP,

;END-OF-LINE CHARACTER TO BE PUT OUT. START A NEW LINE.

PUTEOL:
IFN ANS74,<
	SKIPG	DCCFLG		;ARE WE IN SPECIAL DATE-COMPILED PARAGRAPH?
	JRST	PUTEL0		;NO, OUTPUT CURRENT LINE
	SWOFF	FNOCPY		;YES, TURN ON LISTING AGAIN INCASE BUFFER IS FULL
	MOVE	CH,$LFPTR	;RESET CPY BUFFER
	MOVEM	CH,CPYBHO+1	;TO JUST AFTER PREVIOUS EOL
	MOVE	CH,$LFCNT
	MOVEM	CH,CPYBHO+2
	MOVE	LN,SAVELN	;RESET LINE NUMBER TO CURRENT
	SETOM	DCCFLG		;RESET FLAG TO COPY NEXT LINE
	JRST	PUTFL1		;AND WIPE OUT CURRENT PARTIAL LINE

PUTEL0:>
	TSWF	FNOCPY;
	JRST	PUTFL2

	PUSH	PP,CH
	SKIPN	SAVBLN
	MOVEM	CP,SAVBCP
	MOVE	LN,SAVELN
	SKIPN	SAVBLN
	MOVEM	LN,SAVBLN

PUTEL1:	MOVE	CH,CPYBHO+1	;IS WORD FINISHED?
	TLNN	CH,760000
	JRST	PUTEL2		;YES

	MOVEI	CH,0		;NO--PUT OUT A NULL
	PUSHJ	PP,PUTCP0
	JRST	PUTEL1

PUTEL2:	POP	PP,CH

PUTFEL:
IFN ANS74,<
	MOVE	LN,CPYBHO+2	;GET CHAR COUNT LEFT
	CAIGE	LN,^D20		;ENOUGH TO GUARANTEE LF IN BUFFER?
	SETZM	CPYBHO+2	;NO, SO FORCE OUT BUFFER
>
	PUSHJ	PP,PUTCP0	;PUT OUT E-O-L CHARACTER
	MOVE	LN,CPYBHO+1	;GET DBP TO EOL CHAR
	MOVEM	LN,$LFPTR##	;SAVE IT
IFN ANS74,<
	MOVE	LN,CPYBHO+2	;STORE BUFFER COUNT ALSO
	MOVEM	LN,$LFCNT##
>

	AOS	LN,SAVELN	;GET NEW LINE NUMBER
PUTFL1:	LDB	CH,[POINT 7,LN,28]	;PUT OUT FIRST HALF OF LINE NUMBER
	TSWF	FRLIB		;IF THIS IS A LIBRARY FILE,
	IORI	CH,100		;  SET HIGH BIT
	PUSHJ	PP,PUTCP0
	MOVE	CH,LN		;PUT OUT OTHER HALF OF LINE NUMBER
	PUSHJ	PP,PUTCP0
	MOVEI	CH,1		;SET "LINE-NUMBER WORD" FLAG
	IORM	CH,@CPYBHO+1

PUTFL2:	SETZB	CP,SAVECP	;START NEW LINE
	MOVE	LN,SAVELN

	SETZM	EOLKAR
	CAIG	LN,17774	;TOO MANY LINES?
	POPJ	PP,		;NO--RETURN

	SETZB	LN,SAVELN	;RESET LINE NUMBER
	TTCALL	3,[ASCIZ "%CBLLNR Line number wrap-around occured - source program too long
"]
	AOS	WRAPNO##	;[633] COUNT THE NO. OF TIMES
	POPJ	PP,

;TAB BEING PUT OUT--RESET SAVECP

BMPCP:	MOVE	CH,SAVECP
	ADDI	CH,1		;IT ALWAYS POINTS AT PREVIOUS CHARACTER
	IORI	CH,7
	SUBI	CH,1
	MOVEM	CH,SAVECP

	MOVEI	CH,$HT
	POPJ	PP,


EXTERNAL CPYBHO,CPYDEV,CPMAXN
EXTERNAL SAVECP,SAVELN,SAVBLN,SAVBCP,EOLKAR

	END