PDP-10 Archive: tools/dumper2/restore.for from LCG_Integration_Tools_Clearinghouse_T20_v7

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/dumper2/restore.for

There are 2 other files named restore.for in the archive. Click here to see a list.

	INTEGER*4 FUNCTION RES_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the RESTORE command action routine.  It is called when
C	the end of input has been found on a successful RESTORE
C	command.
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'
C
	EXTERNAL DUMPER_RESMAX
C
	RESCNT = RESCNT+1
	IF (RESCNT.GT.RESMAX) THEN
	 CALL ERRORM(%LOC(DUMPER_RESMAX))
	ENDIF
	RES_COMMAND = 1
	RETURN
	END

	INTEGER*4 FUNCTION WHAT_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the WHAT command action routine.  It is called to
C	print out the files/directories that will be restored.
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
	DO I=1,RESCNT-1
	 WRITE(6,100) VAXDIR(I)(1:VAXLEN(I))
100	FORMAT('$[',A,']=[')
	 IF (TAPELEN(1,I).LE.0) THEN
	  WRITE(6,110) '*'
110	FORMAT('+',A,$)
	 ELSE
	  WRITE(6,110) TAPENAME(1,I)(1:TAPELEN(1,I))
	 ENDIF
	 DO J=2,TAPEMAX-2
	  IF (TAPELEN(J,I).LT.0) THEN
	   WRITE(6,120) '*'
120	FORMAT('+,',A,$)
	  ELSE IF (TAPELEN(J,I).EQ.0) THEN
	   GOTO 130
	  ELSE
	   WRITE(6,120) TAPENAME(J,I)(1:TAPELEN(J,I))
	  ENDIF
	 ENDDO
130	CONTINUE
	 IF (TAPELEN(TAPEMAX-1,I).LT.0) THEN
	  WRITE(6,140) '*'
140	FORMAT('+]',A,'.',$)
	 ELSE IF (TAPELEN(TAPEMAX-1,I).EQ.0) THEN
	  WRITE(6,145)
145	FORMAT('+].',$)
	 ELSE
	  WRITE(6,140) TAPENAME(TAPEMAX-1,I)(1:TAPELEN(TAPEMAX-1,I))
	 ENDIF
	 IF (TAPELEN(TAPEMAX,I).LT.0) THEN
	  WRITE(6,150) '*'
150	FORMAT('+',A)
	 ELSE IF (TAPELEN(TAPEMAX,I).EQ.0) THEN
	  WRITE(6,155)
155	FORMAT('+')
	 ELSE
	  WRITE(6,150) TAPENAME(TAPEMAX,I)(1:TAPELEN(TAPEMAX,I))
	 ENDIF
	ENDDO
	WHAT_COMMAND =  1
	RETURN
	END

	INTEGER*4 FUNCTION RESET_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the RESET command action routine.  It is called to
