MODULE TESTFILE ( main=testfile,	!
		IDENT = '01'
		) =
BEGIN

!
!			  Free software BY
!		Project Software & Development, Inc.
!
! This software is furnished for free and may be used and  copied as
! desired. This software or  any  other copies  thereof may be provided
! or otherwise made available to any other person.  No title to and
! ownership of  the  software  is  hereby transferred or allowed. 
!
! The information in this software is subject to change  without  notice
! and  should  not  be  construed  as  a commitment by PROJECT SOFTWARE
! AND DEVELOPMENT, INC.
!
! PROJECT SOFTWARE assumes no responsibility for the use or  reliability  
! of this software on any equipment whatsoever.
!
!	Project Software & Development, Inc.
!	14 Story St.
!	Cambridge, Ma. 02138
!	617-661-1444
!

!++
! FACILITY:
!
! ABSTRACT: Provides the testfile command as is in RSX11M.
!
!
! ENVIRONMENT: Vax/Vms 1.6
!
! AUTHOR: M. Erik Husby	, CREATION DATE: March 1980
!
! MODIFIED BY:
!
! 	, : VERSION
! 01	- 
!--
!
! TABLE OF CONTENTS:
!
! LITERALS:
!
!
! INCLUDE FILES:
!
Library 'SYS$LIBRARY:STARLET';
Library 'SYS$LIBRARY:CLIMAC';
!
! Macros
!
Macro 
!
!	define offsets into cli_service_request block
!
	sym_naml_off= 4,0,16,0 %,
	sym_namp_off = 8,0,32,0 %,
	sym_vall_off = 12,0,16,0 %,
	sym_valp_off = 16,0,32,0 %,
!
!	Macro to form a descriptor block
!
	desc[] = %charcount(%remaining),
		uplit byte(%remaining) %;
!
! OWN STORAGE:
!
own 
!
!	output string descriptor
!
	out_desc : block[dsc$k_s_bln,byte],
	code_buf : vector[ch$allocation(10)],
!
!	testfile filename	
!
	tf_filename : vector[ch$allocation(nam$c_maxrsslcl)],
	tf_esa : vector[ch$allocation(nam$c_maxrsslcl)],
	tf_rsa : vector[ch$allocation(nam$c_maxrsslcl)],
!
!	file control blocks
!
	tf_nam: $nam(esa=tf_esa,	! file name block for the 
		ess=nam$c_maxrsslcl,	! file to be tested.
		rsa=tf_rsa,		! resulting filename
		rss=nam$c_maxrsslcl),
	tf_fab: $fab(fna=tf_filename,	! file attribute block for the
		fop=<nam>,
		nam=tf_nam),
!
!	get command line block
!
	get_cmd_line : $clireqdesc(rqtype=getcmd),
	def_sym_desc : block[cli$k_reqdesc,byte];
!
bind
!
	file_spec_sym =uplit(desc('FILE_SPEC')),
	file_code_sym =uplit(desc('FILE_CODE')),
	code_fmt_desc = uplit(desc('%X!XL')),
	tf_filename_ptr = tf_filename,	! pointer to initial filename
	tf_esa_ptr = tf_esa;		! pointer to expanded filename
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
	sys$cli : addressing_mode(absolute), ! get command line routine
	lib$put_output : addressing_mode(absolute); ! output line routine
	;		!

ROUTINE testfile : NOVALUE =	!

!++
! FUNCTIONAL DESCRIPTION: Performs a testfile command.
!	Given a filename, it does a search to determine the complete
!	file specification and file status.
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	On input, the command line contains a file specification.
!
! IMPLICIT OUTPUTS:
!
!	On completion the symbol "FILE_SPEC" is set to 
!	the complete file specification.
!	And the symbol "FILE_CODE" is set to the RMS file status code.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN
	local msglen : word,
		temp;
!
!	Get the command line;
!
	sys$cli(get_cmd_line);
!
!	Move the filename to the file_specification buffer;
!
	ch$move(.get_cmd_line[cli$w_rqsize],
		.get_cmd_line[cli$a_rqaddr],
		tf_filename_ptr);
!
!	Do a parse and then the search.
!
	tf_fab[fab$b_fns]=.get_cmd_line[cli$w_rqsize]; ! set size of filename
	$parse(fab=tf_fab);
	$search(fab=tf_fab);
!
!	define the symbol "FILE_SPEC" as the filename
!	depending on whether or not the file was found.
!
	if (.tf_fab[fab$l_sts] and sts$m_severity) eql sts$k_success then
		begin
		def_sym_desc[sym_vall_off] = .tf_nam[nam$b_rsl];
		def_sym_desc[sym_valp_off] = .tf_nam[nam$l_rsa];
		end
	else
		begin
		def_sym_desc[sym_vall_off] = .tf_nam[nam$b_esl];
		def_sym_desc[sym_valp_off] = .tf_nam[nam$l_esa];
		end;
	def_sym_desc[cli$w_servcod] = cli$k_deflocal;
	def_sym_desc[cli$b_rqtype] = cli$k_cliserv;
	def_sym_desc[sym_naml_off] = .file_spec_sym;
	def_sym_desc[sym_namp_off] = .(file_spec_sym+4);
	sys$cli(def_sym_desc);

!
!	Define the symbol "FILE_CODE" as the RMS file status code
!	as a hexadecimal string (similar to $STATUS).
!
	out_desc[dsc$b_class] = dsc$k_class_s;
	out_desc[dsc$b_dtype] = dsc$k_dtype_t;
	out_desc[dsc$w_length] = 10;
	out_desc[dsc$a_pointer] = code_buf;
	$faol(ctrstr =code_fmt_desc,
		outlen=msglen,
		outbuf=out_desc,
		prmlst=%ref(.tf_fab[fab$l_sts]));
	def_sym_desc[sym_naml_off] = .file_code_sym;
	def_sym_desc[sym_namp_off] = .(file_code_sym+4);
	def_sym_desc[sym_vall_off] = .msglen;
	def_sym_desc[sym_valp_off] = code_buf;
	sys$cli(def_sym_desc);
	
!
!	exit with normal status
!
	$exit(code=ss$_normal);

    END;			! end of testfile

END				!End of module
ELUDOM