	Subroutine FTP$WRITE
c
	Include 'FTP$DEVINFO.FOR'
c
c	*** FTP error messages
c
	External	FTP$_FILCNT
	External	FTP$_NOFILPRC
c
	Character*256	Input_File,	Cmd
c
	Integer		Input_Len,	Buffer_Address
	Integer		Byt,		Rec,		Blk
	Integer		FTP$SET_TAPE,	CLI$Get_Value
c
	Input_Present = CLI$Get_Value
	1			(	'INPUT_FILE'	! entity_desc
	1			,	Input_File	! retdesc
	1			,	Input_Length	! retlength
	1			)
c
c	*** Set tape block and record sizes
c
	I = 0
c
	If ( FTP$Set_Tape() ) Then
c
c	    *** DYNAMICALLY allocate enough memory for buffers
c
	    Call FTP$GET_MEMORY( Buffer_Address, FTP$BUFSIZ )
c
	    Byt = FTP$RECSIZ
	    Rec = FTP$BUFSIZ / FTP$RECSIZ
c
	    Call FTP$Process_Files( Input_File( : Input_Length), I,
	1			%Val( Buffer_Address ), Byt, Rec )
c
	    Call FTP$RELEASE_MEMORY( Buffer_Address, FTP$BUFSIZ )
	End If
c
	If ( I .eq. 0 ) Then
	    Call Lib$Signal( FTP$_NOFILPRC )
	Else
	    Call Lib$Signal( FTP$_FILCNT, %Val( 1 ), %Val( I ) )
	End If
c
	Return
	End



	Integer Function FTP$SET_TAPE
c
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$TRANSTBL.FOR'
c
c	*** FTP error messages
c
	External	FTP$_INVRECCHR
	External	FTP$_INVBLKCHR
	External	FTP$_INVRECSIZ
	External	FTP$_INVBLKSIZ
	External	FTP$_RECNOTMULT
	External	LIB$AB_ASC_EBC
	External	LIB$AB_EBC_ASC
c
	Character*255	String
c
	Integer		CLI$Get_Value,		CLI$Present
	Integer		TMP$PADCHAR,		TMP$BUFSIZ
	Integer		TMP$RECSIZ
	Integer		SLen,			Status
c
10	Format( I10 )
c
	FTP$SET_TAPE = .TRUE.
c
c	*** Check for /LOG
c
	If ( CLI$Present('LOG') ) Then
	    FTP$LOG_FLG = .True.
	Else
	    FTP$LOG_FLG = .False.
	End If
c
c	*** Check for the translate switch (/TRANSLATE={})
c
	If ( CLI$Present('TRANSLATION.ASCII_TO_EBCDIC') ) Then
		FTP$ASCEBC_FLG = .True.
		FTP$EBCASC_FLG = .False.
		FTP$OTHER_FLG = .False.
		FTP$TRANSLATE_FLG = .True.
		Call FTP$LOAD_TABLE( FTP$TRANS_TABLE, LIB$AB_ASC_EBC )
	Else If ( CLI$Present('TRANSLATION.EBCDIC_TO_ASCII') ) Then
		FTP$ASCEBC_FLG = .False.
		FTP$EBCASC_FLG = .True.
		FTP$OTHER_FLG = .False.
		FTP$TRANSLATE_FLG = .True.
		Call FTP$LOAD_TABLE( FTP$TRANS_TABLE, LIB$AB_EBC_ASC )
	Else If ( CLI$Present('TRANSLATION.OTHER') ) Then
		Call CLI$Get_Value('TRANSLATION.OTHER', String, Slen)
		Call FTP$READ_TABLE(FTP$TRANS_TABLE, String(:Slen), Status)
		If ( Status ) Then
		    FTP$ASCEBC_FLG = .False.
		    FTP$EBCASC_FLG = .False.
		    FTP$OTHER_FLG = .True.
		    FTP$TRANSLATE_FLG = .True.
		Else
		    FTP$SET_TAPE = .False.
		    Return
		End If
	Else If ( CLI$Present('TRANSLATION.NONE') ) Then
		FTP$TRANSLATE_FLG = .False.
		FTP$ASCEBC_FLG = .False.
		FTP$EBCASC_FLG = .False.
		FTP$OTHER_FLG = .False.
	End If
