; PRNDOC.PGM - CMD FILE TO CMP/TKB PROGRAM PRNDOC
	.OPEN PRNDOC.FTN
.ENABLE DATA
C@SD@ PRNDOC * * * * * * * * * * * * * * * * * * * * * * * *
C
C PROGRAM ID:  PRNDOC
C PROGRAMMER:  TSGT MARVIN L FREIMUND /ADLS
C CREATED ON:  21JUL78 FOR PROJ 050540
C AS OF DATE:  12 AUG 81
C
C
C DESCRIPTION:  PRNDOC IS A FORTRAN (F4P) LANGUAGE UTILITY PROGRAM
C      USED ON THE PDP-11 TO PRINT THE DOCUMENTATION SECTIONS FROM
C      SOURCE MODULES.  IT WORKS BY SEARCHING INPUT LINES FOR SPECIAL
C      FLAGS STARTING WITHIN THE FIRST 12 COLUMNS.  USER OPTIONS ALLOW
C      FOR SUPPRESSION OF EXTRA BLANK LINES AND FOR BLANKING OUT COMMENT
C      MARKERS FROM FORTRAN OR ASSEMBLER SOURCE CODE.
C
C INSTRUCTIONS:  TYPE "RUN $PRNDOC<CR>" AND RESPOND AS PROMPTED.
C
C INPUT/OUTPUT:
C
C      LUN 1 - INPUT FILE (NAME REQUESTED AT RUN TIME)
C              IF THE NAME IS PREFIXED WITH AN ATSIGN ("@") THIS FILE
C              WILL BE OPENED ON LUN 3 AND WILL CONTAIN A LIST OF
C              FILENAMES TO BE OPENED ON LUN 1.
C      LUN 2 - OUTPUT FILE (NAME REQUESTED AT RUN TIME)
C      LUN 3 - INDIRECT INPUT FILE CONTAINING LIST OF FILENAMES (NAME
C	       SUPPLIED BY USER; SEE ABOVE.)
C      LUN 5 - TI:  USED TO ENTER FILE SPECIFICATIONS AND OUT-
C            PUT ERROR MESSAGES.
C
C ETAC SUBPROGRAMS USED:
C
C      BEGIN    - USED TO TYPE STARTING MESSAGE AND DTG
C      QUIT     - USED TO TYPE FINISHED MESSAGE AND DTG
C      TRMSG    - USED TO SOLICIT FILE NAME INFO AND USER OPTIONS
C      CHAR7    - USED TO BUILD THE LARGE (7 X 7) CHARS 
C      MESSG    - USED TO LIST FILE CURRENTLY BEING DONE
C      TABIT    - USED TO CHANGE TABS TO CORRECT NUMBER OF SPACES
C
C REMARKS:
C
C  A STARTER CARD CONTAINS THE FLAG: "@SD@ XXXXXXXX".
C  THE XXXXXXXX REPRESENTS UP TO 8 CHARACTERS TO BE REPRODUCED IN 7X7
C  BLOCK LETTERS AT THE TOP OF THE FIRST OUTPUT PAGE.  THIS CARD
C  INITIATES PRINTING OF ALL INPUT LINES UNTIL AN "@ED@" FLAG OR
C  END-OF-FILE IS REACHED.  IT ALSO INITIALIZES PAGE NUMBERING.
C
C  AN ENDING CARD CONTAINS THE FLAG: "@ED@".  THIS CAUSES THE
C  PRINTING OF INPUT LINES TO BE TURNED OFF.
C
C  IF A LINE CONTAINS THE PAGE SKIP FLAG, "@PG@", THE NEXT LINE OF THE
C  FILE WILL BE PRINTED AT THE TOP OF A NEW PAGE.
C
C   NOTE:  A TOTAL OF 58 LINES WILL BE PRINTED ON EACH PAGE.  THIS IN-
C   CLUDES AN ASTERISK BORDER AND A BLANK LINE AT THE TOP (2) AND AN
C   ASTERISK BORDER, 2 BLANK LINES, AND A PAGE NUMBER LINE AT THE
C   BOTTOM (4).  HENCE, A MAX OF 52 DATA LINES WILL BE PRINTED PER
C   PAGE.  (ON THE TITLE PAGE, 8 OF THOSE DATA LINES ARE USED TO
C   PRINT THE BLOCK LETTERS. THIS LEAVES ONLY 44 DATA LINES ON THAT
C   PAGE.)  IF A PAGE WOULD BE LESS THAN 58 LINES (A SHORT SINGLE PAGE
C   FILE OR A SHORT PAGE BECAUSE OF A "PG" FLAG), ENOUGH BLANK LINES
C   WILL BE WRITTEN TO MAKE IT 58 LINES.
C
C  STORAGE USED:  6048 WORDS (12096 BYTES).
C
C  TIMING:  20 SECONDS FOR A SINGLE INPUT FILE OF 300 LINES WITH
C	COMMENT-BLANKING OPTION.  INDIRECT INPUT RUNS FASTER FOR
C	MULTIPLE FILES BY ELIMINATING THE NEED FOR ADDITIONAL CONSOLE
C	INTERACTION.  PROGRAM RUNS MUCH FASTER ON PLAIN TEXT WHERE
C	PROGRAM-COMMENT-MARKER BLANKING OPTION IS NOT NEEDED.
C
C  UPDATED:
C  24JUL79 BY TSGT FREIMUND TO INPUT A FILESPEC FOR LIST OF FILENAMES
C  30AUG79 BY TSGT FREIMUND TO ADD "PG", CHANGE TO 7X7 LETTERS, AND
C          FORCE ALL PAGES TO 56 LINES.
C  31APR81 BY TSGT FREIMUND TO CHANGE INPUT FILESPEC PROCESSING
C  22JUL81 BY MAJ CARL S ZIMMERMAN TO LENGTHEN PAGE TO 58 LINES,
C	EXPAND DOCUMENTATION, TIGHTEN FLAG SEARCH CRITERIA, CORRECT
C	HANDLING OF EOF WHEN @ED@ IS NOT FOUND.
C  11AUG81 BY MAJ CARL S ZIMMERMAN TO IMPROVE ERROR HANDLING ON INDIRECT
C	INPUT FILE OPENING, MAKE SUPPRESSION OF EXTRA BLANK LINES
C	OPTIONAL, MAKE BLANKING OF SOURCE CODE COMMENT MARKERS OPTIONAL.
C  11SEP81 BY MAJ CARL S ZIMMERMAN TO ADD SHORT-STOP OPTION, WHICH CAN
C	SPEED PROCESSING WHEN USER KNOWS THAT @ED@ IS ALWAYS THE END OF
C	ALL DOCUMENTATION IN EVERY FILE PROCESSED.
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  LIST OF VARIABLES AND ARRAYS USED IN THE PROGRAM.
C
C  BIGL(70,7) - PROGRAM NAME IN 7X7 BLOCK LETTERS
C  BNPT(72)  - CARD COLUMNS 1-72 IN A1 FORMAT
C  BFNM(36) - CURRENT FILE SPECIFIER
C  BPNM(8) - NAME FROM THE "SD" CARD ON CURRENT FILE
C  NPAG   - SET TO 1 ON "SD", 0 ON "ED"; INCREMENTED FOR EACH NEW PAGE.
C  NBLK  - SET 0 IF LAST LINE NOT BLANK, 1 IF IT WAS BLANK.
C  NLNS - NUMBER OF LINES PRINTED ON CURRENT PAGE
C  NMSZ - NUMBER OF CHARACTERS IN CURRENT PROGRAM NAME
C
      LOGICAL INDIR, EXTRAB, BLCOMT, SHORTS
      REAL STMSG(12)
      BYTE BSDC(4),BEDC(4),BPGC(4),BCOM(4)
      BYTE BIGL(70,7),BNPT(72),BFNM(36),BPNM(8)
      BYTE BLNK,BNUL,BEOF,BAST,BASG
      EQUIVALENCE (STMSG(4),BFNM(1))
      DATA STMSG/'STAR','TING',' ON ',9*0/
      DATA BLNK/' '/,BNUL/0/,BEOF/-10/,BAST/'*'/,BASG/'@'/
      DATA BSDC/'@','S','D','@'/, BEDC/'@','E','D','@'/
      DATA BPGC/'@','P','G','@'/, BCOM/'C',';','D','*'/
      DATA NPAG/0/, NBLK/0/, NLNS/0/
      DATA LINLIM/54/		! = 58 - 4 LINES 