C	reset the restore information.
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
	RESCNT = 1
	RESET_COMMAND = 1
	RETURN
	END

	INTEGER*4 FUNCTION RES_VDIR(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine called when the VAX filename is
C	started.  It will reset the data being built up.  If the
C	limit of names has already been reached, it will return an
C	error code to be reported.
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
	EXTERNAL DUMPER_RESIGN
C
C	If the maximum number of restore statements have been
C	processed already, return the 'ignored' message.  If
C	not, then clean out the current values of the restore
C	information in case a previous command line aborted.
C
	IF (RESCNT.GT.RESMAX) THEN
	 RES_VDIR = %LOC(DUMPER_RESIGN)
	ELSE
	 VAXDIR(RESCNT) = ' '
	 VAXLEN(RESCNT) = 0
	 DO I=1,TAPEMAX
	  TAPENAME(I,RESCNT) = ' '
	  TAPELEN(I,RESCNT) = 0
	 ENDDO
	 TAPECNT = 1
	 RES_VDIR = 1
	ENDIF
	RETURN
	END

	INTEGER*4 FUNCTION RES_VNAME(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine called to add to the VAX
C	directory name that will recieve the data.
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
	EXTERNAL DUMPER_RESDNM
C
C	Save the partial VAX directory name.  Report an error
C	if it is too long.
C
	J = VAXLEN(RESCNT)
	IF (J+%LOC(TLEN).GT.64) THEN
	 RES_VNAME = %LOC(DUMPER_RESDNM)
	ELSE
	 DO I=1,%LOC(TLEN)
	  VAXDIR(RESCNT)(I+J:I+J) = CHAR(TOKEN(I))
	 ENDDO
	 VAXLEN(RESCNT) = J+%LOC(TLEN)
	 RES_VNAME = 1
	ENDIF
	RETURN
	END

	INTEGER*4 FUNCTION RES_VDOT(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine that is called when a period
C	is seen in the VAX directory name.  It will add the period
C	to the current directory name being built.
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
	EXTERNAL DUMPER_RESDNM
C
C	If the period won't fit in the name, report an error
C
	J = VAXLEN(RESCNT)+1
	IF (J.GT.64) THEN
	 RES_VDOT = %LOC(DUMPER_RESDNM)
	ELSE
	 VAXDIR(RESCNT)(J:J) = '.'
	 VAXLEN(RESCNT) = J
	 RES_VDOT = 1
	ENDIF
	RETURN
	END

	INTEGER*4 FUNCTION RES_TNAME(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine that is called when the
C	tape name information is to be added to.  It will copy
C	the supplied token into the current tape name area if
C	it will fit.  If not, it will return an error message.
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
	EXTERNAL DUMPER_RESDNM,DUMPER_RESFNM
C
	IF (%LOC(TLEN).GT.32) THEN
	 IF (TAPECNT.GE.TAPEMAX-1) THEN
	  RES_TNAME = %LOC(DUMPER_RESFNM)
	 ELSE
	  RES_TNAME = %LOC(DUMPER_RESDNM)
	 ENDIF
	ELSE
	 DO I=1,%LOC(TLEN)
	  TAPENAME(TAPECNT,RESCNT)(I:I) = CHAR(TOKEN(I))
	 ENDDO
	 TAPELEN(TAPECNT,RESCNT) = %LOC(TLEN)
	 RES_TNAME = 1
	ENDIF
	RETURN
	END

	INTEGER*4 FUNCTION RES_TSTAR(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine that handles the asterisk when
C	found in a DEC 10/20 filename specification.  It merely
C	sets the length of this part of the name to -1.
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
	TAPELEN(TAPECNT,RESCNT) = -1
	RES_TSTAR = 1
	RETURN
	END

	INTEGER*4 FUNCTION RES_TDOT(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine called when a comma (or period)
C	is seen in a DEC 10/20 directory name.  It will increment
C	the index into the tape name table and signal an error if
C	too many sfd's have been seen.
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
	EXTERNAL DUMPER_RESSFD
C
	IF (TAPECNT.EQ.TAPEMAX-2) THEN
	 RES_TDOT = %LOC(DUMPER_RESSFD)
	ELSE
	 TAPECNT = TAPECNT+1
	 RES_TDOT = 1
	ENDIF
	RETURN
	END

	INTEGER*4 FUNCTION RES_TBR(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine called to handle the right bracket
C	in the tape name.  It will set the index to the tape name to
C	point to the filename portion.
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
	TAPECNT = TAPEMAX-1
	RES_TBR = 1
	RETURN
	END
	INTEGER*4 FUNCTION RES_VMIN(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the action routine that is called when a minus
C	is seen in the VAX directory name.  It will add the minus
C	to the current directory name being built.
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
	EXTERNAL DUMPER_RESDNM
C
C	If the period won't fit in the name, report an error
C
	J = VAXLEN(RESCNT)+1
	IF (J.GT.64) THEN
	 RES_VMIN = %LOC(DUMPER_RESDNM)
	ELSE
	 VAXDIR(RESCNT)(J:J) = '-'
	 VAXLEN(RESCNT) = J
	 RES_VMIN = 1
	ENDIF
	RETURN
	END