c
c	*** Check for the record pad character
c
	If ( CLI$Present( 'PAD_CHARACTER.RECORD' ) ) Then
	    Call CLI$Get_Value('PAD_CHARACTER.RECORD', String, Slen)
	    Read(String(:Slen),10) TMP$PADCHAR
	    If ( (TMP$PADCHAR .gt. 127 ) .or. (TMP$PADCHAR .lt. 0) ) Then
		Call Lib$Signal( FTP$_INVRECCHR )
		FTP$SET_TAPE = .False.
		Return
	    Else
		FTP$REC_PADCHAR = TMP$PADCHAR
	    End If
	End If
c
c	*** Check for the block pad character
c
	If ( CLI$Present( 'PAD_CHARACTER.BLOCK' ) ) Then
	    Call CLI$Get_Value('PAD_CHARACTER.BLOCK', String, Slen)
	    Read(String(:Slen),10) TMP$PADCHAR
	    If ( (TMP$PADCHAR .gt. 127 ) .or. (TMP$PADCHAR .lt. 0) ) Then
		Call Lib$Signal( FTP$_INVBLKCHR )
		FTP$SET_TAPE = .False.
		Return
	    Else
		FTP$BLK_PADCHAR = TMP$PADCHAR
	    End If
	End If
c
c	*** Get the block and record sizes
c
	TMP$BUFSIZ = FTP$BUFSIZ
	TMP$RECSIZ = FTP$RECSIZ
c
	If ( CLI$Get_Value('BLOCK_SIZE', String, Slen) )
	1	Read(String(:SLen),10) TMP$BUFSIZ
c
	If ( CLI$Get_Value('RECORD_SIZE', String, Slen) )
	1	Read(String(:Slen),10) TMP$RECSIZ
c
	If ( (TMP$BUFSIZ .lt. 14) .or. (TMP$BUFSIZ .gt. 65535) ) Then
	    Call Lib$Signal( FTP$_INVBLKSIZ )
	    FTP$SET_TAPE = .False.
	    Return
	Else If ( (TMP$RECSIZ .lt. 1) .or. (TMP$RECSIZ .gt. TMP$BUFSIZ) ) Then
	    Call Lib$Signal( FTP$_INVRECSIZ, %Val(1), %Val(TMP$BUFSIZ) )
	    FTP$SET_TAPE = .False.
	    Return
	Else If ( Mod( TMP$BUFSIZ, TMP$RECSIZ ) .ne. 0 ) Then
	    Call Lib$Signal( FTP$_RECNOTMULT )
	    FTP$SET_TAPE = .False.
	    Return
	Else
	    FTP$BUFSIZ = TMP$BUFSIZ
	    FTP$RECSIZ = TMP$RECSIZ
	End If
c
c	Thats it...
c
	Return
	End



	Subroutine FTP$LOAD_TABLE( A, B )
c
	Byte		A( 256 ),	B( 256 )
c
	Integer		I
c
	Do I = 1, 256
	    A( I ) = B( I )
	End Do
c
	Return
	End



	Subroutine FTP$READ_TABLE( Table, File, Status )
c
	Byte		Table( 16, 16 )
c
	Integer		Status
c
	Character	File*(*)
c
	Integer		I,		J,		IOS
c
	Open	(	Unit	= 3
	1	,	Name	= File
	1	,	Type	= 'OLD'
	1	,	ERR	= 300
	1	,	READONLY
	1	,	SHARED
	1	)
c
10	Format( 16Z3 )
c
	Do I = 1, 16
	    Read( 3, 10, Err=300, IOStat=IOS ) (Table( I, J ), J = 1, 16)
	End Do
c
	Status = .True.
	Return