C
C  PERFORM INITIAL HOUSEKEEPING
C
      CALL BEGIN
      DO 5 I=1,3
5     CALL ASNLUN(I,'SY',0)	! ASSIGN I/O TO USER'S DEFAULT DISK
C
C  GET AND OPEN OUTPUT FILE
C
10    CALL TRMSG('PRNDOC - ENTER OUTPUT FILESPEC>',31,BFNM,36)
      BFNM(36) = BNUL
      OPEN(UNIT=2,NAME=BFNM,TYPE='NEW',ERR=10)
C
C  ASK USER ABOUT BLANK-SUPPRESSION OPTION
C
      EXTRAB = .TRUE.
      CALL TRMSG(' SUPPRESS EXTRA BLANK LINES FROM PRINTING? [Y/N]>',49,
     * BFNM,1)
      IF (BFNM(1).EQ.'Y' .OR. BFNM(1).EQ.'y')  EXTRAB = .FALSE.	! UC/LC CK
C
C  ASK USER ABOUT COMMENT-BLANKING OPTION
C
      NOCOMT = .FALSE.
      CALL TRMSG(' BLANK OUT SOURCE CODE COMMENT MARKERS? [Y/N]>',45,
     *  BFNM,1)
      IF (BFNM(1).EQ.'Y' .OR. BFNM(1).EQ.'y')  BLCOMT = .TRUE.	! UC/LC CK
