!++
! FILENAME: EVEDT_BUILD.TPU 
! FUNCTION: This procedure will build the new EVEDT.TPU$SECTION. It is 
!           the EVE$BUILD supplied by DEC under TPU V2.0 but has been 
!           modified such that the screen output is also sent to a .LOG 
!           file when /DISPLAY is specified on the command line.
! AUTHOR:   DEC, Steven K. Shapiro
!           (C) Copyright SKS Enterprises, Austin TX. All Rights Reserved.
!
!           The format, structure and contents of this file are the sole      
!           property  of Steven K. Shapiro  and are  copyrighted to  SKS
!           Enterprises, Austin Texas. 
!           
!           The information may be freely distributed, used and modified
!           provided  that the  information in this  header block is not 
!           changed, altered, disturbed or modified in any way.                 
!
! DATE:     13-NOV-1988 Original.
! HISTORY:  -<( 11-NOV-1988 16:58:14.55 )>- current.
! CONTENTS: eve$$build
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure eve$$build			! Main-line build routine

local   build_buffer,		! Buffer compilations happen in
	file_name,		! File name and type of current file
	file_spec,		! File spec from the master file
	dump_buffer,		! Buffer to extract TPU$INIT_PROCEDURE through
	init_pattern,		! Pattern to match the whole TPU$INIT_PROCEDURE
	init_code,		! Range containing the TPU$INIT_PROCEDURE
	init_file,		! File the automatically generated code goes in
	last_procedure,		! Pointer to the last endprocedure statement
	last_arg,		! Pointer to the last argument declaration
	listing_buffer,		! Buffer to build the listing in
	listing_file,		! Name of file to write listing to
	listing_locale,		! Directory to write the listings to
	master_buffer,		! Buffer containing master file
	master_file,		! Master file from DCL command line
	master_line,		! Current line from the master file
	message_file,		! Name of file to write message buffer to
	build_message_window,	! Window to message buffer (/DISPLAY only)
	source_file_default,	! Source file default name
	product_name,		! Name of the product being built
	product_version,	! Version string for the product
	product_ident,	        ! Ident string for the product
	version_file,		! Name of file containing the product version
	build_time,		! String containing the time the build started
	found_synonym,		! Boolean if synonym already exists
	the_command,		! Copy of command for synonym
	section_file,		! File-spec to write the section file to
	space_pos,		! Position of space in expand_name variable
	temp,			! Guess...
	temp_buffer,		! Scratch buffer.
	the_code,		! Trailing executable statements, if any
	the_end,		! Gets end_of(build_buffer)
	the_length,		! The length of the_names
	the_name,		! Individual names within the_names
	the_names,		! Return value from expand_names
	array_count,		! Elements created in synonym_array + 1
	module_idents,		! List (from expand name) of known idents
	parser_flags,		! List of all parser routine flags
	module_pre_inits,	! List of all pre-inits
	module_inits,		! List of all inits
	declare_synonyms,	! List of all declare_synonyms
	synonym_inits,		! List of all synonym_inits
	exit_handlers,		! List of all exit_handlers
	quit_handlers,		! List of all quit_handlers
	status_fields,		! List of status-line fields
	the_program,		! Compiled version of the_code
	white_space,		! Space, and tab used to build patterns
	facility,		! Help facility string
	space_index,		! Index temp variable
	save_command;		! Save command to execute

constant   eve$kt_format_module_ident := "*_module_ident";
constant   eve$kt_format_enable_parser := "eve$x_enable_parser_";
constant   eve$kt_format_pre_init := "*_module_pre_init";
constant   eve$kt_format_module_init := "*_module_init";
constant   eve$kt_format_status_field := "*_status_field";
constant   eve$kt_format_declare_synonym := "*_declare_synonym";
constant   eve$kt_format_synonym_init := "*_synonym_init";
constant   eve$kt_format_exit_handler := "*_exit_handler";
constant   eve$kt_format_quit_handler := "*_quit_handler";

!
!	Error handler -- All errors are fatal except "String not found",
!			 "No names expanded", and "Multiple names expanded"
!

on_error
    [TPU$_STRNOTFOUND]:
    [TPU$_NONAMES]:
    [TPU$_MULTIPLENAMES]:
    [OTHERWISE]:
	message ("");
	message (error_text);
	message ("");
	return (2);
endon_error;

set (SUCCESS, OFF);
set (MESSAGE_FLAGS, 1);
dump_buffer := 0;

! insure eve$$x_synonym_array exists (none exists if /SECTION= not specified)

if get_info (eve$$x_synonym_array, "type") <> ARRAY
then
    eve$$x_synonym_array := create_array;
endif;

if eve$defined_procedure ("eve$$build_module_idents")
then
    module_idents := execute ("on_error" +
			      " return (''); " +
			      "endon_error " +
			      " return eve$$build_module_idents");
else
    module_idents := expand_name (eve$kt_format_module_ident, ALL);
    if module_idents <> ""
    then
	module_idents := module_idents + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_parser_flags")
