!*************************************************************************
!									 *
! © Copyright 2004 Hewlett-Packard Development Company, L.P.		 *
!									 *
! Confidential computer software. Valid license  from  HP  required  for *
! possession, use or copying. Consistent with  FAR  12.211  and  12.212, *
! Commercial Computer Software,  Computer  Software  Documentation,  and *
! Technical  Data  for  Commercial  Items  are  licensed  to  the   U.S. *
! Government under vendor's standard commercial license.		 *
!									 *
!*************************************************************************

!
! Module Name: PACKAGE_HEADER_FILES.TPU
! Author : Rajesh Mishra
! Creation Date : 08-26-91
! Version : 1.0
!
!	A Filter from C '.i' library files, containing function
!	prototypes, to LSE package definitions. The file name where the
!	routines reside are input from the user along with the package
!	name and the help library name. The output is a set of package
!	definitions for the library files. It is stored in a given output
!	file name. To determine how to produce '.i' files from '.h' files,
!	please read the ReadMe file.
!
! PORTABILITY ISSUES:
!
!	The purpose of this filter is to create UNIX library package
!	definitions. But, the result of this filter is a set of definitions
!	in CLI, not in the portable command language. Hence, this filter
!	may only be executed in a VMS LSE environment.
!
! CALLING SEQUENCE:
!
!	This file must be put into a buffer and executed to create a
!	TPU section file. Using this section file, the call may be made
!	to package_header_files. A series of prompts for specific data
!	will follow regarding the package definitions to be generator:
!
!		* Name of the package being defined
!		* Help library name (Supply '{tbs}' for default case)
!		* Output filename where the package definitions will be written
!		  (this filename must have a '.LSE' tag).
!		* Name of input header files -- This is a series of prompts
!		  for more than one header file. When no more header files
!		  need to be given, simply press the carriage return key.
!		  Recall that these header files have already been processed
!		  by a C pre-processor producing function proto-types for the
!		  routines and the parameters to be defined.
!

!
! Package_Header_Files :
!
!	Main TPU routine that is called to create a package. It is responsible
!	for prompting the user for needed information and storing the resulting
!	values. It calls the proper function that handles defining the routines
!	and parameters for all the function proto-types in a given file.
!

PROCEDURE Package_Header_Files

LOCAL
	input_file,			! Name of library file
	outfile,			! Name of file which will contain def.
	package_name,			! Name of package being created
	help_lib,			! Help library used by package
	old_buff,			! Temp buff ptr to swap buffers
	read_buff,			! Buffer containing library file 
	write_buff;			! Buffer containing package definitions

ON_ERROR
	IF Error = TPU$_DUPBUFNAME    ! Output buff name already exists.
	THEN write_buff := 0;
	ENDIF;
ENDON_ERROR

! Prompt user for info and collect it as variable values.
package_name := READ_LINE ('Package Name: ');
help_lib := READ_LINE ('Help Library: ');
old_buff := CURRENT_BUFFER;

! Until output file name given that is not a current buffer, prompt for input.
LOOP
	outfile := READ_LINE ('Output File for Package Definitions : ');
	write_buff := CREATE_BUFFER (outfile);
	EXITIF (write_buff <> 0);
	MESSAGE (outfile+' is not an acceptable output file name.');
ENDLOOP;

! Define a package for the given package name.
ERASE (write_buff);
DEFINE_PACKAGE (write_buff,package_name,help_lib);

! Loop that processes input files for function proto-types
LOOP
	input_file := READ_LINE ('Library file name : ');
	EXITIF (input_file = '');
	read_buff := CREATE_BUFFER (input_file,input_file);
	SET (NO_WRITE,read_buff);

	! Process file containing routines.
	PARSE_FILE (read_buff,write_buff,package_name,input_file);
	DELETE (read_buff);
	POSITION (old_buff);

	! Send message that input file has been processed.
	MESSAGE ('Routines and parameters in '+input_file+' have been defined.');
ENDLOOP;

! Close the output buffer containing package definitions and return.
WRITE_FILE (write_buff,outfile);
DELETE (write_buff);
POSITION (old_buff);
MESSAGE ('Package definitions have been completed.');
RETURN;

