Google
 

Trailing-Edge - PDP-10 Archives - integ_tools_tops20_v7_30-apr-86_dumper - tools/dumper2/dmpact.for
There are 3 other files named dmpact.for in the archive. Click here to see a list.
	INTEGER*4 FUNCTION EOT_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the EOT command action routine.  It is called when
C	the user wants to move the magtape to the end of tape.
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'
C
	INTEGER*2 IOSB(4)
	INTEGER*4 STATUS
	EXTERNAL IO$_SKIPFILE,SS$_VOLINV
	EXTERNAL DUMPER_NTDSEL
	INTEGER*4 SYS$QIOW
	LOGICAL FLAG
C
	IF (.NOT.GOTDEV) THEN
	    DEVLEN=6
	    DEVNAME(1:6)='DUMPER'
	    CALL USE_COMMAND
	ENDIF
C
	IF(GOTDEV)THEN
	    FLAG = .TRUE.
	    DO WHILE (FLAG)
	        CALL MTSKPF(CHANNEL,10000,STATUS)
	        IF (.NOT.STATUS) FLAG = .FALSE.
C	        IF (STATUS.EQ.%LOC(SS$_VOLINV)) THEN
C	        TYPE 20, DEVNAME(1:DEVLEN)
C20	        FORMAT(' The magtape must be mounted before this program can',/,
C	1          ' access it.  Exit and type "$ MOUNT/FOR ',A,'" before',/,
C	2          ' trying again.')
C	        ENDIF
	    ENDDO
	ENDIF
	EOT_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION GO_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the GO command action routine.  It is called when
C	the save set is to be processed.  The value of GOVALUE is
C	the number of save sets to process.  Default value is one.
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 SS$_ENDOFFILE,SS$_ENDOFVOLUME
	EXTERNAL DUMPER_STDBLK,DUMPER_CCCBLK
	EXTERNAL DUMPER_NTDSEL,DUMPER_UNKBLK
C
C	Local data storage:
C	BUFFER -- The input buffer from the magtape
C	BUFLEN -- The buffer length (a constant)
C	ACTLEN -- The actual number of bytes read in by a read
C	STATUS -- The status of the I/O transfer
C	HEADER -- The reformatted DEC-10/20 information
C
	INTEGER*4 BUFLEN
	PARAMETER (BUFLEN=2720)
	BYTE BUFFER(BUFLEN)
	INTEGER*4 ACTLEN,STATUS
	INTEGER*4 HEADER(2,32)
C
	IF (.NOT.GOTDEV) THEN
	    DEVLEN=6
	    DEVNAME(1:6)='DUMPER'
	    CALL USE_COMMAND
	ENDIF
C
C	Initialize the validation tables
C
	IF(GOTDEV)THEN
	    DO I=1,RESMAX
	        VALIDD(I) = .FALSE.
	        VALIDF(I) = .FALSE.
	    ENDDO
	    CDIRLEN = 0
C
	    DO WHILE (GOVALUE.GT.0)
	        CALL MTREAD(CHANNEL,BUFFER,BUFLEN,ACTLEN,STATUS)
	        IF (.NOT.STATUS) THEN
	            IF (STATUS.EQ.%LOC(SS$_ENDOFFILE)) THEN
	                IF (EOFSEEN) THEN
	                    CALL ERRORM(%LOC(SS$_ENDOFVOLUME))
	                    GOVALUE = 0
	                ELSE
	                    GOVALUE = GOVALUE-1
	                    EOFSEEN = .TRUE.
	                ENDIF
	            ELSE
	                GOVALUE = 0
	            ENDIF
	        ELSE
	            EOFSEEN = .FALSE.
	            IF (ACTLEN.EQ.2720) THEN
	                IF (BLKTYP.NE.STDBLK) THEN
	                    CALL ERRORM(%LOC(DUMPER_STDBLK))
	                    BLKTYP = STDBLK
	                ENDIF
	                CALL CVT36(BUFFER,HEADER,32)
	                CALL PROCESS(BUFFER,HEADER)
	            ELSE IF (ACTLEN.EQ.2448) THEN
	                IF (BLKTYP.NE.CCCBLK) THEN
	                    CALL ERRORM(%LOC(DUMPER_CCCBLK))
	                    BLKTYP = CCCBLK
	                ENDIF
	                CALL CVT72(BUFFER,HEADER,32)
	                CALL PROCESS(BUFFER,HEADER)
	            ELSE
	                CALL ERRORM(%LOC(DUMPER_UNKBLK),ACTLEN)
	                CALL MTSKPF(CHANNEL,1,STATUS)
	                GOVALUE = GOVALUE-1
	                EOFSEEN = .TRUE.
	            ENDIF
	        ENDIF
	    ENDDO
	ENDIF
	GO_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION HELP_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C BYU