then
    parser_flags := execute ("on_error" +
			     " return (''); " +
			     "endon_error " +
			     " return eve$$build_parser_flags");
else
    parser_flags := expand_name (eve$kt_format_enable_parser, VARIABLES);
    if parser_flags <> ""
    then
	parser_flags := parser_flags + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_module_pre_inits")
then
    module_pre_inits := execute ("on_error" +
				 " return (''); " +
				 "endon_error " +
				 " return eve$$build_module_pre_inits");
else
    module_pre_inits := expand_name (eve$kt_format_pre_init, PROCEDURES);
    if module_pre_inits <> ""
    then
	module_pre_inits := module_pre_inits + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_module_inits")
then
    module_inits := execute ("on_error" +
			     " return (''); " +
			     "endon_error " +
			     " return eve$$build_module_inits");
else
    module_inits := expand_name (eve$kt_format_module_init, PROCEDURES);
    if module_inits <> ""
    then
	module_inits := module_inits + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_status_fields")
then
    status_fields := execute ("on_error" +
			      " return (''); " +
			      "endon_error " +
			      " return eve$$build_status_fields");
else
    status_fields := expand_name (eve$kt_format_status_field, PROCEDURES);
    if status_fields <> ""
    then
	status_fields := status_fields + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_declare_synonyms")
then
    declare_synonyms := execute ("on_error" +
				 " return (''); " +
				 "endon_error " +
				 " return eve$$build_declare_synonyms");
else
    declare_synonyms := expand_name (eve$kt_format_declare_synonym, PROCEDURES);
    if declare_synonyms <> ""
    then
	declare_synonyms := declare_synonyms + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_synonym_inits")
then
    synonym_inits := execute ("on_error" +
			      " return (''); " +
			      "endon_error " +
			      " return eve$$build_synonym_inits");
else
    synonym_inits := expand_name (eve$kt_format_synonym_init, PROCEDURES);
    if synonym_inits <> ""
    then
	synonym_inits := synonym_inits + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_exit_handlers")
then
    exit_handlers := execute ("on_error" +
			      " return (''); " +
			      "endon_error " +
			      " return eve$$build_exit_handlers");
else
    exit_handlers := expand_name (eve$kt_format_exit_handler, PROCEDURES);
    if exit_handlers <> ""
    then
	exit_handlers := exit_handlers + " ";
    endif;
endif;

if eve$defined_procedure ("eve$$build_quit_handlers")
then
    quit_handlers := execute ("on_error" +
			      " return (''); " +
			      "endon_error " +
			      " return eve$$build_quit_handlers");
else
    quit_handlers := expand_name (eve$kt_format_quit_handler, PROCEDURES);
    if quit_handlers <> ""
    then
	quit_handlers := quit_handlers + " ";
    endif;
endif;

!
!	Set all buffers that exist when we start up to be NO-WRITE. This
!	should only happen if we were started /SECTION, which may cause
!	other problems.
!
temp_buffer := get_info (BUFFER, "first");
loop
    exitif temp_buffer = 0;
    set (NO_WRITE, temp_buffer);
    temp_buffer := get_info (BUFFER, "next");
endloop;

temp_buffer := create_buffer ("Temp buffer");
set (NO_WRITE, temp_buffer);

white_space := " " + ascii (9);
init_pattern := "procedure" + spanl (white_space) + "tpu$init_procedure";

!
!	Parse the command line.
!
!	In /DISPLAY make sure there is a message buffer & window.
!	In /NODISPLAY make sure there isn't.
!
if get_info (COMMAND_LINE, "display")
then
    message("/DISPLAY specified");
    if get_info (tpu$x_message_buffer, "type") <> BUFFER
    then
        message("Building message buffer.");
	tpu$x_message_buffer := create_buffer ("Message Buffer");
	set (SYSTEM, tpu$x_message_buffer);
	set (EOB_TEXT, tpu$x_message_buffer, "");
	build_message_window := create_window (1, 24, ON);
	map (build_message_window, tpu$x_message_buffer);
	set (PROMPT_AREA, 24, 1, NONE);
    endif;
else
    message("/NODISPLAY specified");
    tpu$x_message_buffer := 0;
endif;

!
!	The DCL command line parameter is the name of the product.
!	From it we get the name of master and version [and section] files.
!	If there is none, ask and quit if there is no answer.
!
product_name := get_info (COMMAND_LINE, "file_name");
if (product_name = "")
then
    product_name := read_line ("Product name: ");
endif;

if (product_name = "")
then
    return (1);
endif;

master_file := product_name + "_MASTER.FILE";
version_file := product_name + "_VERSION.DAT";

if (file_search (master_file) = "") or
    (file_search (version_file) = "")
then
    master_file := product_name + "$MASTER.FILE";
    version_file := product_name + "$VERSION.DAT";

    if (file_search (master_file) = "") or
	(file_search (version_file) = "")
    then
	message ("Can't find MASTER and VERSION files.");
	return (2);
    endif;
endif;