ENDPROCEDURE

!
!	Define_Package:
!
!	Output the PACKAGE Definition for the given package name. This
!	includes specifying the languages allowed, the help library for
!	the package, the topic-string for the package, and the TPU expansion
!	routines which will expand the routines and the parameters.
!

PROCEDURE Define_Package (output_buffer,package_name,library_name);
LOCAL
	prev_buff;

! Move to beginning of and initialize output write-buffer.
prev_buff := CURRENT_BUFFER;
POSITION (BEGINNING_OF (output_buffer));
SET (FORWARD, output_buffer);
ERASE (output_buffer);

! Print out package info.
COPY_TEXT ('DELETE PACKAGE "'+package_name+'"'); SPLIT_LINE;
COPY_TEXT ('DEFINE PACKAGE "'+package_name+'" -'); SPLIT_LINE;
COPY_TEXT ('	/LANGUAGE=C -'); SPLIT_LINE;
COPY_TEXT ('	/HELP_LIBRARY='+library_name+' -'); SPLIT_LINE;
COPY_TEXT ('	/TOPIC_STRING="'+package_name+'" -'); SPLIT_LINE;
COPY_TEXT ('	/ROUTINE_EXPAND="LSE$PKG_EXPAND_ROUT_" -'); SPLIT_LINE;
COPY_TEXT ('	/PARAMETER_EXPAND="LSE$PKG_EXPAND_PARM_"'); SPLIT_LINE;
SPLIT_LINE;

!   Return control to previous buffer.
POSITION (prev_buff);

ENDPROCEDURE

!
!	Routine_Definition :
!
!	Procedure which prints out a 'DEFINE ROUTINE'.  The parameter_list
!	is given as the argument buffer which contains all the parameter
!	names for this routine.
!	

PROCEDURE Routine_Definition (buffer_write,routine_name,num_parm,
			      parameter_list,package_name,header_file)

LOCAL
	curr_parm,			! Counter to keep track of function arg
	curr_param,			! String keeps param stated in func def
	last_buff;			! Temp buffer pointer to switch buffers

! Print out a routine definition
last_buff :=  CURRENT_BUFFER;
POSITION (buffer_write);
COPY_TEXT ('DELETE ROUTINE "'+routine_name+'" /PACKAGE = "'+package_name+'"');
SPLIT_LINE;
COPY_TEXT ('DEFINE ROUTINE "'+routine_name+'" -');
SPLIT_LINE;

! Loop to print out all the parameters of the routine
curr_parm := 0;
curr_param := '';
LOOP
	! Leave loop only when all parameters have been processed.
	EXITIF (curr_parm = num_parm);

	! Get next parm in buffer and specify it in the routine definition
	curr_param := NEXT_ARGUMENT(parameter_list);
	COPY_TEXT ('	"'+curr_param+'"');
	
	! The special case of a '...' argument is signalled by the
	! "additional parameters" parameter.
	IF (curr_param = 'additional parameters')
	THEN COPY_TEXT ('/OPTIONAL');
	ENDIF;

	! An address variable (pointer) is by REFERENCE.
	IF (SUBSTR(curr_param,LENGTH(curr_param),1) = '*')
	THEN COPY_TEXT ('/BY_REFERENCE');	! Ptr means by reference
	ELSE COPY_TEXT ('/BY_VALUE');
	ENDIF;

	! The last parameter does not end in a comma
	IF (curr_parm = (num_parm - 1))
	THEN COPY_TEXT (' -');
	ELSE COPY_TEXT (', -');
	ENDIF;
	SPLIT_LINE;

	! Update parameter count
	curr_parm := curr_parm + 1;

ENDLOOP;

! Finish up routine definition and return back SUCCESS
COPY_TEXT ('	/PACKAGE="'+package_name+'" -');
SPLIT_LINE;
COPY_TEXT ('	/DESCRIPTION="Library routine '+routine_name+' in '+header_file+'"');
SPLIT_LINE;
SPLIT_LINE;
POSITION (last_buff);
RETURN;

ENDPROCEDURE

!
! Parameter_Definition :
!
!	Procedure which prints out a 'DEFINE PARAMETER'. The only qualifier is
!	the package name which is given as an argument along with the parameter name.
!