C
C
C  ASK USER ABOUT SHORT-STOP OPTION
C
      SHORTS = .FALSE.
      CALL TRMSG(' STOP READING INPUT FILE ON @ED@? [Y/N]>',40,BFNM,1)
      IF (BFNM(1).EQ.'Y' .OR. BFNM(1).EQ.'y')  SHORTS = .TRUE.	! UC/LC CK
C  GET AND OPEN INPUT FILESPEC(S), AND CHECK FOR END OF RUN
C
20    INDIR = .FALSE.
25    IF (INDIR) GOTO 30
28    CALL TRMSG('PRNDOC - ENTER INPUT FILESPEC> ',31,BFNM,36)
      BFNM(36) = BNUL
      IF (BFNM(1).EQ.BEOF .OR. BFNM(1).EQ.BLNK) GOTO 60
      IF (BFNM(1).NE.BASG) GOTO 40
C     OPEN INDIRECT NAME FILE
      OPEN(UNIT=3,NAME=BFNM(2),TYPE='OLD',READONLY,ERR=28)
      INDIR = .TRUE.
30    READ (3,3000,END=50) BFNM
      BFNM(36) = BNUL
C     OPEN DATA INPUT FILE
40    OPEN(UNIT=1,NAME=BFNM,TYPE='OLD',READONLY,ERR=70)
      IF (INDIR) CALL MESSG(STMSG)
      GOTO 100
C
50    CLOSE (UNIT=3)	! END OF INDIRECT INPUT FILE
      GOTO 20
60    CLOSE (UNIT=2)
      CALL QUIT