C	Set up parameters to call the help library.
C
	PARAMETER HELP_LIBRARY='SYS$HELP:DUMPER.HLB'
	PARAMETER HLP$M_HELP=	'00000020'X
	PARAMETER HLP$M_PROMPT=	'00000001'X
	INTEGER*4 LBR$OUTPUT_HELP,ISTAT,HLP_FLAGS
	EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT
C
C	This is the HELP command action routine.  It is called when
C	the user wants to get HELP.
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'
C
	CHARACTER*1 ANS
C
C BYU
C	Call the help library.	Go into prompt mode and display the main
C	help text in the library.
C
 	HLP_FLAGS=HLP$M_PROMPT.OR.HLP$M_HELP
	ISTAT=LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,,HELP_LIBRARY,
	1	HLP_FLAGS,LIB$GET_INPUT)
	IF(.NOT.ISTAT) THEN
	    TYPE*,'	(HELP files temporarily unavailable,  contact the'
	    TYPE*,'	system manager if condition persists.)'
	ENDIF
C
C 	The below commented out by BYU.
C
C	TYPE 10
C10	FORMAT(
C	1 1X,/' Magtape Handling Commands:',/,
C	1 7X,'USE drive -- Use the magtape drive "drive"',/,
C	1 7X,'EOT -- Skip to the end of tape',/,
C	1 7X,'REWIND -- Rewind the magtape',/,
C	1 7X,'SKIP n -- Skip ''n'' save sets (negative means reverse)',/,
C	2 1X,'File Processing Commands:',/,
C	2 7X,'RESTORE vaxdir=files -- Copy the files on tape to the VAX',
C	2 ' directory '/12x'specified (may be repeated).  Use RESTORE ',
C	2     'vaxdir=[*]file.ext',/,
C	2 12X,'for interchange mode tapes.  *.* is legal',/,
C	2 7X,'WHAT -- Lists the RESTORE commands that are active',/,
C	2 7X,'GO n -- Process ''n'' save sets',/,
C	2 7X,'RESET -- Reset the list of RESTORE commands',/,
C	2 7X,'Type Control-C to abort the processing of a GO command')
C       READ(*,15) ANS
C15	FORMAT(A)
C	TYPE 20
C20	FORMAT(
C	3 1X,'File Listing Commands:',/,
C	3 7X,'FILES -- The files restored will be listed on the user''s',
C	3 ' terminal',/,
C	3 7X,'LIST -- Allows the user to select a tape directory listing',/,
C	3 7X,'SILENT -- Reverses the action of the FILES command',/,
C	5 1X,'Miscellaneous Commands:',/,
C	5 7X,'HELP -- Print this message',/,
C	5 7X,'STOP, EXIT, or QUIT -- Leave the program',/,
C	5 /,1X,'At DCL command level, type HELP DUMPER for more'
C	5 ' information.'/)
	HELP_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION REW_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the REWIND command action routine.  It is called
C	when the user wants to rewind the magtape back to the
C	start of the tape.
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
	INTEGER*4 SYS$QIOW
	INTEGER*4 STATUS
	INTEGER*2 IOSB(4)
	EXTERNAL IO$_REWIND
	EXTERNAL DUMPER_NTDSEL
	INCLUDE 'DMPCOM.FOR/NOLIST'
C
	IF (.NOT.GOTDEV) THEN
	    DEVLEN=6
	    DEVNAME(1:6)='DUMPER'
	    CALL USE_COMMAND
	ENDIF
C
	IF(GOTDEV)THEN
	    STATUS = SYS$QIOW(,%VAL(CHANNEL),IO$_REWIND,IOSB,,
	1       ,,,,,,)
	    IF (.NOT.STATUS) CALL ERRORM(STATUS)
	ENDIF
	REW_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION SKIP_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the SKIP command action routine.  It is called when
C	the user wants to skip forward or backward save sets.
C	If the skip value supplied is negative, the program will
C	skip back save sets.  If positive, the program will skip
C	forward save sets.
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'
C
	INTEGER*2 IOSB(4)
	INTEGER*4 STATUS
	EXTERNAL IO$_SKIPFILE,SS$_VOLINV
	EXTERNAL DUMPER_NTDSEL
	LOGICAL FLAG
	INTEGER*4 SKIPIT,COUNT
C
	IF (.NOT.GOTDEV) THEN
	    DEVLEN=6
	    DEVNAME(1:6)='DUMPER'
	    CALL USE_COMMAND
	ENDIF
C
C	Skip in the direction desired... subtract one from
C	0 and less skips.
C
	IF(GOTDEV)THEN
	    IF (SIGN.EQ.ICHAR('-')) THEN
	        COUNT = -SKIPNO
	    ELSE
	        COUNT = SKIPNO
	    ENDIF
	    CALL MTSKPF(CHANNEL,COUNT,STATUS)