PROCEDURE Parameter_Definition (buffer_write,parameter,package_name)
LOCAL
	last_buffer;

last_buffer := CURRENT_BUFFER;
POSITION (buffer_write);
COPY_TEXT ('DELETE PARAMETER "'+parameter+'" /PACKAGE = "'+package_name+'"');
SPLIT_LINE;
COPY_TEXT ('DEFINE PARAMETER "'+parameter+'" -');
SPLIT_LINE;
COPY_TEXT ('	/PACKAGE="'+package_name+'" -');
SPLIT_LINE;
SPLIT_LINE;
POSITION (last_buffer);

ENDPROCEDURE

!
! Parse_file:
!
!	Go through the input file and process the function
!	prototypes which reside in it. It returns only when
!	no more function proto-types are found in the input
!	file. It avoids the invalid function proto-type signal (-1)
!	by trying to find the next one.
!

PROCEDURE Parse_file (input_buff,output_buff,pack_name,in_filename)

LOCAL
	old_buffer;

! Initialize input file pointer to the beginning of the buffer
old_buffer := CURRENT_BUFFER;
POSITION (BEGINNING_OF (input_buff));
POSITION (old_buffer);

! Loop to process all functions in this read-buffer file.
LOOP
	! Check input-buffer pointer to make sure it is not at EOF.
	old_buffer := CURRENT_BUFFER;
	POSITION (input_buff);
	EXITIF (MARK(NONE) = END_OF (input_buff));
	POSITION (old_buffer);

	! Process a function proto-type (find it, then define it)
	IF PROCESS_FUNCTION (input_buff,output_buff,pack_name,in_filename) = 0
	THEN RETURN;
	ENDIF;

ENDLOOP;

ENDPROCEDURE

!
! Process_Function :
!
!	This routine is responsible for finding a function proto-type,
!	then defining its constituents as a routine with its parameters.
!	It first finds the function proto-type; then, validates it by
!	finding the function name. Then it prints out the routine and
!	parameter definitions making sure they are originals. The return
!	codes are as follows :
!
!			1	: Proto-type processed successfully.
!			0	: No more function proto-types in input file.
!			-1	: Invalid function proto-type.

PROCEDURE Process_Function (input_buff,out_buff,package_name,input_filename)
LOCAL
	temp_buff,
	arg_list,
	arg_buffer,
	func_name,
	curr_arg,
	curr_param,
	num_arguments;

! Create an argument buffer to hold the function's arguments
arg_buffer := CREATE_BUFFER ("arguments");
SET (NO_WRITE,arg_buffer);
ERASE (arg_buffer);

! Find a function proto-type. If none is found, then return NONE (0).
IF (FIND_ARGUMENT_NAMES (input_buff,arg_list,arg_buffer,num_arguments) = 0)
THEN
	DELETE (arg_buffer);
	RETURN (0);
ENDIF;

! Find the function name corresponding to the function proto-type.
! If FIND_FUNCTION_NAME determines the proto-type to be invalid, it
! returns a signal saying so.
func_name := FIND_FUNCTION_NAME (input_buff,arg_list);
IF (func_name = 0)
THEN
	FIND_END_FUNC (input_buff,arg_list);
	DELETE (arg_buffer);
	RETURN (-1);
ENDIF;

! If routine already defined, return back that it has been defined.
IF (ALREADY_DEFINED (func_name,'ROUTINE',out_buff) = 1)
THEN
	FIND_END_FUNC (input_buff,arg_list);
	DELETE (arg_buffer);
	RETURN (1);
ENDIF;

! Define a routine in the output buffer.
temp_buff := CURRENT_BUFFER;
POSITION (arg_buffer);
POSITION (BEGINNING_OF(arg_buffer));
POSITION (temp_buff);
ROUTINE_DEFINITION (out_buff,func_name,num_arguments,
		arg_buffer,package_name,input_filename);

