Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
putcpy.mac
There are 14 other files named putcpy.mac in the archive. Click here to see a list.
; UPD ID= 2867 on 5/22/80 at 5:05 PM by NIXON
TITLE PUTCPY FOR COBOL V12C
SUBTTL WRITE OUT A CPYFIL CHARACTER AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
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
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
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