C	    IF (STATUS.EQ.%LOC(SS$_VOLINV)) THEN
C	       TYPE 20, DEVNAME(1:DEVLEN)
C20	       FORMAT(' The magtape must be mounted before this program can',/,
C	1       ' access it.  Stop and type "$ MOUNT/FOR ',A,'" before',/,
C	2        ' trying again.')
C	    ENDIF
	ENDIF
	SKIP_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION USE_COMMAND(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the USE command action routine.  It is called when
C	the device is to be selected.  The common variable DEVNAME
C	has the characters in the name, and the common variable
C	DEVLEN is the number of characters in that name.  The
C	channel assignment made by SYS$ASSIGN will be put into
C	the common variable CHANNEL.
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'
C
	INTEGER*4 SYS$ASSIGN,SYS$DASSGN
	INTEGER*4 STATUS
	EXTERNAL DUMPER_ERRDPD,DUMPER_ERRATD
C
C	The following by BYU for SYS$GETDVI and SYS$WAITFR.
C
        PARAMETER  DVI$_DEVCLASS  ='00000004'X
        PARAMETER  DVI$_DEVCHAR   ='00000002'X
        PARAMETER  DEV$M_MNT      ='00080000'X
        PARAMETER  DEV$M_AVL      ='00040000'X
        PARAMETER  DC$_TAPE       ='00000002'X
	INTEGER*2 ITEM_CODE,BUFFER_LEN
	INTEGER*4 BUFFER_ADDR,RET_LEN_ADDR,RET_BUFF,IOSB(2)
	INTEGER*2 ITEM_LIST(8)
	EQUIVALENCE (ITEM_LIST(1),BUFFER_LEN)
	EQUIVALENCE (ITEM_LIST(2),ITEM_CODE)
	EQUIVALENCE (ITEM_LIST(3),BUFFER_ADDR)
	EQUIVALENCE (ITEM_LIST(5),RET_LEN_ADDR)
	DATA ITEM_LIST(7),ITEM_LIST(8)/0,0/	!Terminate the list
	DATA BUFFER_LEN/4/
	EXTERNAL DUMPER_NOTMNT,DUMPER_OFFLIN,DUMPER_NTDSEL,DUMPER_NOTMTA
C
	IF (GOTDEV) THEN
	 STATUS = SYS$DASSGN(%VAL(CHANNEL))
	 IF (.NOT.STATUS) THEN
	  CALL ERRORM(%LOC(DUMPER_ERRDPD))
	  CALL ERRORM(STATUS)
	 ENDIF
	ENDIF
C
	STATUS = SYS$ASSIGN(DEVNAME(1:DEVLEN),CHANNEL,,)
	IF (.NOT.STATUS) THEN
	    GOTDEV=.FALSE.
	    IF(DEVNAME(1:DEVLEN).EQ.'DUMPER')THEN
	        CALL ERRORM(%LOC(DUMPER_NTDSEL))
	    ELSE
	        CALL ERRORM(%LOC(DUMPER_ERRATD),DEVNAME(1:DEVLEN))
	        CALL ERRORM(STATUS)
	    ENDIF
	ELSE
	    GOTDEV = .TRUE.
C
C	    Below by BYU to see if the device is a tape and is mounted.
C
	    BUFFER_ADDR=%LOC(RET_BUFF)
	    ITEM_CODE=DVI$_DEVCLASS
	    CALL SYS$GETDVI(,%VAL(CHANNEL),,ITEM_LIST,IOSB,,,)
	    IF(RET_BUFF.NE.DC$_TAPE)CALL ERRORM(%LOC(DUMPER_NOTMTA))
	    ITEM_CODE=DVI$_DEVCHAR
	    CALL SYS$GETDVI(,%VAL(CHANNEL),,ITEM_LIST,IOSB,,,)
	    IF((RET_BUFF.AND.DEV$M_MNT).EQ.0)CALL ERRORM(%LOC(DUMPER_NOTMNT))
	    IF((RET_BUFF.AND.DEV$M_AVL).EQ.0)CALL ERRORM(%LOC(DUMPER_OFFLIN))
	ENDIF
        USE_COMMAND = 1
	RETURN
	END
	INTEGER*4 FUNCTION USE_NAME(OPTION,SLEN,STRING,TLEN,
	1 TOKEN,CHARX,NUMBER,PARAM)
C
C	This is the GO command action routine.  It is called when
C	when the device name has been entered.  The name is copied
C	from TOKEN into DEVNAME, and TLEN is copied into DEVLEN.
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
	INTEGER*4 I
C
	INCLUDE 'DMPCOM.FOR/NOLIST'
C
	DEVLEN = MIN(64,%LOC(TLEN))
	DO I=1,DEVLEN,1
	 DEVNAME(I:I) = CHAR(TOKEN(I))
	ENDDO
C
	USE_NAME = 1
	RETURN
	END