! Define all the parameters corresponding to the defined routine.
POSITION (arg_buffer);
POSITION (BEGINNING_OF(arg_buffer));
POSITION (temp_buff);
curr_arg := 0;
LOOP
	! Exit if all parameters have been defined (or prev. defined).
	EXITIF (curr_arg = num_arguments);

	! Get next argument in the argument buffer and define it if
	! it has not been already defined.
	curr_param := NEXT_ARGUMENT (arg_buffer);
	IF (ALREADY_DEFINED (curr_param,'PARAMETER',out_buff) = 0)
	THEN PARAMETER_DEFINITION (out_buff,curr_param,package_name);
	ENDIF;

	! Update argument count.
	curr_arg := curr_arg + 1;

ENDLOOP;

! Clean up and return back a signal that the function proto-type has
! been processed successfully.
FIND_END_FUNC (input_buff,arg_list);
DELETE (arg_buffer);
RETURN (1);

ENDPROCEDURE

!
! Next_Argument:
!
!	Procedure which finds the next argument in the argument
!	list buffer to be displayed. It returns the argument as a
!	string. Since the argument buffer is a vertical list of
!	arguments, the next line is retrieved as an argument.
!

PROCEDURE Next_argument (arg_buff)
LOCAL
	hold_buffer,
	arg;

hold_buffer := CURRENT_BUFFER;
POSITION (arg_buff);
arg := CURRENT_LINE;
MOVE_VERTICAL (1);
POSITION (hold_buffer);
RETURN (arg);

ENDPROCEDURE

!
! Already_Defined:
!
!	Determines if a paramater or a routine has already been
!	defined. It looks through the output buffer for the given
!	routine (or paramater) definition. It returns a TRUE or a
!	FALSE depending on whether the definition has been found.

PROCEDURE Already_Defined (definition_name,type_of_name,definition_buff)

LOCAL
	hold_buff,
	search_result;

ON_ERROR
	POSITION (END_OF (definition_buff));
	POSITION (hold_buff);
	RETURN FALSE;			! Defintion not found.
ENDON_ERROR;

! Search for the definition in the output buffer
hold_buff := CURRENT_BUFFER;
POSITION (BEGINNING_OF(definition_buff));
search_result := SEARCH ('DEFINE '+type_of_name+' "'+definition_name+
			'"',FORWARD,EXACT);

! Restore old buffer and return that the definition is found.
POSITION (END_OF (definition_buff));
POSITION (hold_buff);
RETURN TRUE;

ENDPROCEDURE

!
! Find_Argument_Names:
!
!	Find the next function proto-type by staying in a loop
!	until a valid one is found or no more valid ones are
!	found. The arguments of the function prototype will be
!	stored in the given argument buffer. The number of arguments
!	that were found will also be returned. The range for the
!	function prototype is also remembered for future reference.
!

PROCEDURE Find_Argument_Names (read_buffer,arg_names,argument_buffer,numargs)

! Loop to locate the next function prototype
LOOP
	! Search for a pair of paren that may be a prototype
	arg_names := FIND_PAREN (read_buffer);

	! If return value is 0, signal back "File has no more prototypes"
	IF arg_names = 0
	THEN RETURN (0);
	ENDIF;

	! Collect the arguments in the prototype in a buffer
	ERASE (argument_buffer);
	numargs := COLLECT_ARGUMENTS (read_buffer,arg_names,
					argument_buffer);

	! Unless function prototype is invalid, return back that a
	! prototype was found. Otherwise, stay in loop that searches
	! for a correct one.
	IF (numargs <> -1)
	THEN RETURN (1);
	ENDIF;

ENDLOOP;

ENDPROCEDURE

!
! Find_Paren:
!
!	Search for set of parentheses that may locate a function proto-type.
!	If none are found, then the routine signals back that it is finished
!	processing the input file. Otherwise, the range found is returned.
!

PROCEDURE Find_Paren (inbuff)

LOCAL
	hold_buff,		! Temp buffer ptr to swap buffers to inputfile.
	paren_region,		! Search pattern equivelant to '(...)'
	nesting_level,		! Counter to keep track of parenthesis nesting level.
	found_paren;		! Result of searching for '(...)'

ON_ERROR
	found_paren := 0;			! Search not successful in locating prototype
ENDON_ERROR

