	Program Foreign_Tape_Processor
c
c Author:             Mark R. Vevle
c                     UAB Center for Macromolecular Crystallography
c                     University of Alabama at Birmingham
c                     244 BHS, THT 79
c                     University Station
c                     Birmingham, Alabama  35294
c                     (205) 934 - 1973 / 2657
c
c Description:        FTP - A Foreign Tape Processing utility
c
c                     This program reads and writes foreign tapes. FTP will
c                     handle tapes which are  written as  'CARD IMAGES'  as
c                     well  as making copies of any tape to a disk file and
c                     back.
c
c Function:           o To provide users a  simple and easy to use means to
c                       read  and  write foreign tapes for export/import
c                       to/from machines and operating systems.
c
c Disclaimer/rights:  This   software  is  in  the  public  domain  and  is
c                     provided  free  though  DECUS or other channels.  The
c                     information  in  this  software  is subject to change
c                     without  notice  and  should  not  be  construed as a
c                     commitment  by the author or his employer. The author
c                     and  his  employer  assumes no responsibility for the
c                     use,  the  correctness,  or  the  reliability of this
c                     software. THIS SOFTWARE IS PROVIDED AS IS.
c
c Environment:        VAX/VMS V4.0 or later
c
c Privledges Needed:  NONE
c
c Modification History (VMS V4):
c
c                     V1.0 - Original version
c
c                            MRV 15-AUG-1986
c
c                     V1.1 - Make  FTP write  two EOF marks after each file
c                            written, then backspace over two of them. This
c                            provides a hard END OF TAPE mark.
c
c                            MRV 19-AUG-1986
c
c                     V1.2 - Add the ability to make IMAGE copies of tapes.
c
c                            MRV 21-AUG-1986
c
c                   V1.2.1 - Restructure subroutines and clean up code.
c
c                            MRV 22-AUG-1986
c
c                   V1.3.1 - Add the SET verb.
c
c                            Modify the SKIP FILE routine so that it will
c                            skip the correct number of files in the reverse
c                            direction.
c
c                            Change the format of the image file. Write the
c                            status code in 'binary' rather than formatted
c                            to conserve space.
c
c                            Add /CARRIAGE_CONTROL, /FIXED, /TRIM qualifiers
c                            to the READ verb.
c
c                            MRV 26-AUG-1986
c

c
	Include '($RMSDEF)'
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
c
	Character*256	Cmd
c
	Integer		CLI$DCL_PARSE,		Parse_Status
	Integer		Cmd_Len
c
	External	LIB$GET_INPUT,		FTP$COMMAND_TABLE
	External	FTP$SIGNAL_HANDLER
c
c   Establish a condition handler
c
	Call Lib$Establish ( FTP$SIGNAL_HANDLER )
c
c	Initialize
c
	FTP$ASCEBC_FLG = .False.
	FTP$EBCASC_FLG = .False.
	FTP$OTHER_FLG = .False.
	FTP$TRANSLATE_FLG = .False.
	FTP$CARRIAGE_CONTROL = 'LIST'
	FTP$REC_PADCHAR = 32
	FTP$BLK_PADCHAR = 0
c
c	Begin...
c
	Call FTP$Get_Command_Line ( Cmd, Cmd_Len )
c
	Cmd = 'FTP ' // Cmd( : Cmd_Len)
	Cmd_Len = Cmd_Len + 4
	Parse_Status = CLI$DCL_PARSE
	1		(	Cmd( : Cmd_Len)		! command-string
	1		,	FTP$COMMAND_TABLE	! table
	1		,	Lib$Get_Input		! [param-routine]
	1		,	Lib$Get_Input		! [prompt-routine]
	1		,	'FTP> '			! [prompt-string]
	1		)
c
	If ( Parse_Status ) Then
	    Call CLI$DISPATCH
	    If (.not. FTP$READY_FLG) Parse_Status = .False.
	End If
c
	Do While ( Parse_Status )
c
	    Parse_Status = CLI$DCL_PARSE
	1			(				! command-string
	1			,	FTP$COMMAND_TABLE	! table
	1			,	Lib$Get_Input		! [param-routine]
	1			,	Lib$Get_Input		! [prompt-routine]
	1			,	'FTP> '			! [prompt-string]
	1			)
c
	    If ( Parse_Status ) Then
		Call CLI$DISPATCH
	    Else If (Parse_Status .ne. RMS$_EOF ) Then
		Parse_Status = .True.
	    End If
c
	End Do
c
	End



	Subroutine FTP$Mount
c
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
c
	Character*256	Device_Name
c
	Integer		Device_Present,		Device_Length
	Integer		CLI$PRESENT
c
	
	If ( CLI$PRESENT('ASSIST_FLAG') ) Then
	    FTP$ASSIST_FLG = .True.
	Else
	    FTP$ASSIST_FLG = .False.
	End If
c
	If ( CLI$PRESENT('DENSITY.800') ) Then
	    FTP$DENSITY = 800
	Else If ( CLI$PRESENT('DENSITY.1600') ) Then
	    FTP$DENSITY = 1600
	Else If ( CLI$PRESENT('DENSITY.6250') ) Then
	    FTP$DENSITY = 6250
	End If
c
	Call CLI$GET_VALUE('LABEL', FTP$LABEL, FTP$LABEL_LEN)
c
	Call CLI$GET_VALUE	(	'DEVICE_NAME'	! entity_desc
	1			,	Device_Name	! retdesc
	1			,	Device_Length	! retlength
	1			)
c
	Call FTP$Mount_Device
c
	Return
	End



	Subroutine FTP$Attach
c
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
c
	Character*256	Device_Name
