Google
 

Trailing-Edge - PDP-10 Archives - tops10_integ_tools_v4_10jan-86 - 70,6067/dumpr2/overhe.for
There is 1 other file named overhe.for in the archive. Click here to see a list.
	SUBROUTINE OVERHEAD(BUFFER,BLEN,FSPEC,FSLEN)
C
C	This segment examines the overhead section of the
C	file data.  The data is printed on the user's terminal.
C
C
C	Parameter list description:
C
C	BUFFER -- Raw data of the input buffer
C	BLEN   -- Length of the overhead region in words
C	FSPEC  -- File specification to return to caller
C	FSLEN  -- Length of the file specification returned
C
	INTEGER*4 BUFLEN
	PARAMETER (BUFLEN=2720)
	BYTE BUFFER(BUFLEN)
	INTEGER*4 BLEN
	CHARACTER*256 FSPEC
	INTEGER*4 FSLEN
C
	INCLUDE 'DMPCOM.FOR/NOLIST'
	INCLUDE 'DMPHEAD.FOR/NOLIST'
	INCLUDE 'DMPREC.FOR/NOLIST'
C
C	Local data description:
C
	INTEGER*4 DAT(2,512)
C
	INTEGER RH,LH
	INTEGER RHS,LHS
	CHARACTER*5 CHARS
	CHARACTER*20 DATIME
	BYTE LINE(256)
	INTEGER LINEL
	CHARACTER*256 CLINE
	EQUIVALENCE (LINE,CLINE)
	BYTE NUM(8)
	CHARACTER CNUM*8
	EQUIVALENCE (NUM,CNUM)
C
	FSLEN = 0
	IF (BLKTYP.EQ.STDBLK) THEN
	 CALL CVT36(BUFFER(161),DAT,BLEN)
	ELSE
	 CALL CVT72(BUFFER(145),DAT,BLEN)
	ENDIF
	K = BLEN
	I = 1
	LINEL = 1
	DO WHILE (K.GT.I)
	 CALL CVTHALF(DAT(1,I),RH,LH)
	 GOTO (905,100,200,300,400,500) LH+1
	 WRITE(6,10) I,RH,LH
10	FORMAT(' ERROR WITH OVERHEAD RECORD, WORD=',I3,' VALUE = ',
	1 2O8.6)
	 GOTO 1000
C
C	NAME RECORD
C
100	CONTINUE
	J = 1+I
	CALL CVTHALF(DAT(1,J),RHS,LHS)
	IF (LHS.EQ.N$DEV) THEN
	 CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	 J = J+RHS
	 CALL CVTHALF(DAT(1,J),RHS,LHS)
	 LINE(LINEL) = ':'
	 LINEL = LINEL+1
	ENDIF
	IF (LHS.EQ.N$UFD) THEN
	 LINE(LINEL) = '['
	 LINEL = LINEL+1
	 CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	 J = J+RHS
	 CALL CVTHALF(DAT(1,J),RHS,LHS)
	 DO WHILE (LHS.GT.N$UFD)
	  LINE(LINEL) = ','
	  LINEL = LINEL+1
	  CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	  J = J+RHS
	  CALL CVTHALF(DAT(1,J),RHS,LHS)
	 ENDDO
	 LINE(LINEL) = ']'
	 LINEL = LINEL+1
	ENDIF
	IF (LHS.EQ.N$NAME) THEN
	 IF (LINEL.EQ.1) THEN
	  LINEL = 4
	  LINE(1) = '['
	  LINE(2) = '_'
	  LINE(3) = ']'
	 ENDIF
	 CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	 J = J+RHS
	 CALL CVTHALF(DAT(1,J),RHS,LHS)
	ENDIF
	LINE(LINEL) = '.'
	LINEL = LINEL+1
	IF (LHS.EQ.N$EXT) THEN
	 CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	 J = J+RHS
	 CALL CVTHALF(DAT(1,J),RHS,LHS)
	ENDIF
	IF (LHS.EQ.N$VER) THEN
	 J = J+RHS
	 CALL CVTHALF(DAT(1,J),RHS,LHS)
	ENDIF
	IF (LHS.EQ.N$GEN) THEN
	 LINE(LINEL) = ';'
	 LINEL = LINEL+1
	 CALL CVTASZ(DAT(1,J+1),LINE,LINEL)
	ENDIF
	FSLEN = LINEL-1
	DO I=1,FSLEN
	 IF (LINE(I).EQ.'-') LINE(I) = '_'
	ENDDO
	FSPEC(1:FSLEN) = CLINE(1:FSLEN)
	GOTO 900
C
C	ATTRIBUTE SUB-BLOCK
C
200	CONTINUE
	DO J=LINEL,38,1
	LINE(J) = ' '
	ENDDO
	LINEL = MAX(39,LINEL)
	LINE(LINEL) = ' '
	LINEL = LINEL+1
	WRITE(CNUM,210) (DAT(1,I+A$ALLS)+255)/256
210	FORMAT(I8)
	DO J=1,8
	LINE(LINEL-1+J) = NUM(J)
	ENDDO
	LINE(LINEL+8) = ' '
	LINE(LINEL+9) = ' '
	LINE(LINEL+10) = ' '
	LINEL = LINEL+11
	CALL CVTDATE(DAT(1,I+A$WRIT),LINE,LINEL)
	GOTO 900
C
C	DIRECTORY ATTRIBUTES
C
300	CONTINUE
	GOTO 900
C
C	SYSTEM NAME
C
400	CONTINUE
	IF (LINEL.GT.1) THEN
	LINEL = LINEL-1
	IF (LIST) WRITE(2,910) (LINE(J),J=1,LINEL)
	LINEL = 1
	ENDIF
	CALL CVTASZ(DAT(1,I+1),LINE,LINEL)
	IF (LIST) WRITE(2,410) (LINE(J),J=1,LINEL-1)
410	FORMAT(' SYSTEM NAME = ',256(A1,:))
	LINEL = 1
	GOTO 900
C
C	SAVE SET NAME
C
500	CONTINUE
	IF (LINEL.GT.1) THEN
	LINEL = LINEL-1
	IF (LIST) WRITE(2,910) (LINE(J),J=1,LINEL)
	LINEL = 1
	ENDIF
	CALL CVTASZ(DAT(1,I+1),LINE,LINEL)
	IF (LIST) WRITE(2,510) (LINE(J),J=1,LINEL-1)
510	FORMAT(' SAVE SET NAME = ',256(A1,:))
	LINEL = 1
	GOTO 900
C
C	GO TO THE NEXT REGION
C
900	CONTINUE
	I = I+RH
	ENDDO
C
905	CONTINUE
	LINEL = LINEL-1
	IF (LIST) WRITE(2,910) (LINE(J),J=1,LINEL)
910	FORMAT(1X,<LINEL>A1)
1000	CONTINUE
	RETURN
	END