source_file_default := product_name;
product_name := file_parse (product_name, "", "", NAME);
!
!	The /OUTPUT qualifier gives us the name of the section file.
!	If none is specified, ask with a default of the product name.
!

section_file := get_info (COMMAND_LINE, "output_file");
if (section_file = "")
then
    section_file := read_line ("Section file name [default = product name " +
			       product_name + "]: ");
    if (section_file = "")
    then
	message ("Using default section file name = " + product_name +
		 "...");
	section_file := "sys$disk:[]" + product_name;
    endif;
endif;

edit (section_file, TRIM, UPPER);

if (substr (section_file, 1, 5) = "EXE$:")
then
    listing_locale := "MAP$:";
else
    listing_locale := "";
endif;

section_file := file_parse (section_file, "sys$disk:[].TPU$SECTION",
			    product_name);

!
!	The listing file name is the same as the section file, with a ".LIST"
!	file type.
!
listing_file := file_parse (".LIST", listing_locale, section_file);
listing_buffer := create_buffer ("Listing buffer");
set (OUTPUT_FILE, listing_buffer, listing_file);
init_file := file_parse (".INIT", listing_locale, section_file);
!
!	Creaate a log file from the message buffer
!
if tpu$x_message_buffer <> 0
then              
    message ("Creating .LOG file");
    message_file := file_parse (listing_locale + ".LOG", section_file);
    set (OUTPUT_FILE, tpu$x_message_buffer, message_file);
endif;
!
!	Create the major buffers.
!
master_buffer := create_buffer ("Master file", master_file);
set (NO_WRITE, master_buffer);
build_buffer := create_buffer ("Build Buffer");
set (NO_WRITE, build_buffer);
tpu$x_show_buffer := create_buffer ("Show Buffer");
set (NO_WRITE, tpu$x_show_buffer);

!
!	Get the version number.
!

position (temp_buffer);
read_file (version_file);
position (beginning_of (temp_buffer));
temp := current_line;
product_ident := substr (temp, 1, length (temp));
erase (temp_buffer);
build_time := fao ("!%D", 0);
if substr (build_time, 1, 1) = " "
then
    build_time := "0" + substr (build_time, 2, length (build_time));
endif;
product_version := product_ident + " " +
		   substr (build_time, 8, 4) + "-" +
		   fao ("!2ZL",
!** internationalize the following:
			index ("  JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",
			       substr (build_time, 4, 3)) / 3) + "-" +
		   substr (build_time, 1, 2) + " " +
		   substr (build_time, 13, 5);
!
!	Print out the heading for the listing file.
!
position (listing_buffer);
copy_text (fao ("!15AS            !23AS           EVE$BUILD !8AS",
		product_name, build_time, eve$build_module_ident));
split_line;
split_line;
copy_text ("Master file  = " + get_info (master_buffer, "file_name"));
split_line;
copy_text ("Section file = " + section_file);
split_line;
copy_text ("Listing file = " + listing_file);
split_line;
copy_text ("Init file    = " + init_file);
split_line;

message (create_range (beginning_of (listing_buffer),
		       end_of (listing_buffer),
		       NONE));

split_line;
copy_text ("Product Name                    Version");
split_line;
copy_text ("------------                    -------");
split_line;
split_line;
copy_text (fao ("!31AS !AS", product_name, product_version));
split_line;
split_line;
copy_text ("-------- Source Module Synopsis --------");
split_line;
split_line;
temp := get_info (COMMAND_LINE, "section_file");
if temp <> ""
then
    temp := file_parse (temp, "sys$share:tpu$section.tpu$section");
    copy_text (fao ("Built under existing section file: !AS", temp));
    split_line;
    split_line;
    copy_text ("      Module summary");
    split_line;
    copy_text ("      --------------");
    split_line;
    split_line;
    eve$insert_module_summary;
    split_line;
    split_line;
endif;
copy_text ("Module Name     Ident            Lines  File");
split_line;
copy_text ("-----------     -----            -----  ----");
split_line;
split_line;

!
!	Get the file names from the master file one at a time.
!	Get each file and compile it
!
position (beginning_of (master_buffer));
array_count := 1;
loop
    position (master_buffer);
    exitif (mark (NONE) = end_of (master_buffer));

    master_line := current_line;
    move_vertical (1);
    temp := index (master_line, "!");
    if temp <> 0
    then
	master_line := substr (master_line, 1, temp - 1);
    endif;
    edit (master_line, UPPER, COMPRESS, TRIM, ON);
    if master_line <> ""
    then
	if substr (master_line, 1, 1) = "%"
	then
	    if master_line = "%LIST"
	    then
		eve$$x_list_conditional_compiles := 1;
	    else
		if master_line = "%NOLIST"
		then
		    eve$$x_list_conditional_compiles := 0;
		else
		    message ("Unrecognized build directive: !AS", temp);
		endif;
	    endif;
	else
	    message ("Loading " + master_line);
	    position (build_buffer);
	    erase (build_buffer);
	    file_spec := file_search (master_line, ".TPU", source_file_default);
	    if file_spec = ""
	    then
		message ("Can't find file: " + master_line);
		return (2);
	    endif;
	    file_spec := read_file (file_spec);
	    message ("  From file: " + file_spec);
	    file_name := file_parse (file_spec, "", "", NAME) +
			 file_parse (file_spec, "", "", TYPE);

	    position (listing_buffer);
	    copy_text (fao ("!6UL  !AS",
			    get_info (build_buffer, "record_count"),
			    file_spec));
	    split_line;
	    move_vertical (-1);
