; DSPLOG.PGM - CMD FILE TO CMP/TKB PROGRAM DSPLOG
	.OPEN DSPLOG.FTN
.ENABLE DATA
C@SD@ DSPLOG   -   PROGRAM
C
C*  PROGRAM ID:  DSPLOG   (DISPLAY LOGIC)
C*
C*  CREATED ON 15 APR 81 FOR PROJECT 113201
C*	AS OF: 20 MAY 82
C*
C*  ANALYST/PROGRAMMER:  MAJOR CARL S. ZIMMERMAN
C*			 USAFETAC/AD
C*			 SCOTT AFB, IL  62225
C*
C*  DESCRIPTION:  THIS PROGRAM IS DESIGNED TO PRINT "DISPLAY LOGIC
C*  STRUCTURE" DOCUMENTATION CARDS FROM ANY SOURCE FILE(S).  IT IS
C*  INTENDED TO BE USED ON FORTRAN SOURCE PROGRAM FILES WHICH CONTAIN
C*  EMBEDDED USER MANUALS OR SPECIAL COMMENT CARDS REFLECTING THE
C*  LOGICAL STRUCTURE OF THE FORTRAN PROGRAM.
C*
C*  INSTRUCTIONS:
C*
C*  1)  UNDER RSX ON THE PDP SYSTEM:
C*
C*      >RUN $DSPLOG
C*  THE PROGRAM WILL SOLICIT FILE SPECIFICATIONS FROM THE USER.
C*  RESPOND WITH ANY OF THE FOLLOWING:
C*
C*    A)  ANY LEGAL "FILENAME.TYP", WHICH WILL BE TAKEN AS THE NAME OF
C*      A SOURCE FILE TO BE SCANNED FOR LOGIC CODE;
C*
C*    B)  "@FILENAME.TYP", WHICH WILL BE USED AS THE NAME OF AN INDIRECT
C*      FILE CONTAINING THE NAMES OF ONE OR MORE SOURCE FILES TO BE 
C*      SCANNED FOR LOGIC CODE;
C*
C*    C)  <CR> TO TERMINATE FILE PROCESSING AND DISPATCH PRINT TO
C*	PRINTER.  THE OUTPUT FILENAME IS "DISPLOGIC.LST" UNDER THE
C*	USER'S UIC.  THIS ALLOWS THE USER LATER TO SPOOL MULTIPLE COPIES
C*	IF DESIRED.  ONE COPY WILL BE SPOOLED TO THE PRINTER AUTOMATIC-
C*	ALLY WHEN THE PROGRAM STOPS.
C*
C*  WARNING:  IF YOU RUN FROM A PRINTER TERMINAL, SOME OF THE MESSAGES
C*  WILL BE UNREADABLE BECAUSE OF OVERPRINTING.  THE OUTPUT MESSAGES
C*  ARE DESIGNED TO MAKE A NEAT DISPLAY ON A CRT.
C*
C*  2)  UNDER DOS ON THE IBM SYSTEM, ORGANIZE YOUR CARD DECK IN THE
C*   FOLLOWING MANNER (WITH APPROPRIATE JCL BEFORE AND AFTER):
C*	// DLBL IJSYS01
C*	// EXTENT SYS001,,1,0,100,200
C*	// ASSGN  SYS001,&PWORK(D)	FORTRAN 4 = WORK FILE
C*	// ASSGN SYS003,X'LST'		FORTRAN 6 = PRINT OUTPUT
C*	// EXEC ADMDSPLO
C*	NAME: P.PGMNAME		)
C*	// EPROC P.PGMNAME       >>-- REPEAT AS MUCH AS NEEDED
C*	/*			)     (I.E. ANY NBR OF INPUT FILES)
C*	/*			EMPTY INPUT FILE STOPS EXECUTION
C*
C*  3)  UNDER CMS ON THE IBM SYSTEM, THERE IS AN EXEC CALLED "DSPLOG",
C*   AVAILABLE TO ALL USERS, WHICH IS DESIGNED TO SET UP INPUT FOR THIS
C*   PROGRAM.  SEE ITS DOCUMENTATION FOR FURTHER INFORMATION.
C*
C*  ON ANY OF THESE THREE SYSTEMS, ANY NUMBER OF FILENAMES MAY BE
C*  SUPPLIED, IN ANY DESIRED ORDER.  THE PROGRAM WILL START PRINTING
C*  FROM EACH SOURCE FILE AT THE TOP OF A NEW PAGE.  PRINTOUT BEARS DUAL
C*  PAGE NUMBERING--GLOBAL (WHICH IS CONTINUOUS THROUGHOUT THE PRINT)
C*  AND LOCAL (WHICH RESTARTS WITH EVERY NEW INPUT SOURCE FILE).  IF
C*  MORE THAN ONE FILE IS INPUT, THEN AN INDEX WILL BE PRINTED AT THE
C*  END.
C*
C*  INPUT:  FILE(S) SPECIFIED BY USER, ACCESSED UNDER LUN 1;
C*	INDIRECT FILE ("@ FNAME" FOR RSX, OR "* INDIRECT" FOR CMS),
C*	ACCESSED UNDER LUN 3 (NOT USED BY DOS).
C*
C*  WORK:  LUN 4 IS USED FOR DEVELOPING THE MULTI-FILE INDEX.
C*
C*  OUTPUT:  A SINGLE PRINT FILE ON LUN 6 REFLECTING SPECIALLY MARKED
C*  LINES FROM THE INPUT FILE AS FOLLOWS:
C*    "C@SD" IN COL.1-4:	COL.7-80 OF THIS INPUT LINE WILL BECOME
C*	   THE PAGE HEADING LINE; LOCAL PAGE NUMBERING WILL RESTART
C*	   FROM 1, AND A PAGE EJECT TO THIS NEW HEADING WILL OCCUR
C*	   AT THE NEXT PRINTABLE LINE (SEE BELOW).  A FLAG MESSAGE WILL
C*	   BE PRINTED IN THE RIGHT MARGIN OF THE OUTPUT.  ALSO TURNS ON
C*	   PRINTING OF ALL INPUT LINES UNTIL "C@ED" IN COL.1-4 IS
C*	   ENCOUNTERED.
C*    "CH" IN COL.1-2:	IF THIS IS THE FIRST SPECIAL LINE FOUND,
C*  	   THEN IT IS TREATED EXACTLY AS A "C@SD" LINE (SEE ABOVE).
C*  	   IF IT IS NOT THE FIRST SUCH LINE, THEN IT IS TREATED
C*  	   SIMILARLY EXCEPT THAT LOCAL PAGE NUMBERING IS NOT RESTARTED.
C*    "C*" IN COL.1-2:	THE ENTIRE LINE IS PRINTED EXACTLY AS INPUT,
C*  	   UNLESS RECOGNITION IS DISABLED (SEE "CF" LINE BELOW).
C*    "CF" IN COL.1-2:	DISABLE (TURN OFF) RECOGNITION OF "C*".
C*  	   THIS ALLOWS SUPPRESSING OF PRINTING OF COMMENT LINES WHICH
C*  	   WERE STARRED FOR SOME REASON OTHER THAN DISPLAYING LOGIC
C*  	   STRUCTURE.
C*    "CN" IN COL.1-2:	ENABLE (TURN ON) RECOGNITION OF "C*"
C*  	   LINES (THIS IS THE DEFAULT CONDITION WHEN FILE INPUT BEGINS).
C*    "CA" IN COL.1-2:	TURN ON PRINTING OF ALL INPUT LINES UNTIL
C*  	   THE NEXT "C*" LINE IS ENCOUNTERED (WHETHER OR NOT RECOGNITION
C*  	   OF "C*" LINES IS ENABLED).  THIS FEATURE IS USEFUL EITHER TO
C*  	   PRINT EXISTING UN-STARRED COMMENT LINES OR TO PRINT PORTIONS
C*  	   OF UN-COMMENTED CODE (FOR EXAMPLE, THE SPECIFICATION STATE-
C*  	   MENTS AT THE BEGINNING OF A FORTRAN PROGRAM).  NOTE:  THIS
C*	   FUNCTION IS NOT NEEDED BETWEEN "C@SD" AND "C@ED" LINES, SINCE
C*	   EVERYTHING IN THAT ZONE WILL BE PRINTED ANYWAY (SEE NOTE 2
C*	   BELOW).
C*    "C@PG" IN COL.1-4:  CAUSE PAGE-EJECT IN THE PRINTOUT.  THIS
C*	   FEATURE MAY BE USED TO AVOID SPLITTING PARAGRAPHS OR LOGIC
C*	   STRUCTURES ACROSS PAGE BOUNDARIES.
C*
C*  NOTES:
C*
C*    1)  IF "C*" LINES ARE FOUND BEFORE A "CH" OR "C@SD" LINE IN A
C*  	SINGLE FILE, THEY WILL BE PRINTED UNDER A BLANK PAGE HEADING.
C*
C*    2)  THE "SD" LINES NEED "@" IN COL.5 ALSO, TO CONFORM TO THE
C*  	REQUIREMENTS OF THE "PRINTDOC" PROGRAM.  IF AN "SD" LINE IS
C*  	INCLUDED TO START AN EMBEDDED USER'S MANUAL, THEN THERE MUST BE
C*  	MUST BE A CORRESPONDING "C@ED@" LINE TO TERMINATE IT.  THIS IS
C*  	NORMALLY PLACED BEFORE ANY EXECUTABLE CODE.  IT WILL NOT BE
C*  	PRINTED BY DSPLOG, ALTHOUGH A FLAG MESSAGE WILL BE PRINTED IN
C*	THE RIGHT MARGIN OF THE OUTPUT.  ALL LINES BETWEEN THE "C@SD"
C*	AND "C@ED" FLAGS WILL BE PRINTED, REGARDLESS OF THEIR INDIVIDUAL
C*	FLAGGING.
C*
C*    3)  THE COMMENTS IN THE SOURCE TEXT OF THIS PROGRAM ARE AN EXAMPLE
C*      OF SUCH SPECIAL COMMENT USAGE IN A STRUCTURED PROGRAM WHERE
C*	INDENTATION IS USED TO PRESENT THE PROGRAM STRUCTURE TO THE
C*	READER.
C*
C*  SUBPROGRAMS USED:
C*  1)  ON PDP SYSTEM,
C*  	PDP SYSTEMS ROUTINES:	DATE
C*  	ETAC SUBROUTINES:	TRMSG
C*  	INTERNAL SUBROUTINES:	HEDSTO, FPRINT
C*  2)  ON IBM SYSTEM UNDER CMS OR DOS,
C*	INTERNAL SUBROUTINES:	HEDSTO, FPRINT, INSETF (FUNCTION).
C*	ETAC SUBROUTINES:	TODAY
C*
C*  STORAGE REQUIREMENTS:
C*  1)  ON PDP SYSTEM, 6K WORDS (12 K BYTES)
C*  2)  ON IBM SYSTEM, UNDER CMS, 158K BYTES (30K PGM + 128K BASE)
C*  3)  ON IBM SYSTEM, UNDER DOS, 19K BYTES (PROGRAM)
C*
C*  HISTORY:
C*	15 APR 81:  CREATED BY MAJ.CARL S. ZIMMERMAN FOR PROJECT 113201.
C*	20 MAY 82 (MAJ.ZIMMERMAN, 237900):  DOCUMENTATION UPDATED AND
C*		SOME MINOR FORMAT CHANGES MADE.  EUM SWITCH ADDED FOR
C*		COMPATIBILITY WITH CMS VERSION.
C*
C*  TIMING:  DEPENDENT ON NUMBER AND LENGTH OF USER-SUPPLIED INPUT
C*	FILES.
C*
C
C************************************************************************
C*									*
C*	THIS SOFTWARE IS RELEASED FOR PUBLIC USE UNDER THE PROVISIONS	*
C*	OF AIR FORCE REGULATION 300-6, MAC SUPPLEMENT 1, PARA.11-7,	*
C*	BY USAFETAC/ADW, SCOTT AFB, IL 62225.  THIS SOFTWARE IS 	*
C*	RELEASED "AS-IS"; THE U. S. AIR FORCE HAS NO WARRANTY		*
C*	RESPONSIBILITY OR LIABILITY FOR THE OPERATION OR USE OF		*
C*	SOFTWARE RELEASED UNDER THIS POLICY.				*
C*									*
C*	RELEASE OF THIS SOFTWARE IS BEING DONE THROUGH DECUS, SO	*
C*	ALL USUAL DECUS DISCLAIMERS APPLY AS WELL.			*
C*									*
C*	UNDER THE PROVISIONS OF THE REGULATION CITED ABOVE, NO		*
C*	CONTRACTOR MAY CHARGE THE GOVERNMENT FOR THE USE OF THIS	*
C*	SOFTWARE DURING THE PERFORMANCE OF ANY CONTRACT WITH THE	*
C*	GOVERNMENT.							*
C*									*
C*	USERS WHO OBTAIN THIS SOFTWARE THROUGH DECUS DISTRIBUTION	*
C*	ARE WELCOME TO SEND COMMENTS TO THE AUTHOR, AS FOLLOWS:		*
C*		USAFETAC/ADW						*
C*		ATTN: MAJOR CARL S. ZIMMERMAN				*
C*		SCOTT AFB, IL  62225					*
C*	GIVEN THE EXIGENCIES OF MILITARY SERVICE, A REPLY TO YOUR	*
C*	COMMENTS CANNOT BE GUARANTEED.					*
C*									*
C************************************************************************
C
C@ED@
C
C*-------------------- END OF EMBEDDED USER'S MANUAL --------------------
CF:OFF
C*	THESE C* LINES WILL NOT BE PRINTED WHEN THIS PROGRAM OPERATES ON
C*	ITSELF, BECAUSE OF THE PRECEDING "CF" LINE.  SUBSEQUENT C* LINES
C*	WILL BE PRINTED, BECAUSE OF THE FOLLOWING "CN" LINE.
CN:ON
C*
C@    BAD "C@" LINE PRODUCES ERROR MESSAGE:
C*
CA		THIS LINE TURN ON "ALL-PRINT" SWITCH
C 
      IMPLICIT REAL(A), BYTE(B), INTEGER*2(C-Z)
C
C*		THIS LINE TURNS OFF "ALL-PRINT" SWITCH
C
      COMMON PAGES		! LOCAL PAGE COUNTER
     *	,    TPAGES		! GLOBAL PAGE COUNTER
     *	,    LINES		! LOCAL INPUT LINE COUNTER
     *	,    LPGS		! LOCAL PAGE COUNTER
     *	,    THEADS		! TOTAL HEADINGS COUNTER
     *	,    HEAD(37)		! HEADING TEXT STORAGE
     *  ,    RBUF		! READ BUFFER
     *	,    NAMELN		! FILENAME PRINT LINE 
      REAL*8 NAMELN(11)
      LOGICAL CSTAR		! "C*" RECOGNITION SWITCH
     *	,     INDIR		! INDIRECT FILENAME INPUT SWITCH
     *	,     ALLIST		! "LIST ALL INPUT" SWITCH
     *	,     EUM		! "WITHIN EMBEDDED USER MANUAL" SWITCH
      DIMENSION RBUF(40)	! READ BUFFER
     1, FNAME(20)		! FILE SPECIFICATION BUFFER
     2, BINDFN(2)		! ALLOWS TESTING OF FIRST BYTE OF FNAME
      EQUIVALENCE (FNAME,BINDFN), (NAMELN(9),FNAME)
      DATA NAMELN/4*' ', 'FILE NAM', 'E:', 5*' '/
     *	,  BLANK/' '/		! BLANK CHARACTER
     *	,  BPLUS/'+'/		! PLUS CHARACTER
C
C*    OPEN PRINT FILE
      OPEN (UNIT=6, NAME='DISPLOGIC.LST',TYPE='NEW',DISP='PRINT')
C*    OPEN WORK FILE FOR DEVELOPING INDEX
      OPEN (UNIT=4,NAME='DSPINDEX.TMP',TYPE='NEW',DISP='DELETE')
C*    INITIALIZE TOTALS FOR FILE, HEADER, PAGE AND LINE COUNTS
      TFILES = 0
      THEADS = 0
      SUBHED = 0
      TPAGES = 0
      TLINES = 0
C*    INITIALIZE FOR DIRECT INPUT OF FILE NAMES
      INDIR = .FALSE.
      ALLIST = .FALSE.
      EUM = .FALSE.
C
C
C*    WHILE AN INPUT FILE NAME IS AVAILABLE
 1    IF (INDIR)  GO TO 12	! CHECK WHETHER DIRECT OR INDIRECT INPUT
      BCC = '+'	! CONSOLE OUTPUT CARRIAGE CONTROL, DIRECT
 10   CALL TRMSG('DISPLOGIC - ENTER FILE SPEC >',29,FNAME,40)
      FNAME(20) = 0		! PROVIDE A NULL TO END NAME SCAN
      IF (FNAME(1).EQ.'  ')  GO TO 8
      IF (BINDFN(1).NE.'@')  GO TO 13
      OPEN(UNIT=3,NAME=BINDFN(2),TYPE='OLD',ERR=10)
      INDIR = .TRUE.
 12   READ(3,92,END=125)  FNAME
      FNAME(20) = 0
      BCC = ' '	! CONSOLE OUTPUT CARRIAGE CONTROL, INDIRECT
      GO TO 13
 125  INDIR = .FALSE.
      CLOSE(UNIT=3)
      GO TO 1
C*	OPEN THAT FILE FOR INPUT
 13	OPEN (UNIT=1,NAME=FNAME,TYPE='OLD',ERR=1)
C*	INITIALIZE INPUT/OUTPUT COUNTERS AND HEADING/PAGING
	IN = 0
	OUT = 0
	LINES = 57	! FORCES PAGE EJECT ON NEXT PRINTABLE LINE
	PAGES = 0
	TFILES = TFILES + 1
C*	BLANK OUT HEADING AREA
	DO 15 I=1,37
	  HEAD(I) = '  '
 15	  CONTINUE
C*	ENABLE "C*" RECOGNITION
	CSTAR = .TRUE.
C*      WHILE CARD IMAGE IS AVAILABLE (I.E. NOT EOF)
 2	READ (1,92,END=5) RBUF
 92	FORMAT(40A2)
C*	  READ A CARD IMAGE
C*	  INCREMENT INPUT COUNTER
	  IN = IN + 1		! COUNT INPUT LINES
C*        FIRST 2 CHARACTERS IN IMAGE DETERMINE CASE:
	  IF (RBUF(1).NE.'CH')  GO TO 24	! FIRST CASE SELECTOR
C*	    CASE 1:  'CH' CARD
C*	      STORE NEW HEADING
	      CALL HEDSTO
C*	      IF FIRST SPECIAL LINE
	      IF (OUT.GT.0)  GO TO 23
C*		OUTPUT MAJOR PAGE HEADING AND FILENAME VIA 'HEDWRT'
		CALL HEDWRT
		TPGS = TPAGES
		GO TO 239
C*	      ELSE
C*		INCREMENT SUBHEADING COUNTER
 23		SUBHED = SUBHED + 1
		LPGS = PAGES + 1	! LOCAL PAGE NUMBER FOR INDEX
		TPGS = TPAGES + 1
 239		CONTINUE	! END IF
C*	      STORE NEW HEADING LINE IN INDEX FILE
	      WRITE (4,9239) HEAD, LPGS, TPGS, FNAME
 9239	      FORMAT(37A2,2I5,2X,20A2)
	      GO TO 49	      ! END CASE
 24	  IF (RBUF(1).NE.'C*')  GO TO 3		! SECOND CASE SELECTOR
C*          CASE 2:  'C*' CARD
C*	      TURN OFF "ALL-PRINT" SWITCH
	      ALLIST = .FALSE.
C*	      IF RECOGNITION IS ENABLED, OR IN EUM
	      IF (.NOT. (CSTAR.OR.EUM))  GO TO 49
C*		PRINT CARD BY CALLING 'FPRINT'
 		CALL FPRINT(RBUF)
C*		INCREMENT OUTPUT COUNTER
		OUT = OUT + 1
		GO TO 49		! END CASE
 3	  IF (RBUF(1).NE.'C@')  GO TO 4		! THIRD CASE SELECTOR
C*	    CASE 3:  'C@' CARD
C*	      IF "C@SD" CARD
	      IF (RBUF(2).NE.'SD')  GO TO 36
C*		STORE NEW HEADING
		CALL HEDSTO
C*		OUTPUT MAJOR PAGE HEADING AND FILE NAME VIA 'HEDWRT'
		CALL HEDWRT
C*		STORE NEW HEADING LINE IN INDEX FILE
		WRITE (4,9239) HEAD, LPGS, TPAGES, FNAME
C*		PRINT SPECIAL MESSAGE
		WRITE (6,934)
 934		FORMAT(81X,'*** "C@SD" STARTS EMBEDDED USER MANUAL.')
C*		INCREMENT OUTPUT COUNTERS
		LINES = LINES + 1
		OUT = OUT + 1
C*		SET EUM FLAG ON
		EUM = .TRUE.
		GO TO 49	! END CASE
C*	      ELSE IF "C@ED" CARD
 36	      IF (RBUF(2).NE.'ED')  GO TO 37
C*		PRINT SPECIAL MESSAGE
		WRITE (6,936)
 936		FORMAT(81X,'*** "C@ED" ENDS EMBEDDED USER MANUAL.')
C*		INCREMENT OUTPUT COUNTERS
		LINES = LINES + 1
		OUT = OUT + 1
C*		SET EUM FLAG OFF
		EUM = .FALSE.
		GO TO 49	! INDIRECT END CASE
C*	      ELSE IF "C@PG" CARD
 37	      IF (RBUF(2).NE.'PG')  GO TO 38
C*		PRINT SPECIAL MARGIN MESSAGE
		WRITE (6,937)
 937		FORMAT('+',80X,'@PG@ CARD FORCES PAGE EJECT')
		OUT = OUT + 1
C*		FORCE PAGE-EJECT AT NEXT LINE-PRINT
		LINES = LINES + 56
		GO TO 49	! END CASE
C*	      ELSE CARD HAS BAD FORMAT
C*		PRINT ERROR MESSAGE WITH CARD
 38		CALL FPRINT(RBUF)
		OUT = OUT + 1
		WRITE (6,938)
 938		FORMAT('+',80X,'<== BAD "C@" CARD FORMAT *************')
		GO TO 49	! END CASE
 4	  IF(RBUF(1).NE.'CF')  GO TO 43		! FOURTH CASE SELECTOR
C*	    CASE 4:  'CF' CARD
C*	      DISABLE C* RECOGNITION
	      CSTAR = .FALSE.
C*	      PRINT 'DISABLE' MESSAGE
	      WRITE (6,941)
 941	      FORMAT(81X,'*** "CF" CARD DISABLED "C*" RECOGNITION.')
C*	      INCREMENT OUTPUT COUNTERS
	      LINES = LINES + 1
	      OUT = OUT + 1
	      GO TO 49		! END CASE
 43	  IF (RBUF(1).NE.'CN')  GO TO 45	! FIFTH CASE SELECTOR
C*	    CASE 5:  'CN' CARD
C*	      ENABLE C* RECOGNITION
	      CSTAR = .TRUE.
C*	      PRINT 'ENABLE' MESSAGE
	      WRITE (6,943)
 943	      FORMAT(81X,'*** "CN" CARD ENABLED "C*" RECOGNITION.')
C*	      INCREMENT OUTPUT COUNTERS
	      LINES = LINES + 1
	      OUT = OUT + 1
	      GO TO 49		! END CASE
 45	  IF (RBUF(1).NE.'CA')  GO TO 47
C*	    CASE 6:  'CA' CARD
C*	      TURN ON "ALL PRINT" SWITCH
	      ALLIST = .TRUE.
C*	      PRINT SPECIAL MESSAGE
	      WRITE (6,945)
 945	      FORMAT(81X,'*** "CA" CARD TURNED ON "ALL PRINT" SWITCH.')
	      GO TO 49		! END CASE
C@PG
C*	    CASE 7:  ANYTHING ELSE
C*	      IF "ALL PRINT" IS ENABLED, OR IN "EUM" STATE
 47	      IF (.NOT. (ALLIST.OR.EUM))  GO TO 49	! INDIRECT END CASE
C*		PRINT THE LINE
		CALL FPRINT(RBUF)
C*		INCREMENT OUTPUT COUNTER
		OUT = OUT + 1
C				! AND END CASE
 49	  GO TO 2		  ! END WHILE
 5	CONTINUE
C
C*	TELL USER HOW MANY LINES INPUT FROM THIS FILE
	WRITE (5,95)  BCC, IN, FNAME
 95	FORMAT(A1,I6,' LINES WERE INPUT FROM  ',20A2)
	APRCNT = 100.*FLOAT(OUT)/FLOAT(IN)
C*	IF ANY DOCUMENTATION WAS PRINTED FROM THIS FILE
	IF (OUT.GT.0)
     *    WRITE (6,951)  IN, OUT, APRCNT
C*	  PRINT THE INPUT AND OUTPUT LINE COUNTS
 951	  FORMAT('0',80X,I5,' LINES SOURCE TEXT INPUT'/81X,I5,' LINES'
     *	  ' DOCUMENTATION OUTPUT:',F6.1,' PERCENT')
C*	ADD THE INPUT COUNT TO TOTAL COUNT (FOR MULTIPLE FILES)
	TLINES = TLINES + IN
C*	CLOSE INPUT FILE
	CLOSE (UNIT=1)
  	GO TO 1 		! END WHILE
C
 8    CONTINUE
C
C*    TELL USER HOW MANY PAGES OF OUTPUT TO EXPECT, ETC.
      WRITE (5,980) BPLUS, TLINES, TFILES, TPAGES, THEADS, SUBHED
 980  FORMAT(A1,'------',61X/1X,I6,' LINES WERE INPUT FROM',I5,' FILES T
     *OGETHER, AND'/1X,I6,' PAGES ARE PRINTED UNDER ',I3,' MAJOR HEADING
     $S AND',I4,' SUBHEADINGS.'//)
C*    IF TOTALS SUGGEST INADEQUATE DOCUMENTATION IN THE INPUT FILES
      IF (TFILES.EQ.THEADS)  GO TO 82
C*	WARN USER
	SHORT = TFILES - THEADS
	WRITE (5,981) SHORT
 981	FORMAT(' Please note that',I3,' of these files do not have headi
     *ng flags.'/' Perhaps you should make an effort to improve your doc
     $umentation.'//)		! THIS FORMAT IS MOSTLY LOWERCASE.
C*    CLOSE AND REWIND INDEX FILE
 82   END FILE 4
      REWIND 4
C*    IF MORE THAN ONE FILE WAS INPUT
      IF (TFILES.LE.1)  GO TO 89
C*	WRITE INDEX HEADING
	WRITE (6,982)
 982	FORMAT('1****** INDEX TO DOCUMENTATION IN PRECEDING PAGES ******
     *',30X,'LOCAL PAGE   -   GLOBAL PAGE   -   FILENAME'///)
C*	WHILE AN INDEX LINE IS AVAILABLE (I.E. NO EOF)
 83	READ(4,9239,END=84)  HEAD, LPGS, TPGS, FNAME
C*	  READ AN INDEX LINE
	  BCTL = '0'
	  IF (LPGS.NE.1)  BCTL = ' '
C*	  WRITE THAT INDEX LINE
	  WRITE (6,983)  BCTL, HEAD, LPGS, TPGS, (FNAME(I),I=1,10)
 983	  FORMAT(A1,37A2,2I17,3X,10A2)
	  GO TO 83		! END WHILE
C*	WRITE SUMMARY OF PROCESSING
 84	WRITE (6,980)  BLANK, TLINES, TFILES, TPAGES, THEADS, SUBHED
C*    DISPATCH PRINT
 89   CLOSE (UNIT=6)
C*    STOP.
      STOP
CH    UTILITY SUBROUTINES FOR 'DSPLOG' PROGRAM
      END
      SUBROUTINE HEDSTO
C*
C*    HEDSTO   -   SUBROUTINE IN 'DSPLOG'
C*
C*	THIS SUBROUTINE STORES THE TEXT FROM EACH HEADING CARD FOUND
C*	BY THE MAIN PROGRAM.
C*
C*	-	-	-	-	-	-	-	-	-
C*
      IMPLICIT REAL(A),BYTE(B),INTEGER*2(C-Z)
      COMMON PAGES,TPAGES,LINES,LPGS,THEADS,HEAD(37),RBUF(40),NAMELN(11)
      REAL*8 NAMELN
C	SEE MAIN PROGRAM FOR DEFINITION OF ABOVE
      DIMENSION BDATE(9)
C
C*    STORE NEW HEADING
      DO 22 I=1,37
	HEAD(I) = RBUF(I+3)
 22	CONTINUE
C*    RESET LINE COUNT TO FORCE PAGE EJECT AT NEXT PRINT LINE
      LINES = 57
C*    RETURN TO CALLER.
      RETURN
C*
C* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C*
C*    HEDWRT   -   ENTRY IN SUBROUTINE 'HEDSTO' IN PROGRAM 'DSPLOG'
C*
C*	THIS ENTRY WRITES FILE IDENTIFICATION IN SUCH A WAY AS TO FORCE A
C*	NEW PAGE HEADING TO START PRINTING.  IT IS USED WHENEVER A NEW
C*	MAJOR HEADING IS ENCOUNTERED, WHICH IS NORMALLY AT OR NEAR THE
C*	START OF EACH SOURCE FILE PROCESSED.
C*
C*	-	-	-	-	-	-	-	-
C*
      ENTRY HEDWRT
C
C*    RESET PAGE COUNTER
      PAGES = 0
      LPGS = 1	! LOCAL PAGE NUMBER FOR INDEX
C*    INCREMENT MAJOR HEADING COUNTER
      THEADS = THEADS + 1
C*    PRINT OUTPUT FILE IDENTIFICATION VIA FPRINT TO FORCE NEW HEADING
      CALL FPRINT(NAMELN)
C*    AND FOLLOW WITH DATE AND TWO BLANK LINES
      CALL DATE(BDATE)
      WRITE (6,95)  BDATE
 95   FORMAT('+',100X,9A1//)
      LINES = LINES + 2	! INCREMENT COUNT FOR BLANK LINES
C*    RETURN TO CALLER.
      RETURN
C*
C*
C*----------------------------------------------------------------------
      END
      SUBROUTINE FPRINT(BUFF)
C*
C*    FPRINT   -   SUBROUTINE IN 'DSPLOG'
C*
C*	SUBROUTINE 'FPRINT' PRINTS SELECTED LINES FOR 'DSPLOG'.
C*	IT ALSO PUTS OUT PAGE HEADINGS AT APPROPRIATE INTERVALS, WITH
C*	BOTH LOCAL AND GLOBAL NUMBERING.
C*
C*	-	-	-	-	-	-	-	-
C*
      IMPLICIT INTEGER*2(A-Z)
      COMMON PAGES, TPAGES, LINES, LPGS, THEADS, HEAD(37)
      DIMENSION BUFF(40)
C
C*    INCREMENT OUTPUT LINE COUNT FOR PAGE
      LINES = LINES + 1
C*    IF THE CURRENT PRINTED PAGE IS FULL
      IF (LINES.LT.56)  GO TO 2
C*	INCREMENT PAGE COUNTS
	TPAGES = TPAGES + 1
	PAGES = PAGES + 1
C*	WRITE PAGE HEADING
	WRITE (6,98) HEAD, PAGES, TPAGES
C*	RESET LINE COUNT FOR NEW PAGE
	LINES = 0
C*    WRITE THE SELECTED LINE
 2    WRITE(6,99)  BUFF
C*    RETURN TO CALLER.
      RETURN
C
 98   FORMAT('1',37A2,22X,' PAGE',I4,10X,'TOTAL PAGES',I5//)
 99   FORMAT(' ',40A2)
C
      END
.DISABLE DATA
	.CLOSE
	F4P DSPLOG,DSPLOG/-SP=DSPLOG
	.ASK BLD DO YOU WANT TO TASK BUILD
	.IFF BLD .GOTO FIN
	.OPEN DSPLOG.BLD
.ENABLE DATA
DSPLOG/CP/FP,DSPLOG/-SP=DSPLOG
/
LIBR=F4PRES:RO
ASG=SY0:6
ACTFIL=5
//
.DISABLE DATA
	.CLOSE
	TKB @DSPLOG.BLD
	.ASK SPL SPOOL LISTING FILES
	.IFT SPL PIP DSPLOG.LST/SP,DSPLOG.BLD,DSPLOG.MAP
.FIN:	; DSPLOG.PGM - FINISHED.