Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/putcpy.mac
There are 14 other files named putcpy.mac in the archive. Click here to see a list.
; UPD ID= 1600 on 5/15/84 at 8:55 AM by HOFFMAN                         
TITLE	PUTCPY FOR COBOL V13
SUBTTL	WRITE OUT A CPYFIL CHARACTER	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
	IFN TOPS20,<SEARCH MACSYM, MONSYM>
	%%P==:%%P

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

;EDITS
;V13*****************
;NAME	DATE		COMMENTS
;JEH	14-MAY-84	[1531] Use 'OUTSTR' in place of 'TTCALL' to nativise
;
;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
;********************

IFN TOPS20,<EXTERN	CPYBH>
IFE TOPS20,<EXTERN	CPYBHO>
EXTERN	CPYDEV,CPMAXN
EXTERN	SAVECP,SAVELN,SAVBLN,SAVBCP,EOLKAR

IFN TOPS20,<SYN CPYBH, CPYBHO>
ENTRY PUTCPY,PUTFEL,PUTCIF
IFE TOPS20,<
EXTERN	DEVDED
>
IFN TOPS20,<
EXTERN	RITCPY
>

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:	SKIPLE	DCCFLG		;ANYTHING SPECIAL FOR DATE-COMPILED?
	JRST	PUTCP3		;YES, DON'T PRINT THIS LINE
IFE TOPS20,<
	OUT	CPY,
	  JRST	PUTCP1
	MOVEI	CH,CPYDEV
	JRST	DEVDED
>
IFN TOPS20,<
	PUSHJ	PP,RITCPY
	JRST	PUTCP1
>

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:	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
	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:	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:	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
	MOVE	LN,CPYBHO+2	;STORE BUFFER COUNT ALSO
	MOVEM	LN,$LFCNT##

	AOS	LN,SAVELN	;GET NEW LINE NUMBER
IFN DEBUG,<
	AOS	%SRCLN##	;FOR COMPILATION SPEED
>
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
	OUTSTR	[ASCIZ "%CBLLNR Line number wrap-around occurred - source program too long
"]					;[1531]
	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,


	END