!
!	Handle conditional compilation (until TPU supports it better)
!
	    if not eve$$conditional_compile (build_buffer)
	    then
		return (2);
	    endif;
!
!	Look for the trailing executable code
!
	    the_code := 0;
	    the_end := end_of (build_buffer);
	    position (the_end);
	    last_procedure := search (LINE_BEGIN + ("endprocedure" |
						    "endmodule"), REVERSE);
	    if (last_procedure <> 0)
	    then
		position (last_procedure);
		move_vertical (1);
		move_horizontal (-current_offset);
	    else
		position (beginning_of (build_buffer));
	    endif;
	    if (mark (NONE) <> the_end)
	    then
		message ("  Found trailing executable statements.");
		the_code := create_range (mark (NONE), the_end, NONE);
!
!	Clean up the executable code--remove SAVEs, QUITs, and DEBUGONs
!
		position (temp_buffer);
		erase (temp_buffer);
		copy_text (the_code);
		loop
		    position (beginning_of (temp_buffer));
		    temp := search (LINE_BEGIN + "quit" + REMAIN, FORWARD);
		    exitif (temp = 0);
		    message ("    Commenting out QUIT statement.");
		    position (temp);
		    copy_text ("!");

		endloop;

		loop
		    position (beginning_of (temp_buffer));
		    temp := search (LINE_BEGIN
				    + "save"
				    + match (";")
				    + REMAIN,
				    FORWARD);
		    exitif (temp = 0);
		    message ("    Commenting out SAVE statement.");
		    position (temp);
		    copy_text ("!");

		endloop;

		loop
		    position (beginning_of (temp_buffer));
		    temp := search (LINE_BEGIN
				    + "debugon;"
				    + REMAIN,
				    FORWARD);
		    exitif (temp = 0);
		    message ("    Commenting out DEBUGON call.");
		    position (temp);
		    copy_text ("!");

		endloop;

		the_code := create_range (beginning_of (temp_buffer),
					  end_of (temp_buffer),
					  NONE);
	    endif;

!
!	TPU$INIT_PROCEDURE is only valid in one file: EVE$CORE.TPU.
!	Complain about all other copies.
!
	    if (file_name <> "EVE$CORE.TPU")
	    then
		loop
		    position (beginning_of (build_buffer));
		    init_code := search (init_pattern, FORWARD);
		    exitif init_code = 0;
		    position (init_code);
		    if current_offset = 0
		    then
			message ("  Warning: Found tpu$init_procedure.");
			exitif;
		    endif;
		    move_horizontal (-current_offset);
		    move_vertical (1);
		endloop;
	    endif;
!
!	Now that it has been sanitized, compile the code.
!
	    set (INFORMATIONAL, ON);

	    the_program := compile (build_buffer);

	    if (the_code <> 0)
	    then
		the_program := 0;
		the_program := compile (the_code);
		if (the_program <> 0)
		then
		    message ("  Executing the trailing code...");
		    execute (the_program);
		else
		    message ("  Trailing code is not executable.");
		endif;
	    endif;
	    set (INFORMATIONAL, OFF);
	    erase (build_buffer);