! Go to the input file and look for a function prototype
hold_buff := CURRENT_BUFFER;
POSITION (inbuff);
found_paren := SEARCH ('(',FORWARD,NO_EXACT);

! If no more function proto-types found, then file has been processed
IF found_paren = 0
THEN
	POSITION (hold_buff);
	RETURN (0);
ENDIF;

! Go through function prototype and check to make sure it is valid.
POSITION (found_paren);
nesting_level := 1;
LOOP
	MOVE_HORIZONTAL (1);
	IF (CURRENT_CHARACTER = '(')
	THEN nesting_level := nesting_level + 1;
	ENDIF;
	IF (CURRENT_CHARACTER = ')')
	THEN nesting_level := nesting_level - 1;
	ENDIF;
	EXITIF (nesting_level = 0);
ENDLOOP;

! So far the function prototype has been found to be valid, so return it.
paren_region := CREATE_RANGE (BEGINNING_OF(found_paren),MARK(NONE),NONE);
POSITION (hold_buff);
RETURN (paren_region);

ENDPROCEDURE

!
! Collect_Arguments:
!
!	This routine collects all the arguments in the
!	found function prototype in the argument buffer.
!	If the found function prototype is invalid, it
!	returns a -1, otherwise it returns the number of
!	arguments collected.
!

PROCEDURE Collect_Arguments (func_buff,argument_list,store_buff)
LOCAL
	old_buff,		! Temp buffer ptr to switch to inputfile
	curr_arg,		! Current argument name
	ret_val,		! Return value from GET_ARG -1,0,or {ret_arg}
	ret_arg,		! Stored data type to be inserted into buffer
	white_space,		! White space pattern
	arg_cnt;		! Total number of arguments so far.

ON_ERROR
	null_arg := 0;		! If search failed, set range to zero
ENDON_ERROR

! Pattern for white space between tokens to be searched
white_space := LINE_END | SPANL (' '+'	');

! Go to beginning of argument list (and one more for skipping '(')
old_buff := CURRENT_BUFFER;
POSITION (func_buff);
POSITION (BEGINNING_OF(argument_list));
MOVE_HORIZONTAL (1);

! Search for null argument list.
null_arg := SEARCH ((')'|(white_space&')')), FORWARD);
IF (null_arg <> 0)
THEN
	IF (MARK(NONE) = BEGINNING_OF(null_arg))  ! Null arg list found.
	THEN
		POSITION (END_OF(argument_list));
		RETURN (0);
	ENDIF;
ENDIF;

! Loop that collects arguments and stores them in a buffer.
arg_cnt := 0;
LOOP
	! Get an argument
	ret_val := GET_ARG(ret_arg);		! Get an argument.

	! If illegal argument found, return the signal that it is one.
	IF (ret_val = -1)
	THEN RETURN (-1);
	ENDIF;

	! Leave loop if argument is a null argument list
	EXITIF (SUBSTR(ret_arg,1,LENGTH(ret_arg)) = 'void');

	! If optional parameters, then insert a special parameter called
	! "additional parameters"; otherwise, store the extracted argument
	IF (SUBSTR(ret_arg,1,LENGTH(ret_arg)) = '...')
	THEN INSERT_ARGUMENT ("additional parameters",store_buff);
	ELSE INSERT_ARGUMENT (ret_arg,store_buff);
	ENDIF;

	! Update argument count.
	arg_cnt := arg_cnt + 1;

	! Leave loop if end-of-argument-list encountered.
	EXITIF (ret_val = 0);

ENDLOOP;

! Restore previous status and return number of arguments collected
POSITION (END_OF (argument_list));
POSITION (old_buff);
RETURN (arg_cnt);

ENDPROCEDURE

!
! Insert_Argument:
!
!	Insert an argument name into the argument buffer. The routine
!	simply copies the given word into the argument buffer (insert_buffer)
!	and appends it with a linefeed (for next argument).
!

PROCEDURE Insert_Argument (insert_word, insert_buffer)
LOCAL
	temp_hold_buff;

temp_hold_buff := CURRENT_BUFFER;
POSITION (insert_buffer);
COPY_TEXT (insert_word);
SPLIT_LINE;
POSITION (temp_hold_buff);

ENDPROCEDURE

