Trailing-Edge
-
PDP-10 Archives
-
tops10_integ_tools_v4_10jan-86
-
70,6067/dumpr1/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