!
!	Add any module-specific components just compiled to their variables.
!
	    the_names := expand_name (eve$kt_format_enable_parser,
				      VARIABLES) + " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (parser_flags, the_name) = 0
		    then
			parser_flags := parser_flags + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_pre_init, PROCEDURES) + " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (module_pre_inits, the_name) = 0
		    then
			module_pre_inits := module_pre_inits + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_module_init, PROCEDURES) +
			 " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (module_inits, the_name) = 0
		    then
			module_inits := module_inits + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_status_field, PROCEDURES) +
			 " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (status_fields, the_name) = 0
		    then
			status_fields := status_fields + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_exit_handler, PROCEDURES) +
			 " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (exit_handlers, the_name) = 0
		    then
			exit_handlers := exit_handlers + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_quit_handler, PROCEDURES) +
			 " ";
	    if the_names <> " "
	    then
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		    if index (quit_handlers, the_name) = 0
		    then
			quit_handlers := quit_handlers + the_name + " ";
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_declare_synonym,
				      PROCEDURES) + " ";
	    if the_names <> " "
	    then
		the_length := length (eve$kt_format_declare_synonym) - 1;
		loop
		    exitif the_names = "";
		    space_index := index (the_names, " ");
		    the_name := substr (the_names, 1, space_index - 1);
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));

		    if index (declare_synonyms, the_name) = 0
		    then
			! got a new facility

			declare_synonyms := declare_synonyms + the_name + " ";
			change_case (the_name, LOWER);
			facility := substr (the_name, 1, length (the_name) -
					    the_length);
			synonym_inits := synonym_inits + facility +
					 "_synonym_init" + " ";

			! execute the declare_synonyms procedure

			the_program := 0;
			the_program := compile (the_name);
			if (the_program <> 0)
			then
			    message ("  Executing " + the_name + "...");
			    execute (the_program);
			else
			    message ("  " + the_name + " is not executable.");
			    return (2);
			endif;

			! If any new synonym argument variables were just
			! created, put them into a <facility>_synonym_init
			! procedure that also inits the array elements,
			! and keep track of all the new procedures in
			! synonym_inits.

			if get_info (eve$x_synonym_buffer, "type") <> BUFFER
			then
			    eve$x_synonym_buffer := create_buffer ("SYNONYMS");
			endif;
			position (end_of (eve$x_synonym_buffer));

			last_arg := search (LINE_BEGIN +
					    "eve$arg", REVERSE);
			if last_arg <> 0
			then
			    last_procedure := search (LINE_BEGIN +
						      "endprocedure", REVERSE);
			endif;
			if (last_arg <> 0) and
			    (last_procedure <> 0)
			then
			    if (beginning_of (last_arg)) >
				(beginning_of (last_procedure))
			    then
				position (last_procedure);
				move_vertical (1);
			    endif;
			endif;

			split_line;
			copy_text ("procedure " + facility + "_synonym_init");
			split_line;
			split_line;

			! add code to <facility>_synonym_init to init the
			! synonym array elements

			if get_info (eve$$x_build_array, "type") = ARRAY
			then
			    loop
				exitif array_count > eve$$x_build_array {0};
				! get the root eve command in the array
				space_index := index (
						      eve$$x_build_array
						      {array_count}, " ");
				if space_index = 0
				then
				    the_command :=
						   eve$$x_build_array
						   {array_count};
				else
				    the_command :=
						   substr (
							   eve$$x_build_array
							   {array_count},
							   1, space_index - 1);
				endif;

				! see if the_command has already been copied
				! from eve$$x_build_array to
				! eve$$x_synonym_array during this build;
				! array_count = (# of elements + 1) the build
				! has added to eve$$x_synonym_array up to now

				temp := array_count - 1;
				loop
				    exitif temp = 0;
				    if index (" " + eve$$x_build_array {temp} +
					      " ",
					      " " + the_command + " ") = 1
				    then
					found_synonym := 1;
					exitif;
				    endif;
				    temp := temp - 1;
				endloop;

				copy_text ("eve$$x_synonym_array {'" +
					   the_command +
					   "'} := ");

				! see if the synonym already existed in
				! eve$$x_synonym_array due to /SECTION=

				if (eve$$x_synonym_array {the_command} <>
				    tpu$k_unspecified) or
				    (found_synonym)
				then
				    ! the_command is already in the array,
				    ! prevent duplicate root commands in array

				    if space_index = 0
				    then
					message ("  '" + the_command +
						 "' has already been " +
						 " declared a synonym root.");
					return (2);
				    else
					eve$$x_build_array {array_count} :=
									  substr
									    (
							      eve$$x_build_array
									     {
								     array_count
									      },
								     space_index
									     +
									     1,
									     999
									     );
					copy_text ("eve$$x_synonym_array {'" +
						   the_command + "'} + ' ");
				    endif;
				else
				    copy_text ("'");
				endif;
				copy_text (eve$$x_build_array {array_count} +
					   "';");
				split_line;
				array_count := array_count + 1;
			    endloop;
			endif;
			position (end_of (eve$x_synonym_buffer));
			copy_text ("endprocedure");
			split_line;
			split_line;
		    endif;
		endloop;
	    endif;

	    the_names := expand_name (eve$kt_format_module_ident, ALL) + " ";
	    the_length := length (eve$kt_format_module_ident) - 1;
	    the_name := "";
	    if the_names <> " "
	    then
		loop
		    exitif (the_names = "");
		    space_index := index (the_names, " ");
		    temp := substr (the_names, 1, space_index - 1);
		    if index (module_idents, temp + " ") = 0
		    then
			module_idents := module_idents + temp + " ";
			the_name := temp;
		    endif;
		    the_names := substr (the_names, space_index + 1,
					 length (the_names));
		endloop;
	    endif;
	    position (listing_buffer);
	    copy_text (fao ("!15AS ", substr (the_name, 1,
					      length (the_name) - the_length)));
	    if the_name = ""
	    then
		copy_text ("                ");
	    else
		execute ("if get_info(" + the_name + ",'type')=STRING then " +
			 "copy_text(fao('!15AS '," + the_name + "));" +
			 "endif;");
	    endif;
	    move_vertical (1);
	    message (" ");
	endif;
    endif;
endloop;

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 13

!
!	Build the dynamicly overloaded/created procedures
!
!	eve$parser_dispatch, eve$$pre_init_modules, eve$$init_modules,
!	eve$get_status_fields, eve$version,
!	eve$dynamic_module_ident, eve$exit_dispatch, eve$$quit_dispatch
!
message ("  Building Parser Dispatch Procedure...");

position (build_buffer);
copy_text ("procedure eve$parser_dispatch(the_command)");
split_line;

the_names := parser_flags;
if (the_names <> " ")
then
    the_length := length (eve$kt_format_enable_parser) + 1;
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in parser dispatch.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);

