Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/dumper2/validate.for
There are 2 other files named validate.for in the archive. Click here to see a list.
SUBROUTINE VALIDATE(FILESPEC,FSLEN)
C
C This segment will take a file specification from the
C BACKUP tape and if this is a file to remove, will then
C open the file and set FILEOK so that the
C file will be processed.
C
C Parameter list arguments:
C
C FILESPEC -- DEC 10/20 file specification
C FSLEN -- Length of the info in FILESPEC
C
CHARACTER*256 FILESPEC
INTEGER*4 FSLEN
C
INCLUDE 'DMPCOM.FOR/NOLIST'
INCLUDE 'DMPRES.FOR/NOLIST'
EXTERNAL DUMPER_IDFE
C
C LIB$TPARSE parameter information
C
INTEGER*4 STATUS,LIB$TPARSE
INTEGER*4 TPBLOK(0:8),STRINGCNT,STRINGPTR
EXTERNAL TPA$L_COUNT,TPA$L_OPTIONS,TPA$L_STRINGCNT
EXTERNAL TPA$L_STRINGPTR,TPA$L_TOKENCNT,TPA$L_TOKENPTR
EXTERNAL TPA$B_CHAR,TPA$L_NUMBER,TPA$L_PARAM
EXTERNAL TPA$M_BLANKS,TPA$M_ABBRFM,TPA$M_ABBREV
EXTERNAL TPA$M_AMBIG,TPA$K_COUNT0
C
EXTERNAL VFINIT,VFKEY
EXTERNAL VDINIT,VDKEY
C
C Initialize part of the block
C
TPBLOK(%LOC(TPA$L_COUNT)/4) = %LOC(TPA$K_COUNT0)
C TPBLOK(%LOC(TPA$L_OPTIONS)/4) = %LOC(TPA$M_ABBREV)
STRINGCNT = %LOC(TPA$L_STRINGCNT)/4
STRINGPTR = %LOC(TPA$L_STRINGPTR)/4
C
C Validate the file name
C
STELEN = 0
STNLEN = 0
FILEOK = .FALSE.
K = INDEX(FILESPEC(1:FSLEN),']')
IF (K.EQ.0) THEN
CALL ERRORM(%LOC(DUMPER_IDFE),FILESPEC(1:FSLEN))
GOVALUE = 0
RETURN
ENDIF
IF (K.EQ.CDIRLEN) THEN
IF (CURDIR(1:K).EQ.FILESPEC(1:K)) THEN
IF (NVDIR) RETURN
DO I=1,RESCNT-1
VALIDF(I) = VALIDD(I)
ENDDO
TPBLOK(STRINGCNT) = FSLEN-K
TPBLOK(STRINGPTR) = %LOC(FILESPEC(K+1:K+1))
STATUS = LIB$TPARSE(TPBLOK,VFINIT,VFKEY)
IF (STATUS) FILEOK = .TRUE.
ELSE
DO I=1,RESCNT-1
VALIDD(I) = .TRUE.
ENDDO
TPBLOK(STRINGCNT) = K
TPBLOK(STRINGPTR) = %LOC(FILESPEC)
TAPECNT = 1
STATUS = LIB$TPARSE(TPBLOK,VDINIT,VDKEY)
IF (NVDIR) RETURN
DO I=1,RESCNT-1
VALIDF(I) = VALIDD(I)
ENDDO
TPBLOK(STRINGCNT) = FSLEN-K
TPBLOK(STRINGPTR) = %LOC(FILESPEC(K+1:K+1))
STATUS = LIB$TPARSE(TPBLOK,VFINIT,VFKEY)
IF (STATUS) FILEOK = .TRUE.
ENDIF
ELSE
DO I=1,RESCNT-1
VALIDD(I) = .TRUE.
ENDDO
TPBLOK(STRINGCNT) = K
TPBLOK(STRINGPTR) = %LOC(FILESPEC)
TAPECNT = 1
STATUS = LIB$TPARSE(TPBLOK,VDINIT,VDKEY)
IF (NVDIR) RETURN
DO I=1,RESCNT-1
VALIDF(I) = VALIDD(I)
ENDDO
TPBLOK(STRINGCNT) = FSLEN-K
TPBLOK(STRINGPTR) = %LOC(FILESPEC(K+1:K+1))
STATUS = LIB$TPARSE(TPBLOK,VFINIT,VFKEY)
IF (STATUS) FILEOK = .TRUE.
ENDIF
IF (FILEOK.AND.(PRMODE.EQ.FILES)) TYPE 10,FILESPEC(1:FSLEN)
10 FORMAT('+ from ',A)
RETURN
END
INTEGER*4 FUNCTION VAL_DIR(OPTION,SLEN,STRING,TLEN,
1 TOKEN,CHARX,NUMBER,PARAM)
C
C This is the segment that validates directory names from
C the magtape.
C
C Parameter list description:
C
C OPT -- Options given to LIB$TPARSE
C SLEN -- Length of remaining string
C STRING -- Address of remaining string
C TLEN -- Length of the matched token
C TOKEN -- Address of the matched token
C CHARX -- Character matched by a single letter type
C NUMBER -- Integer value of a matched numeric type
C PARAM -- Parameter supplied by state transition
C
INTEGER*4 OPTION,SLEN,TLEN,NUMBER,PARAM
INTEGER*4 CALL_COUNT ![BYU]
BYTE STRING(1),TOKEN(1),CHARX
LOGICAL COMPBS
C
INCLUDE 'DMPCOM.FOR/NOLIST'
INCLUDE 'DMPRES.FOR/NOLIST'
C
CALL_COUNT=CALL_COUNT+1 ![BYU]
VAL_DIR = 0
NVDIR = .FALSE.
DO I=1,RESCNT-1
IF (VALIDD(I)) THEN
IF (TAPELEN(CALL_COUNT,I).EQ.0) THEN
VALIDD(I) = .FALSE.
ELSE IF (TAPELEN(CALL_COUNT,I).GT.0) THEN
IF (TAPELEN(CALL_COUNT,I).EQ.%LOC(TLEN)) THEN
IF (COMPBS(TAPELEN(CALL_COUNT,I),TOKEN,
1 TAPENAME(CALL_COUNT,I))) THEN
TAPECNT = TAPECNT+1
ELSE
VALIDD(I) = .FALSE.
ENDIF
ELSE
VALIDD(I) = .FALSE.
ENDIF
ENDIF
NVDIR = NVDIR .OR. VALIDD(I)
ENDIF
ENDDO
IF (NVDIR) VAL_DIR = 1
NVDIR = .NOT.NVDIR
RETURN
C
C The following code by BYU to do a final validation on the
C directory comparisons.
C
ENTRY VAL_DIR_RESET
CALL_COUNT=0 !reset call to VAL_DIR count each time
VAL_DIR_RESET=0 !Tell TPARSE to cont in present state
RETURN
ENTRY VAL_DIR_CHECK
DO I=1,RESCNT-1
J=1
DO WHILE (TAPELEN(J,I).NE.0.AND.J.LE.TAPEMAX-2)
J=J+1
ENDDO
IF (CALL_COUNT.LT.J-1)VALIDD(I)=.FALSE.
NVDIR=NVDIR.OR.VALIDD(I)
ENDDO
CALL_COUNT=0
IF (NVDIR) VAL_DIR = 1
NVDIR = .NOT.NVDIR
RETURN
END
INTEGER*4 FUNCTION VAL_NAME(OPTION,SLEN,STRING,TLEN,
1 TOKEN,CHARX,NUMBER,PARAM)
C
C This is the segment that validates the file name from
C the magtape.
C
C Parameter list description:
C
C OPT -- Options given to LIB$TPARSE
C SLEN -- Length of remaining string
C STRING -- Address of remaining string
C TLEN -- Length of the matched token
C TOKEN -- Address of the matched token
C CHARX -- Character matched by a single letter type
C NUMBER -- Integer value of a matched numeric type
C PARAM -- Parameter supplied by state transition
C
INTEGER*4 OPTION,SLEN,TLEN,NUMBER,PARAM
BYTE STRING(1),TOKEN(1),CHARX
LOGICAL COMPBS
C
INCLUDE 'DMPCOM.FOR/NOLIST'
INCLUDE 'DMPRES.FOR/NOLIST'
C
VAL_NAME = 0
DO I=1,RESCNT-1
IF (VALIDD(I)) THEN
IF (TAPELEN(TAPEMAX-1,I).EQ.0) THEN
VALIDF(I) = .FALSE.
ELSE IF (TAPELEN(TAPEMAX-1,I).GT.0) THEN
IF (TAPELEN(TAPEMAX-1,I).EQ.%LOC(TLEN)) THEN
IF (.NOT.COMPBS(TAPELEN(TAPEMAX-1,I),TOKEN,TAPENAME(TAPEMAX-1,I)))
1 VALIDF(I) = .FALSE.
ELSE
VALIDF(I) = .FALSE.
ENDIF
ENDIF
IF (VALIDF(I)) VAL_NAME = 1
ENDIF
ENDDO
IF (VAL_NAME.EQ.1) THEN
STNLEN = MIN(9,%LOC(TLEN))
DO I=1,STNLEN
STNAME(I:I) = CHAR(TOKEN(I))
ENDDO
ENDIF
RETURN
END
INTEGER*4 FUNCTION VAL_EXT(OPTION,SLEN,STRING,TLEN,
1 TOKEN,CHARX,NUMBER,PARAM)
C
C This is the segment that validates the extension from
C the magtape.
C
C Parameter list description:
C
C OPT -- Options given to LIB$TPARSE
C SLEN -- Length of remaining string
C STRING -- Address of remaining string
C TLEN -- Length of the matched token
C TOKEN -- Address of the matched token
C CHARX -- Character matched by a single letter type
C NUMBER -- Integer value of a matched numeric type
C PARAM -- Parameter supplied by state transition
C
INTEGER*4 OPTION,SLEN,TLEN,NUMBER,PARAM
BYTE STRING(1),TOKEN(1),CHARX
LOGICAL COMPBS
C
INCLUDE 'DMPCOM.FOR/NOLIST'
INCLUDE 'DMPRES.FOR/NOLIST'
C
VAL_EXT = 0
DO I=1,RESCNT-1
IF (VALIDD(I)) THEN
IF (TAPELEN(TAPEMAX,I).EQ.0) THEN
VALIDF(I) = .FALSE.
ELSE IF (TAPELEN(TAPEMAX,I).GT.0) THEN
IF (TAPELEN(TAPEMAX,I).EQ.%LOC(TLEN)) THEN
IF (.NOT.COMPBS(TAPELEN(TAPEMAX,I),TOKEN,TAPENAME(TAPEMAX,I)))
1 VALIDF(I) = .FALSE.
ELSE
VALIDF(I) = .FALSE.
ENDIF
ENDIF
IF (VALIDF(I)) VAL_EXT = 1
ENDIF
ENDDO
IF (VAL_EXT.EQ.1) THEN
STELEN = MIN(3,%LOC(TLEN))
DO I=1,STELEN
STEXT(I:I) = CHAR(TOKEN(I))
ENDDO
ENDIF
RETURN
END
INTEGER*4 FUNCTION VAL_OPEN(OPTION,SLEN,STRING,TLEN,
1 TOKEN,CHARX,NUMBER,PARAM)
C
C This is the segment that opens the output file
C after validating the names.
C
C Parameter list description:
C
C OPT -- Options given to LIB$TPARSE
C SLEN -- Length of remaining string
C STRING -- Address of remaining string
C TLEN -- Length of the matched token
C TOKEN -- Address of the matched token
C CHARX -- Character matched by a single letter type
C NUMBER -- Integer value of a matched numeric type
C PARAM -- Parameter supplied by state transition
C
INTEGER*4 OPTION,SLEN,TLEN,NUMBER,PARAM
BYTE STRING(1),TOKEN(1),CHARX
C
INCLUDE 'DMPCOM.FOR/NOLIST'
INCLUDE 'DMPRES.FOR/NOLIST'
C
LOGICAL FAIL
CHARACTER*1 ANS
CHARACTER*256 VAXSPEC
INTEGER*4 VSLEN
CHARACTER*7 CC(0:2)
INTEGER*4 RS(0:1)
C
DATA RS/64,640/
DATA CC/'NONE','LIST','FORTRAN'/
C
VAL_OPEN = 0
FAIL = .FALSE.
DO I=1,RESCNT
IF (VALIDF(I)) THEN
VSLEN = 3+VAXLEN(I)+STNLEN+STELEN
VAXSPEC(1:VSLEN) = '[' // VAXDIR(I)(1:VAXLEN(I)) // ']' //
1 STNAME(1:STNLEN) // '.' // STEXT(1:STELEN)
C BYU
C Open two different ways if binary or ascii.
C
IF(IOMODE.EQ.BINARY)THEN
OPEN(UNIT=1,NAME=VAXSPEC(1:VSLEN),STATUS='NEW',ERR=70,
1 CARRIAGECONTROL='NONE',RECORDSIZE=640,
2 INITIALSIZE=1,EXTENDSIZE=1)
ELSE
OPEN(UNIT=1,NAME=VAXSPEC(1:VSLEN),STATUS='NEW',ERR=50,
1 RECL=512,ACCESS='SEQUENTIAL',CARRIAGECONTROL='LIST')
ENDIF
VAL_OPEN = 1
IF (PRMODE.EQ.FILES) TYPE 10, VAXSPEC(1:VSLEN)
10 FORMAT('$Creating ',A<VSLEN>)
GOTO 200
50 CONTINUE
FAIL = .TRUE.
TYPE 60, VAXSPEC(1:VSLEN)
60 FORMAT(' Error creating ',A)
ENDIF
ENDDO
C
IF (FAIL) THEN
70 TYPE 80
80 FORMAT(' Errors occurred, enter S to skip this file, A to',/,
1 ' abort the processing, or F to enter a filename: ',$)
READ(5,90) ANS
90 FORMAT(A)
IF ((ANS.EQ.'S').OR.(ANS.EQ.'s')) GOTO 200
IF ((ANS.EQ.'A').OR.(ANS.EQ.'a')) THEN
GO_VALUE = 0
RETURN
ENDIF
IF ((ANS.NE.'F').AND.(ANS.NE.'f')) GOTO 70
TYPE 100
100 FORMAT(' Enter filename: ',$)
READ(5,110) VSLEN,VAXSPEC
110 FORMAT(Q,A)
OPEN(UNIT=1,NAME=VAXSPEC(1:VSLEN),STATUS='NEW',ERR=70,
1 CARRIAGECONTROL=CC(ORMODE),RECORDSIZE=RS(IOMODE),
2 INITIALSIZE=1,EXTENDSIZE=1)
VAL_OPEN = 1
IF (PRMODE.EQ.FILES) TYPE 10, VAXSPEC(1:VSLEN)
ENDIF
200 CONTINUE
RETURN
END