!
!	Get_Arg:
!
!		Get the next argument in any argument list. An
!		argument list may look like :
!			arg1,arg2,...,argN)
!		Where argi is a doublet: a valid C data type (including
!		previously defined structures that had been typedefined)
!		followed by a variable name. The argument may also be
!		just "void" (in this case, null arguments is signalled
!		back) or "..." (in such a case, we return '...' to
!		signal optional arguments).
!
!		The return value is one of the following:
!			-1 : Error in parsing through argument list.
!			0 : End of argument list encountered.
!			{return value} : Arg found, so continue parsing.
!

PROCEDURE Get_Arg (ret_arg)
LOCAL
	white_space,			! Pattern for white space between tokens.
	separator,			! Argument separator (',' or ';')
	number_pattern,			! Pattern for a whole number
	identifier,			! Pattern for a word
	pointer,			! Any number of '*' to specify address
	atomic_data_type,		! Fundamental data type.
	size_data_type,			! 'long' or 'short'
	data_type_modifier,		! Storage class specifier
	paren_set,			! Pattern for set of parentheses (if function call)
	variable_pattern,		! Pattern for a variable parameter (identifier or array)
	data_type_pattern,		! Generic data type without modifiers, qualifiers
	func_call,			! Pattern for function call as an argument
	form_parm,			! Pattern for a formal parameter
	data_type_with_form,		! Data type with its formal parameter.
	data_type_pointer,		! Pattern if qualifer_pattern after data_type_pattern
	arg_pattern,			! Entire pattern for an argument.
	search_pattern,			! Final search pattern for argument with its separator
	array_val,			! Return value for "[{number}]" in variable parameter
	func_arg,			! Return value for function call as argument
	argument;			! Range found after search.
ON_ERROR				! Search had failed.
	argument := 0;
ENDON_ERROR

! Define patterns to form search pattern for argument

	white_space := ANCHOR & SPANL (' '+'	');
	separator := ANCHOR & ANY(',)');
	number_pattern := ANCHOR & SPAN ('0123456789');
	identifier := ANCHOR &
	   SPAN('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$');
	pointer := ANCHOR & SPANL (' '+'	'+'*');
	atomic_data_type := ANCHOR & ('void'|'int'|'char'|'float'|'double');
	size_data_type := ANCHOR & ('long'|'short');
	data_type_modifier := ANCHOR &
		('const' | 'static' | 'register' | 'extern' | 'volatile');

	! Pattern for a parentheses grouping
	paren_set := ANCHOR & ((white_space & '(' & SCANL(')') & ')') |
				('()') |
				('(' & SCANL(')') & ')'));

	! Pattern for the formal parameter (includes array declaration)
        variable_pattern := ANCHOR  &
	   ((identifier & (('[' & (''|white_space|number_pattern) & ']'))@array_val) |
	   identifier);

	! Patten for generic data type
	data_type_pattern := ANCHOR &
		(('struct' & white_space & identifier) |	! Structure
		('union' & white_space & identifier) |		! Union
		('unsigned'&white_space&size_data_type&white_space&atomic_data_type) |
		('unsigned' & white_space & atomic_data_type) |
		('unsigned' & white_space & size_data_type) |
		(size_data_type & white_space & atomic_data_type) |
		 atomic_data_type | size_data_type | 'unsigned' |
		 identifier);

	! Pattern for a formal parameter that is a pointer to a function
	func_call := ANCHOR &
			(((identifier&paren_set)@func_arg) |
			(('('&pointer&identifier&white_space&')'&paren_set)@func_arg) |
			(('('&pointer&identifier&')'&paren_set)@func_arg));

	! Formal parameter as a variable or a function with arguments
	form_parm := ANCHOR & (variable_pattern | func_call);
	
	! Generic pattern for a data type with its formal parameter
	data_type_with_form := ANCHOR &
		((((data_type_pattern&white_space&pointer)@ret_arg)&form_parm) |
		(((data_type_pattern&pointer)@ret_arg)&white_space&form_parm) |
		((data_type_pattern@ret_arg)&white_space&form_parm));

	! Possible pattern if qualifier after data type
	data_type_pointer := ANCHOR &
		(((data_type_pattern&white_space&pointer)@ret_arg) |
		((data_type_pattern&pointer)@ret_arg) |
		(data_type_pattern@ret_arg));

	! Pattern for an entire argument
	search_pattern := ANCHOR & (data_type_with_form |
		(data_type_modifier&white_space&data_type_with_form) |
		(data_type_pointer&white_space&data_type_modifier&white_space&form_parm) |
		('void'@ret_arg) |
		('...'@ret_arg));

	! Pattern for an argument plus any possible argument separators
	arg_pattern := ANCHOR &
		((white_space&search_pattern&white_space&separator) |
		(white_space&search_pattern&separator) |
		(search_pattern&separator) |
		(search_pattern&white_space&separator));