! insure each enabled parser has a corresponding procedure

	temp := substr (the_name, the_length, 9999);
	facility := expand_name (temp + "%process_command", PROCEDURES);
	if (facility = 0)
	then
	    message ("Can't find parser dispatch procedure for facility = " +
		     temp);
	    return (2);
	endif;
	if index (facility, " ")
	then
	    message ("Too many parser dispatches for facility = " + temp);
	    return (2);
	endif;

	split_line;
	copy_text ("    if ");
	copy_text (the_name);
	split_line;
	copy_text ("    then");
	split_line;
	copy_text ("        if (" + facility + "(the_command))");
	split_line;
	copy_text ("        then");
	split_line;
	copy_text ("            return;");
	split_line;
	copy_text ("        endif;");
	split_line;
	copy_text ("    endif;");
	split_line;
	message ("    Found parser dispatch for facility = " + temp);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;
position (end_of (build_buffer));

copy_text ("    eve$process_command(the_command);");
split_line;
split_line;
copy_text ("endprocedure");
split_line;
split_line;
message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 14

message ("  Building Package Pre-Initialization Dispatch Procedure...");

copy_text ("procedure eve$$pre_init_modules");
split_line;
split_line;

the_names := module_pre_inits;
if (the_names <> " ")
then
    the_length := length (eve$kt_format_pre_init) - 1;
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in module pre-init.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);
	facility := substr (the_name, 1, length (the_name) - the_length);

	copy_text ("    ");
	copy_text (the_name);
	copy_text (";");
	split_line;
	message ("    Found package pre-init for facility = " + facility);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;

position (end_of (build_buffer));

copy_text ("endprocedure");
split_line;
split_line;

message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 15

message ("  Building Package Initialization Dispatch Procedure...");

copy_text ("procedure eve$$init_modules");
split_line;
split_line;

the_names := module_inits;
if (the_names <> " ")
then
    the_length := length (eve$kt_format_module_init) - 1;
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in module init.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);
	facility := substr (the_name, 1, length (the_name) - the_length);

	copy_text ("    ");
	copy_text (the_name);
	copy_text (";");
	split_line;
	message ("    Found package init for facility = " + facility);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;

position (end_of (build_buffer));

copy_text ("endprocedure");
split_line;
split_line;

message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 16

message ("  Building Status Line Dispatch Procedure...");

copy_text ("procedure eve$get_status_fields (the_length, the_format)");
split_line;
split_line;
copy_text ("local	remaining,");
split_line;
copy_text ("	the_fields,");
split_line;
copy_text ("	the_field;");
split_line;
split_line;
copy_text ('the_fields := "";');
split_line;
copy_text ("remaining := the_length;");
split_line;
split_line;

the_names := status_fields;
if (the_names <> " ")
then
    the_length := length (eve$kt_format_status_field) - 1;
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in status field.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);
	facility := substr (the_name, 1, length (the_name) - the_length);

	copy_text ("the_field := ");
	copy_text (the_name);
	copy_text (" (remaining, the_format);");
	split_line;
	copy_text ("if length (the_field) <= remaining");
	split_line;
	copy_text ("then");
	split_line;
	copy_text ("    the_fields := the_field + the_fields;");
	split_line;
	copy_text ("    remaining := remaining - length (the_field);");
	split_line;
	copy_text ("endif;");
	split_line;
	split_line;
	message ("    Found status line for facility = " + facility);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;

position (end_of (build_buffer));

copy_text ("return the_fields");
split_line;
split_line;

copy_text ("endprocedure");
split_line;
split_line;

message (" ");


! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 17

the_names := declare_synonyms;
if (the_names <> " ")
then
    message ("  Building Synonym Initialization Dispatch Procedure...");

    ! copy dynamically created synonym procedures and argument variables

    if get_info (eve$x_synonym_buffer, "type") = BUFFER
    then
	copy_text (eve$x_synonym_buffer);
    endif;

    ! create procedure to (1) invoke all dynamically created synonym procedures
    ! of the form <facility>_synonym_init that declare argument variables,
    ! (2) build the string-indexed eve$$x_synonym_array from integer-indexed
    ! eve$$x_build_array.

    copy_text ("procedure eve$$init_all_synonyms");
    split_line;
    split_line;

    the_names := synonym_inits;
    the_length := length (eve$kt_format_synonym_init) - 1;
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in synonym_inits.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);
	facility := substr (the_name, 1, length (the_name) - the_length);

	copy_text (the_name + ";");
	split_line;
	message ("    Found synonym_init for facility = " + facility);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;

position (end_of (build_buffer));

