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