c
	Integer		Device_Present
	Integer		Device_Length
	Integer		CLI$PRESENT,		CLI$GET_VALUE
c
	Character*4	String
	Integer	Slen
c
10	Format( I4 )
c
	Device_Present = CLI$GET_VALUE
	1			(	'DEVICE_NAME'	! entity_desc
	1			,	Device_Name	! retdesc
	1			,	Device_Length	! retlength
	1			)
c
	Call FTP$GETDVI( Device_Name( :Device_Length) )
c
	If ( FTP$TAPDEV_FLG .and. FTP$DEVAVL_FLG .and. FTP$IOWN_FLG ) Then
	    If ( .not. FTP$MOUNTED_FLG ) Call FTP$MOUNT
	    If ( FTP$MNTFOR_FLG ) Call FTP$ASSIGN_CHANNEL
	End If
c
	Return
	End



	Subroutine FTP$ASSIGN_CHANNEL
c
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
	Include '($DVIDEF)'
c
	Integer		SYS$ASSIGN,	Assign_Status
c
	Assign_Status = SYS$ASSIGN
	1	(	FTP$FULLDEVNAM( :FTP$FULLDEVNAM_LEN)	! devnam
	1	,	FTP$CHANNEL				! chan
	1	,						! acmode
	1	,						! mbxnam
	1	)
c
	If ( Assign_Status ) Then
	    FTP$READY_FLG = .True.
	    Call LIB$GETDVI
	1	(	DVI$_DEVBUFSIZ				! item-code
	1	,	FTP$CHANNEL				! channel
	1	,						! device-name
	1	,	FTP$BUFSIZ				! out-value
	1	,						! out-string
	1	,						! out-len
	1	)
	    Call Lib$GetDvi
	1	(	DVI$_RECSIZ				! item-code
	1	,	FTP$CHANNEL				! channel
	1	,						! device-name
	1	,	FTP$RECSIZ				! out-value
	1	,						! out-string
	1	,						! out-len
	1	)
c
	    If ( FTP$RECSIZ .le. 0 ) FTP$RECSIZ = FTP$BUFSIZ
c
	Else
c
	    FTP$READY_FLG = .False.
	    Call LIB$SIGNAL( %Val(Assign_Status) )
c
	End If
c
	Return
	End



	Subroutine FTP$Get_Command_Line ( Cmd, Cmd_Len )
c
	Character*256		Cmd
c
	Integer*4		Cmd_Len
c
	Call LIB$GET_FOREIGN
	1		(	Cmd		! get-str
	1		,			! [user-prompt]
	1		,	Cmd_Len		! [out-len]
	1		,			! [force-prompt]
	1		)
c
	Return
	End



	Subroutine FTP$Mount_Device
c
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
c
	Parameter	Mnt_Size = 15
c
	Integer		Mnt_Items( Mnt_Size )
	Integer		Mount_Status,		SYS$MOUNT
c
	If (FTP$IOWN_FLG) Then
	    Call FTP$Setup_Mount ( Mnt_Items, Mnt_Items,
	1			   FTP$LABEL( :FTP$LABEL_LEN ) )
	    Mount_Status = SYS$MOUNT( Mnt_Items )
	    If ( .not. Mount_Status ) Then
		Call LIB$SIGNAL( %Val(Mount_Status) )
		FTP$MOUNT_FLG = .False.
		FTP$MNTFOR_FLG = .False.
	    Else
		FTP$MOUNT_FLG = .True.
		FTP$MNTFOR_FLG = .True.
	    End If
	End If
c
	Call FTP$GETDVI( FTP$FULLDEVNAM( :FTP$FULLDEVNAM_LEN) )
c
	Return
	End



	Subroutine FTP$Setup_Mount ( Long, Short, Volume_Label )
c
	Parameter	Mount_Size = 15
c
	Character	Volume_Label*(*)
c
	Integer		Long(Mount_Size)
c
	Integer*2	Short(2, Mount_Size)
c
	Include '($MNTDEF)'
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
c
c	*** Device Name
c
	Short(1, 1) = 4
	Short(2, 1) = MNT$_DEVNAM
	Long( 2) = %LOC( FTP$FULLDEVNAM )
	Long( 3) = FTP$FULLDEVNAM_LEN
c
c	*** Flags
c
	Short(1, 4) = 4
	Short(2, 4) = MNT$_FLAGS
	FTP$DUMMY =	JIOR	(	MNT$M_FOREIGN,		! Mount Foreign
	1		JIOR	(	MNT$M_NOHDR3,		! No Headers
	1		JIOR	(	MNT$M_MESSAGE,		! Mount Message
	1		JIOR	(	MNT$M_NOAUTO,		! No AVL or AVR
	1				MNT$M_TAPE_DATA_WRITE	! Enable Cache
	1			)
	1			)
	1			)
	1			)
c
	If ( .NOT. FTP$ASSIST_FLG )
	1	FTP$DUMMY = JIOR( FTP$DUMMY, MNT$M_NOASSIST)
c
	Long( 5) = %Loc(FTP$DUMMY)
	Long( 6) = 4
c
c	*** Density
c
	Short(1, 7) = 4
	Short(2, 7) = MNT$_DENSITY
	Long( 8) = %Loc(FTP$DENSITY)
	Long( 9) = 4
c
c	*** Volume label (if specified)
c
	Short(1,10) = Len( Volume_Label )
	Short(2,10) = MNT$_VOLNAM
	Long(11) = %Loc( Volume_Label )
	Long(12) = Len( Volume_Label )
c
c	*** End of mount options
c
	Short(1,13) = 0
	Short(2,13) = 0
	Long(14) = 0
	Long(15) = 0
c
	Return
	End