copy_text ("endprocedure");
split_line;
split_line;

message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 18

message ("  Building Exit Dispatch Procedure Procedure...");

position (build_buffer);
copy_text ("procedure eve$exit_dispatch");
split_line;

the_names := exit_handlers;

if (the_names <> " ")
then
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in exit dispatch.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);

	split_line;
	copy_text ("    if ");
	copy_text (the_name);
	split_line;
	copy_text ("    then");
	split_line;
	copy_text ("        return;");
	split_line;
	copy_text ("    endif;");
	split_line;
	message ("    Found exit dispatch for facility = " + the_name);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;
position (end_of (build_buffer));

copy_text ("    eve$exit;");
split_line;
split_line;
copy_text ("endprocedure");
split_line;
split_line;
message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 19

message ("  Building Quit Dispatch Procedure Procedure...");

position (build_buffer);
copy_text ("procedure eve$quit_dispatch");
split_line;

the_names := quit_handlers;
if (the_names <> " ")
then
    the_names := the_names + " ";
    loop
	exitif (the_names = " ");
	space_index := index (the_names, " ");
	if (space_index = 0)
	then
	    message ("Can't find space in quit dispatch.");
	    return (2);
	endif;

	the_name := substr (the_names, 1, space_index - 1);
	edit (the_name, LOWER);

	split_line;
	copy_text ("    if ");
	copy_text (the_name);
	split_line;
	copy_text ("    then");
	split_line;
	copy_text ("        return;");
	split_line;
	copy_text ("    endif;");
	split_line;
	message ("    Found quit dispatch for facility = " + the_name);

	the_names := substr (the_names, space_index + 1, length (the_names));
    endloop;
endif;
position (end_of (build_buffer));

copy_text ("    eve$quit;");
split_line;
split_line;
copy_text ("endprocedure");
split_line;
split_line;
message (" ");

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 20

message ("  Building eve$version procedure...");

position (end_of (build_buffer));

copy_text ("procedure eve$version");
split_line;
copy_text (fao ("    return '!AS !AS';", product_name, product_version));
split_line;
copy_text ("endprocedure");
split_line;

temp := substr (build_time, 10, 2) +
!** internationalize the following:
	fao ("!2ZL", index ("  JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",
			    substr (build_time, 4, 3)) / 3) +
	substr (build_time, 1, 2) + "." +
	substr (build_time, 13, 2) +
	substr (build_time, 16, 2) +
	substr (build_time, 19, 2);

position (beginning_of (build_buffer));

copy_text ("procedure eve$dynamic_module_ident");
split_line;
copy_text (fao ("return '!AS';", temp));
split_line;
copy_text ("endprocedure");
split_line;
split_line;


! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 21


message ("  Preserving procedure/variable lists...");

position (end_of (build_buffer));

copy_text ("procedure eve$$build_module_idents");
split_line;
split_line;
copy_text ("return (");
loop
    exitif module_idents = "";
    space_index := index (module_idents, " ");
    the_name := substr (module_idents, 1, space_index - 1);
    module_idents := substr (module_idents, space_index + 1,
			     length (module_idents));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'EVE$DYNAMIC_MODULE_IDENT ' + ");
split_line;
copy_text ("	'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_parser_flags");
split_line;
split_line;
copy_text ("return (");
loop
    exitif parser_flags = "";
    space_index := index (parser_flags, " ");
    the_name := substr (parser_flags, 1, space_index - 1);
    parser_flags := substr (parser_flags, space_index + 1,
			    length (parser_flags));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_module_pre_inits");
split_line;
split_line;
copy_text ("return (");
loop
    exitif module_pre_inits = "";
    space_index := index (module_pre_inits, " ");
    the_name := substr (module_pre_inits, 1, space_index - 1);
    module_pre_inits := substr (module_pre_inits, space_index + 1,
				length (module_pre_inits));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_module_inits");
split_line;
split_line;
copy_text ("return (");
loop
    exitif module_inits = "";
    space_index := index (module_inits, " ");
    the_name := substr (module_inits, 1, space_index - 1);
    module_inits := substr (module_inits, space_index + 1,
			    length (module_inits));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_declare_synonyms");
split_line;
split_line;
copy_text ("return (");
loop
    exitif declare_synonyms = "";
    space_index := index (declare_synonyms, " ");
    the_name := substr (declare_synonyms, 1, space_index - 1);
    declare_synonyms := substr (declare_synonyms, space_index + 1,
				length (declare_synonyms));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_synonym_inits");
split_line;
split_line;
copy_text ("return (");
loop
    exitif synonym_inits = "";
    change_case (synonym_inits, UPPER);
    space_index := index (synonym_inits, " ");
    the_name := substr (synonym_inits, 1, space_index - 1);
    synonym_inits := substr (synonym_inits, space_index + 1,
			     length (synonym_inits));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_status_fields");
split_line;
split_line;
copy_text ("return (");
loop
    exitif status_fields = "";
    space_index := index (status_fields, " ");
    the_name := substr (status_fields, 1, space_index - 1);
    status_fields := substr (status_fields, space_index + 1,
			     length (status_fields));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_exit_handlers");