c
300	Call ErrSns(I,J,K,L,M)
	Call Lib$Signal(%Val(M),%Val(3),%Val(L),File,%val(I))
	Status = .False.
	Return
	End



	Subroutine FTP$RELEASE_MEMORY( Buffer_Address, Amount )
c
	Integer		Buffer_Address,		Amount
c
	Integer		Mem_Status,		Lib$Free_VM
c
	External FTP$_ABORTING
c
	Mem_Status = Lib$Free_VM ( Amount, Buffer_Address )
	If ( .not. Mem_Status ) Then
	    Call Lib$Signal( %VAL(Mem_Status) )
	    Call Lib$Signal( FTP$_ABORTING, 'FTP$RELEASE_MEMORY' )
	    Call Exit
	End If
c
	Return
	End



	Subroutine FTP$GET_MEMORY ( Buffer_Address, Amount )
c
	Integer		Buffer_Address,		Amount
c
	Integer		Mem_Status,		Lib$Get_VM
c
	External FTP$_ABORTING
c
c	*** Allocate the memory
c
	Mem_Status = Lib$Get_VM ( Amount, Buffer_Address )
	If ( .not. Mem_Status ) Then
	    Call Lib$Signal( %Val(Mem_Status) )
	    Call Lib$Signal( FTP$_ABORTING, 'FTP$GET_MEMORY' )
	    Call Exit
	End If
c
	Return
	End



	Subroutine FTP$Process_Files( File_Spec, File_Count,
	1			      Array, Byt, Rec )
c
	Character	File_Spec*(*)
c
	Integer		File_Count,	Byt,	Rec
c
	Byte		Array( Byt, Rec )
c
	Include 'FTP$DEVINFO.FOR'
	Include '($SSDEF)'
c
	Integer		Lib$Find_File,		Find_Status
	Integer		Context,		Result_Length
	Integer		SkpFile,		Result
	Integer		Distance,		IOSB( 2 )
c
	Character*256	Result_Spec
c
	File_Count = 0
c
	Find_Status = Lib$Find_File
	1			(	File_Spec	! file-spec
	1			,	Result_Spec	! result-spec
	1			,	Context		! context
	1			,			! [default-spec]
	1			,			! [related-spec]
	1			,			! [stv-addr]
	1			,	2		! [user-flags]
	1			)
c
	If ( .not. Find_Status ) Call Lib$Signal( %Val(Find_Status) )
c
	Do While ( Find_Status )	
c
c	    *** Display File Name
c
	    Call FTP$Show_FileName( Result_Spec, Result_Length )
c
	    Call FTP$READ_FILE( Result_Spec( : Result_Length ),
	1			Array, Byt, Rec )
	    File_Count = File_Count + 1
c
	    Find_Status = Lib$Find_File
	1			(	File_Spec	! file-spec
	1			,	Result_Spec	! result-spec
	1			,	Context		! context
	1			,			! [default-spec]
	1			,			! [related-spec]
	1			,			! [stv-addr]
	1			,	2		! [user-flags]
	1			)
c
	End Do
c
	Call Lib$Find_File_End( Context )
c
	SkpFile = .True.
	Call FTP$WRITE_EOF( IOSB )
	Call FTP$WRITE_EOF( IOSB )
	Call FTP$SKIP( -2, SkpFile, Distance, Result )
c
	Return
	End



	Subroutine FTP$READ_FILE( File_Name, Buffer, Byt, Rec )
c
	Character	File_Name*(*)
c
	Integer		Byt,	Rec
c
	Byte		Buffer(Byt, Rec)
c
	Include 'FTP$FLAGS.FOR'
c
c	*** FTP messages
c
	External	FTP$_TRUNINREC
	External	FTP$_ABORTING
	External	FTP$_BADTRANS
	External	FTP$_OUTCNTS
c
	Integer		In_Size,	Trun_Flg,	IOSB( 2 )
	Integer		Record_Cnt,	Block_Cnt