70    IF (.NOT. INDIR)  GO TO 20
      CALL TRMSG('ERROR--THE FOLLOWING INDIRECT FILE COULD NOT BE OPENED
     * FOR INPUT:',65)
      CALL TRMSG(BFNM,35)
      GO TO 30
C
C  THIS SECTION READS IN THE NEXT CARD AND LOOKS FOR THE FLAGS
C
100   READ(1,1002,END=110) BNPT
      GOTO 120
110   CLOSE(UNIT=1)
      IF (NPAG.EQ.0)  GO TO 25
      NBLK = 5		! EMULATE AN "ED" FLAG AT EOF
      WRITE (5,3112)  BFNM
      GO TO 210
C
C  LOOK FOR AN "SD" FLAG STARTING IN COLUMNS 1-12
120   DO 124 J=1,12
      DO 122 I=1,4
      K = I-1
      IF (BNPT(K+J).NE.BSDC(I)) GOTO 124
122   CONTINUE
      GOTO 200		! FLAG FOUND
124   CONTINUE
      IF (NPAG.EQ.0) GOTO 100
C
C  LOOK FOR AN "ED" FLAG STARTING IN COLUMNS 1-12
130   DO 134 J=1,12
      DO 132 I=1,4
      K = I-1
      IF (BNPT(K+J).NE.BEDC(I)) GOTO 134
132   CONTINUE
      GOTO 300		! FLAG FOUND
134   CONTINUE
C
C  LOOK FOR A "PG" FLAG STARTING IN COLUMNS 1-12
140   DO 144 J=1,12
      DO 142 I=1,4
      K = I-1
      IF (BNPT(K+J).NE.BPGC(I)) GOTO 144
142   CONTINUE
      GOTO 400		! FLAG FOUND
144   CONTINUE
      GOTO 500		! NO FLAG FOUND
C
C  THIS SECTION STARTS A NEW LISTING ON AN "SD" FLAG
C
200   IF (NPAG.EQ.0) GOTO 230
C  GOT TO FINISH UP THE OLD PAGE FIRST
210   IF (NLNS.GE.LINLIM) GOTO 220
      WRITE(2,2012)
      NLNS = NLNS+1
      GOTO 210
220   WRITE(2,2012)
      IF (NPAG.GT.9) WRITE(2,2014) NPAG
      IF (NPAG.GE.2 .AND. NPAG.LE.9) WRITE(2,2013) NPAG
      IF (NPAG.LT.2) WRITE(2,2012)
      WRITE(2,2012)
      WRITE(2,2011)
      IF (NBLK.EQ.3) GOTO 310
      IF (NBLK.EQ.5)  GO TO 25		! FINISHED FILE WITHOUT @ED@
C     NOW START THE NEW PAGE
230   WRITE(2,2010)
      WRITE(2,2012)
      NLNS = 2
      IF (NBLK.EQ.4) GOTO 410
      IF (NBLK.EQ.6) GOTO 610
      NPAG = 1
      NBLK = 1
C
C  FIND THE PROGRAM NAME (J POINTS TO THE START OF THE SD FLAG IN THE INPUT LINE)
      DO 240 I=1,8
240   BPNM(I) = BLNK
      NMSZ = 0
      DO 250 I=5,17	! NAME CAN LIE WITHIN 2 TO 13 CHARS AFTER END OF SD FLAG
      IF (BNPT(I+J).EQ.BLNK) GOTO 250		! BYPASS BLANKS AFTER THE SD FLAG
      IF (BNPT(I+J).EQ.BAST) GOTO 250		! BYPASS STARS AFTER THE SD FLAG
      NMSZ = NMSZ+1
      BPNM(NMSZ) = BNPT(I+J)
      IF (NMSZ.EQ.8)  GO TO 255
250   CONTINUE
      IF (NMSZ.LT.1) GOTO 100
C
C  PRINT THE BIG LETTERS
255   DO 260 I=1,70
      DO 260 J=1,7
260   BIGL(I,J) = BLNK
      CALL CHAR7(BPNM,NMSZ,BIGL,70,2)
      IF (NMSZ.EQ.1) WRITE(2,2001) BIGL
      IF (NMSZ.EQ.2) WRITE(2,2002) BIGL
      IF (NMSZ.EQ.3) WRITE(2,2003) BIGL
      IF (NMSZ.EQ.4) WRITE(2,2004) BIGL
      IF (NMSZ.EQ.5) WRITE(2,2005) BIGL
      IF (NMSZ.EQ.6) WRITE(2,2006) BIGL
      IF (NMSZ.EQ.7) WRITE(2,2007) BIGL
      IF (NMSZ.EQ.8) WRITE(2,2008) BIGL
      WRITE(2,2012)
      NLNS = NLNS+8
      GOTO 100
C
C  THIS SECTION STOPS THE LISTING WHEN AN "ED" FLAG IS READ
C
300   NBLK = 3
      GOTO 210		! WILL RETURN TO 310 FROM AFTER 220
310   NBLK = 1
      NPAG = 0
      IF (.NOT.SHORTS)  GOTO 100
      CLOSE(UNIT=1)
      GO TO 25
C
C  THIS SECTION STARTS A NEW PAGE WHEN A "PG" FLAG IS READ
C
400   NBLK = 4
      GOTO 210		! WILL RETURN TO 410 FROM AFTER 230
410   NBLK = 1
      NPAG = NPAG+1
      GOTO 100
C
C  THIS SECTION CLEANS UP THE COMMENT CARDS
C
500   CALL TABIT(BNPT,72)
      IF (.NOT. BLCOMT)  GO TO 600	! SKIP BLANKING OUT COMMENT MARKERS
      DO 510 I=1,4
      IF (BNPT(1).EQ.BCOM(I)) GOTO 520
510   CONTINUE
      GO TO 600		! NOT A COMMENT CARD
520   IF (BNPT(3).EQ.BNPT(2)) BNPT(3) = BLNK
      BNPT(1) = BLNK
      BNPT(2) = BLNK
530   DO 540 I=72,68,-1		! STRIP TRAILING ASTERISKS FROM COMMENTS
      IF (BNPT(I).NE.BLNK .AND. BNPT(I).NE.BAST) GOTO 600
      BNPT(I) = BLNK
540   CONTINUE
C
C  THIS SECTION PRINTS THE DATA LINE
C
600   IF (NLNS.LT.LINLIM) GOTO 620
      NBLK = 6
      GOTO 210		! WILL RETURN TO 610 FROM AFTER 230
610   NBLK = 1
      NPAG = NPAG+1
620   IF (NBLK.EQ.0) GO TO 640	! ALWAYS TRUE IF EXTRAB=.TRUE.
      DO 630 I=1,72
      IF (BNPT(I).NE.BLNK) GOTO 640
630   CONTINUE
      GOTO 100
640   WRITE(2,2009) BNPT
      NLNS = NLNS+1
      NBLK = 0
      IF (EXTRAB)  GO TO 100		! DON'T SUPPRESS EXTRA BLANK LINES
      DO 650 I=1,72
      IF (BNPT(I).NE.BLNK) GOTO 100
650   CONTINUE
      NBLK = 1
      GOTO 100
C
C  THIS SECTION CONTAINS THE FORMAT STATEMENTS.
C
1002  FORMAT (72A1)
2001  FORMAT (' ',T11,'*',T45,70A1,T86,'*')	! FOR 1-LETTER BIG NAMES
2002  FORMAT (' ',T11,'*',T41,70A1,T86,'*')	! FOR 2-LETTER BIG NAMES
2003  FORMAT (' ',T11,'*',T36,70A1,T86,'*')	! FOR 3-LETTER BIG NAMES
2004  FORMAT (' ',T11,'*',T32,70A1,T86,'*')	! FOR 4-LETTER BIG NAMES
2005  FORMAT (' ',T11,'*',T27,70A1,T86,'*')	! FOR 5-LETTER BIG NAMES
2006  FORMAT (' ',T11,'*',T23,70A1,T86,'*')	! FOR 6-LETTER BIG NAMES
2007  FORMAT (' ',T11,'*',T18,70A1,T86,'*')	! FOR 7-LETTER BIG NAMES
2008  FORMAT (' ',T11,'*',T14,70A1,T86,'*')	! FOR 8-LETTER BIG NAMES
2009  FORMAT (' ',T11,'*',T13,72A1,T86,'*')	! FOR 9-LETTER BIG NAMES
2010  FORMAT ('1',T11,76('*'))
2011  FORMAT (' ',T11,76('*'))
2012  FORMAT (' ',T11,'*',T86,'*')
2013  FORMAT (' ',T11,'*',T47,'<',I1,'>',T86,'*')
2014  FORMAT (' ',T11,'*',T46,'<',I2,'>',T86,'*')
3000  FORMAT (36A1)
3112  FORMAT (' NO @ED@ FLAG FOUND IN FILE ',36A1)
      END
.DISABLE DATA
	.CLOSE
	F4P PRNDOC,PRNDOC/-SP=PRNDOC
	.ASK BLD DO YOU WANT TO TASK BUILD
	.IFF BLD .GOTO FIN
	.OPEN PRNDOC.BLD
.ENABLE DATA
PRNDOC/CP/FP,PRNDOC/-SP=PRNDOC
/
LIBR=F4PRES:RO
//
.DISABLE DATA
	.CLOSE
	TKB @PRNDOC.BLD
	.ASK SPL SPOOL LISTING FILES
	.IFT SPL PIP PRNDOC.LST/SP,PRNDOC.BLD,PRNDOC.MAP
.FIN:	; PRNDOC.PGM - FINISHED.