split_line;
split_line;
copy_text ("return (");
loop
    exitif exit_handlers = "";
    space_index := index (exit_handlers, " ");
    the_name := substr (exit_handlers, 1, space_index - 1);
    exit_handlers := substr (exit_handlers, space_index + 1,
			     length (exit_handlers));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;
copy_text ("procedure eve$$build_quit_handlers");
split_line;
split_line;
copy_text ("return (");
loop
    exitif quit_handlers = "";
    space_index := index (quit_handlers, " ");
    the_name := substr (quit_handlers, 1, space_index - 1);
    quit_handlers := substr (quit_handlers, space_index + 1,
			     length (quit_handlers));
    copy_text ("'" + the_name + " ' +");
    split_line;
    copy_text ("	");
endloop;
copy_text ("'');");
split_line;
split_line;
copy_text ("endprocedure;");
split_line;
split_line;

position (listing_buffer);
copy_text (fao ("!15AS !15AS !6UL  !AS",
		" linkage code", temp,
		get_info (build_buffer, "record_count"),
		init_file));


! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 22

!
!	Handle conditional compilation (until TPU supports it better)
!
if not eve$$conditional_compile (build_buffer)
then
    return (2);
endif;
!
!	Time to actually compile the code
!
set (INFORMATIONAL, OFF);
compile (build_buffer);
compile ("procedure eve$$require(temp) endprocedure;");
!
!	List options
!
split_line;
split_line;

eve$insert_option_list;

!
!	Do a second module summary if we're building under a section
!	file.
!
temp := get_info (COMMAND_LINE, "section_file");
if temp <> ""
then
    split_line;
    split_line;
    copy_text ("      Module summary");
    split_line;
    copy_text ("      --------------");
    split_line;
    split_line;
    eve$insert_module_summary;
endif;
!
!	Now that everything is compiled, list the variables and procedures
!	in the listing file.
!
show (SUMMARY);
position (end_of (listing_buffer));
copy_text (ascii (12));
split_line;
copy_text ("---------------- Summary ---------------");
split_line;
copy_text (create_range (beginning_of (tpu$x_show_buffer),
			 end_of (tpu$x_show_buffer),
			 NONE));

show (VARIABLES);
position (end_of (listing_buffer));
copy_text (ascii (12));
split_line;
copy_text ("------------ Variables used ------------");
split_line;
copy_text (create_range (beginning_of (tpu$x_show_buffer),
			 end_of (tpu$x_show_buffer),
			 NONE));

show (PROCEDURES);
position (end_of (listing_buffer));
copy_text (ascii (12));
split_line;
copy_text ("--------------- Procedures -------------");
split_line;

copy_text (create_range (beginning_of (tpu$x_show_buffer),
			 end_of (tpu$x_show_buffer),
			 NONE));
split_line;


eve$$save_settings;

position (end_of (build_buffer));
copy_text (eve$context_buffer);

set (SUCCESS, ON);

write_file (build_buffer, init_file);
write_file (listing_buffer);
message (" ");

if (dump_buffer <> 0)
then
    write_file (dump_buffer);
endif;

set (SUCCESS, OFF);

compile ("procedure eve$$build endprocedure");

save_command := "on_error [OTHERWISE]: endon_error;"
		+ "save ('" + section_file + "', 'IDENT', '" + product_ident
		+ "'";

if eve$$x_save_names = tpu$k_unspecified
then
    eve$$x_save_names := 0;
endif;

case eve$$x_save_names
    [0]:
	;
    [-1]:
	save_command := save_command + ", 'NO_DEBUG_NAMES'";
    [1]:
	save_command := save_command + ", 'NO_PROCEDURE_NAMES'";
    [INRANGE, OUTRANGE]:
	message ("Eve$$x_save_names was not -1, 0, or 1.");
	return (2);
endcase;

if eve$$x_save_changes = tpu$k_unspecified
then
    eve$$x_save_changes := 0;
endif;

if eve$$x_save_changes
then
    save_command := save_command + ", 'CHANGES_ONLY'";
endif;

save_command := save_command + "); return 1;";

set (SUCCESS, ON);
set (INFORMATIONAL, ON);

if not execute (save_command)
then
    message ("*** Build complete w/Messages ***");
    if get_info (COMMAND_LINE, "display")
    then
      write_file (tpu$x_message_buffer,message_file);
    endif;
    message ("*** Build complete w/Messages ***");
    return (2);
else
    message ("*** Build complete ***");
    if get_info (COMMAND_LINE, "display")
    then
      write_file (tpu$x_message_buffer,message_file);
    endif;
    message ("*** Build complete ***");
    return (1);
endif;

endprocedure;

! EVE$BUILD.TPU 		23-OCT-1987 10:22			Page 23

!
!	Call the main build routine, and execute the string it returns.
!	If there are no errors this will delete eve$$build and eve$$require,
!	and also save the section file.
!

quit (OFF, eve$$build);