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