! Search for argument identifier.
argument := SEARCH (arg_pattern,FORWARD,EXACT);

! Tag on function call if pointer to a function is the formal argument
IF func_arg <> 0
THEN ret_arg := CREATE_RANGE (BEGINNING_OF(ret_arg),END_OF(func_arg),NONE);
ENDIF;

! Tag on array index if formal parameter is an array
IF array_val <> 0
THEN ret_arg := CREATE_RANGE (BEGINNING_OF(ret_arg),END_OF(array_val),NONE);
ENDIF;

! If Search failed, bad arg list.
IF (argument = 0) THEN RETURN (-1);
ENDIF;

! Jump over argument for next argument.
POSITION (END_OF (argument));

! Return from routine with appropriate value
IF (CURRENT_CHARACTER = ')')
THEN
	RETURN(0);		! End of argument list encountered.
ELSE
	MOVE_HORIZONTAL (1);	! Jump over ','
	RETURN(ret_arg);	! Continue parsing argument list.
ENDIF;

ENDPROCEDURE

!
!	Find_Function_Name:
!		Find the name of the function given where the
!		function parameter list is (func_parms). Go
!		back one char and reverse search for identifier
!		pattern.
!

PROCEDURE Find_Function_Name (read_buffer,func_parms)
LOCAL
	white_space,		! Pattern for separating words.
	identifier,		! String of characters that constitute a word.
	pointer,		! Pattern for pointer to a variable/function.
	Temp_old_buff,		! Temp buffer ptr to switch to input file.
	func_name,		! Name of function found and returned.
	found_func_name,	! Range resulting from searching for name.
	func_name_pattern;	! Search pattern for searching for name.
ON_ERROR
	found_func_name := 0;	! Search failed for function name
ENDON_ERROR

! Establish patterns to create search pattern.
white_space := LINE_BEGIN | LINE_END | SPANL(' '+'	');
identifier := ANCHOR &
	SPAN('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$');
pointer := ANCHOR & SPANL (' '+'	'+'*');
func_name_pattern :=
		((white_space&pointer&(identifier@func_name)&white_space) |
		(white_space&pointer&(identifier@func_name)) |
		(white_space&(identifier@func_name)&white_space) |
		(white_space&(identifier@func_name)));

! Switch to input file at the beginning of the parameter list
Temp_old_buff := CURRENT_BUFFER;
POSITION (read_buffer);
POSITION (BEGINNING_OF(func_parms));
MOVE_HORIZONTAL (-1);

! Search for the function name. Should be an identifier right before current position.
found_func_name := SEARCH (func_name_pattern,REVERSE,EXACT);

! Restore old buffer
POSITION (Temp_old_buff);

! Return back from routine with appropriate value
IF (found_func_name = 0)
THEN
	MESSAGE ('No function name found');
	RETURN (0);
ELSE
	RETURN (SUBSTR(func_name,1,LENGTH(func_name)));
ENDIF;

ENDPROCEDURE

!
!	Find_End_Func:
!		This procedure goes to the end of the function given
!		where the function parameter list is. It simply goes
!		to the end of the function parameter list.
!

PROCEDURE Find_End_Func (inbuffer,func_parm_list)
LOCAL
	prev_buff;

prev_buff := CURRENT_BUFFER;
POSITION (inbuffer);
POSITION (END_OF (func_parm_list));
POSITION (prev_buff);
RETURN;

ENDPROCEDURE