Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
putcpy.mac
There are 14 other files named putcpy.mac in the archive. Click here to see a list.
; UPD ID= 1709 on 2/13/79 at 8:56 AM by N:<NIXON>
TITLE PUTCPY FOR COBOL V12
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, 1979 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 LIBRARY BUT NOT OUTPUTTING?
POPJ PP, ;YES--DON'T WRITE
PUTCPY: AOS CP,SAVECP
CAIE CH,12 ;END OF LINE?
CAIN CH,14
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,11 ;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: OUT CPY,
JRST PUTCP1
MOVEI CH,CPYDEV
JRST DEVDED
;PUT SOMETHING INTO COLUMN 7
; [517] TREAT BLANKS AND TABS SAME AS OTHER CHARACTERS (EXCEPT
; "*" OR "-") IF IN COLUMN 7.
PUTCON:
;[517] CAIE CH," "
;[517] CAIN CH,11
;[517] JRST PUTCP0
CAIN CH," " ;[571] CHECK FOR SPACE
JRST PUTCP0 ;[571]
CAIE CH,"-"
CAIN CH,"*"
JRST PUTCP0
IFN ANS74,<
CAIN CH,"/" ;SLASH
JRST PUTCP0 ;YES
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,11 ;[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"+40
CAIGE CH,"A"+40
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: 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+1 ;GET CHAR COUNT LEFT
CAIGE LN,^D20 ;ENOUGH TO GUARANTEE LF IN BUFFER?
SETZM CPYBHO+1 ;NO, SO FORCE OUT BUFFER
>
PUSHJ PP,PUTCP0 ;PUT OUT E-O-L CHARACTER
IFN ANS74,<
MOVE LN,CPYBHO+1 ;GET DBP TO EOL CHAR
MOVEM LN,$LFPTR## ;SAVE IT
>
AOS LN,SAVELN ;GET NEW LINE NUMBER
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 "[SOURCE PROGRAM TOO LONG - LINE NUMBER WRAP-AROUND OCCURED]
"]
AOS WRAPNO## ;[633] COUNT THE NO. OF TIMES
POPJ PP,
;TAB BEING PUT OUT--RESET SAVECP
BMPCP: MOVE CH,SAVECP
ADDI CH,4
ANDCMI CH,7
ADDI CH,3
MOVEM CH,SAVECP
MOVEI CH,11
POPJ PP,
EXTERNAL CPYBHO,CPYDEV,CPMAXN
EXTERNAL SAVECP,SAVELN,SAVBLN,SAVBCP,EOLKAR
END