C*	FDUMP - FILE DUMP
C
C	FDUMP FORMATS THE DUMP OUTPUT SO THAT EACH BLOCK OF THE FILE
C	IS LISTED AS OCTAL,ASCII, AND RAD50 ALL ON THE SAME LINE OF PRINT
C	NOT UNLIKE IBM DUMPS.
C
C	FDUMP SUPPORTS 2 SWITCHES
C		/A
C	THIS SPECIFIES THE OFFSETS FOR EACH LINE TO BE LISTED RELATIVE TO
C	THE BEGINNING OF THE FILE. THAT IS, BLOCK 1 STARTS AT '000000, BLOCK
C	2 STARTS AT 1000, BLOCK 3 AT 2000 ....ETC. THIS IS USEFUL FOR
C	LOOKING AT FILES WHICH CONTAIN LINKED LISTS, LIKE [1,4]SPRQUEUE.SYS.
C
C		/BL:N:M:
C	LIST FROM BLOCK N TO M ONLY
C	IF M ABSENT, LIST FROM BLOCK N TO END OF FILE
C	NOTE THAT MUST HAVE TERMINATING ':' AFTER BLOCK #
C
C	MOD BY F.BORGER TO DO GET MCR LINE, AND OUTPUT DATE AND TIME, ALSO
C	DO ONE BLOCK PER PAGE, AND SELECT BLOCKS
C
C	NORMALLY EACH BLOCK IS LISTED REALATIVE TO 0.
C
	PROGRAM FDUMP
C
	INTEGER*4 IOUT
	DIMENSION IBUF(8,32), IOUT(8), INAME(25),JNAME(40),ITIME(4)
	DIMENSION IDATE(5)
	BYTE BBUF(16,32), BOCT(6,8), BOUT(4,8), BNAME(50)
	EQUIVALENCE (INAME,BNAME),(INAME,JNAME(3))
	EQUIVALENCE (BBUF,IBUF), (BOUT,IOUT)
	DATA IADD/0/, IEOF/-10/, ICR/13/ ,IDASH/'--'/
C
	CALL TIME(ITIME)
	CALL DATE(IDATE)
C	TRY FOR MCR
	ISW=0
	CALL GETMCR(JNAME,ISW)
	IF (ISW.GT.4) GOTO 101
	WRITE (5, 110)
 110	FORMAT (' FDU>'$)
	READ (5, 100) (INAME(I),I=1,25)
 100	FORMAT (50A2)
 101	ICOL = JCCHR (INAME,1,50, '/A',1,2, 3)
	IF (ICOL .GT. 0) IADD = 32767
	JCOL = JCCHR (INAME,1,50,ICR,1,1,3)
C	TRY TO CONVERT 1 OR 2 BLOCK NUMBERS
	IBLL=32767
	IBLF=0
	KCOL=JCCHR(INAME,1,50,'/BL:',1,4,3)
	IF(KCOL .LE. 0) GOTO 104
C	AT LEAST ONE BLOCK # IS PRESENT
	CALL CVRTBL(INAME,KCOL+4,IBLF,IBLL)
	IF (IBLL .EQ. 0) IBLL = 32767
	IF (IBLF .GT. IBLL) GOTO 105
 104	IEND=50
	IF (ICOL .GT. 0) IEND=ICOL
	IF (JCOL .GT. 0 .AND. JCOL .LT. IEND) IEND =JCOL
	IF (KCOL .GT. 0 .AND. KCOL .LT. IEND) IEND =KCOL
	BNAME(IEND)=0
	OPEN (UNIT=1, NAME=INAME, TYPE='OLD', READONLY, SHARED,
	1	BUFFERCOUNT=-1, ERR=105)
	IF (ICOL .GT. 0) BNAME(ICOL)='/'
	IF (KCOL .GT. 0) BNAME(KCOL)='/'
	GO TO 106
 105	CONTINUE
	STOP 'NOT OK'
 106	IS = 1
	CALL X1EFBY (1, IMAX, IHI, IBYTE)
	IF (IBYTE .EQ. 0) IMAX = IMAX - 1
C
 30	CONTINUE
	IF (IS .GT. IMAX) GO TO 40
 	CALL RVB (1, IBUF, 1, IS, NERR)
	IF (NERR .EQ. IEOF) GO TO 40
	IS1 = MIN0(IS-2, IADD)
	IBN = IS - 1
	IF (IBN .GT. IBLL) GOTO 30
	IF (IBN .LT. IBLF) GOTO 30
	WRITE (6,499)(BNAME(I),I=1,50)
 499	FORMAT (///,' DUMP OF ',50A1)
	WRITE (6,4991) IDATE,ITIME,IBN
 4991	FORMAT(/,' ',5A2,' AT ',4A2,'   BLOCK',I5,//,4X,'ADDR',
     $	4X,'OCTAL',54X,'RAD50',31X,'ASCII'/)
	DO 300 J=1,32
	DO 200 I=1,8
	CALL R50ASC (3, IBUF(I,J), IOUT(I))
	DO 180 II=1,3
	IF (BOUT(II,I) .LE. "40) BOUT(II,I) = '.'
 180	CONTINUE
	ENCODE (6, 500, BOCT(1,I)) IBUF(I,J)
 500	FORMAT (O6)
	DO 20 K=1,6
	IF (BOCT(K,I) .EQ. ' ') BOCT(K,I)='0'
 20	CONTINUE
	
	DO 22 K=0,1
	IF (BBUF(I*2-1+K,J).LT. "40) BBUF(I*2-1+K,J) = '.'
 22	CONTINUE
 200	CONTINUE
	IADR = ((J*32-32)/2)+ IS1*"1000
	WRITE (6, 505) IADR, BOCT, ((BOUT(K,L),K=1,3),L=1,8),
     $  (BBUF(K,J),K=1,16)
 505	FORMAT (' ',O6,3X,8(1X,6A1),4X,8(3A1,1X),4X,8(2A1,1X))
	IF (J .EQ. 4*(J/4)) WRITE (6,510) (IDASH,I=1,65)
 510	FORMAT (' ',65A2)
 300	CONTINUE
	WRITE (6,310)
 310	FORMAT('1 ')
	GO TO 30
 40	CLOSE (UNIT=1)
	CALL EXIT
	END