c
10	Format( Q, <Byt>A1 )
c
c	*** Open the file
c
	Open	(	Unit		= 1
	1	,	Name		= File_Name
	1	,	Status		= 'OLD'
	1	,	Access		= 'Sequential'
	1	,	READONLY
	1	,	SHARED
	1	)
c
	Trun_Flg = .True.
	Block_Cnt = 0
	Record_Cnt = 0
c
	Do While (.True.)
c
		Do J = 1, Rec
c
		    Read(1, 10, End=500) In_Size,
	1		(Buffer(I,J),I=1,Min(Byt,In_size))
		    Record_Cnt = Record_Cnt + 1
		    If ( In_Size .lt. Byt ) Then
			Call FTP$PAD_RECORD( Buffer(1,J), In_Size, Byt)
		    Else If ( (Trun_Flg) .and. (In_Size .gt. Byt) ) Then
			Trun_Flg = .False.
			Call LIB$SIGNAL( FTP$_TRUNINREC )
		    End If
		End Do
c
		Call FTP$WRITE_BLOCK( Buffer, Byt, Rec )
		Block_Cnt = Block_Cnt + 1
	End Do
c
500	Close( Unit = 1 )
c
	If (( J .gt. 1 ) .or. (Block_Cnt .eq. 0)) Then
	    Do I = J, Rec
		Call FTP$PAD_BLOCK( Buffer(1,I), Byt)
	    End Do
	    Call FTP$WRITE_BLOCK( Buffer, Byt, Rec )
	    Block_Cnt = Block_Cnt + 1
	End If
c
	Call FTP$WRITE_EOF( IOSB )
c
	If ( FTP$LOG_FLG )
	1    Call Lib$Signal ( FTP$_OUTCNTS, %Val( 2 ),
	1			%Val( Record_Cnt ), %Val( Block_Cnt ) )
c
	Return
	End



	Subroutine FTP$PAD_RECORD( Buffer, Begin, Finish )
c
	Integer		Begin,		Finish
c
	Byte		Buffer( Finish )
c
	Include 'FTP$FLAGS.FOR'
c
	Do I = Begin+1, Finish
	     Buffer( I ) = FTP$REC_PADCHAR
	End Do
c
	Return
	End



	Subroutine FTP$PAD_BLOCK ( Buffer, Finish )
c
	Integer		Finish
c
	Byte		Buffer( Finish )
c
	Include 'FTP$FLAGS.FOR'
c
	Do I = 1, Finish
	     Buffer( I ) = FTP$BLK_PADCHAR
	End Do
c
	Return
	End



	Subroutine FTP$WRITE_BLOCK( Buffer, Byt, Rec )
c
	Integer		Byt,	Rec
c
	Byte		Buffer( Byt*Rec )
c
	Include 'FTP$FLAGS.FOR'
	Include '($IODEF)'
c
	Integer		FTP$WRITE_QIOW,		QIO_Status
	Integer		BufSiz,			Byte_Count
	Integer		Status
c
	BufSiz = Byt * Rec
c
	Call FTP$Translate ( Buffer, BufSiz )
c
	QIO_Status = FTP$WRITE_QIOW( Buffer, BufSiz,
	1				 Byte_Count, Status, )
c
	If ( .not. Status ) Call Lib$Signal( %Val(Status) )
c
	If ( Byte_Count .ne. BufSiz ) Call Lib$Signal( FTP$_BADTRANS,
	1			%Val(2), %Val(BufSiz), %Val(Byte_Count) )
c
	Return
	End



	Subroutine FTP$Show_FileName( File, Length )
c
	Character	File*(*)
c
	Integer		Length
c
	Include 'FTP$FLAGS.FOR'
c
c	*** FTP error messages
c
	External	FTP$_WORKING
c
	Length = Len(File)
c
	Do While ( File( Length: Length ) .le. ' ' )
	    Length = Length - 1
	End Do
c
10	Format ( ' ', A )
c
	If ( FTP$LOG_FLG )
	1	Call Lib$Signal( FTP$_WORKING, %Val(1), File(:Length) ) 
c
	Return
	End


