PDP-10 Archive: tools/dumper2/bigvalida.for from integ_tools_tops20_v7_30-apr-86

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/dumper2/bigvalida.for

There are 2 other files named bigvalida.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=32767,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