MODULE SCA$REPORT_UTILITIES IDENT "T4.5-1" !************************************************************************* ! * ! © 2000 BY * ! COMPAQ COMPUTER CORPORATION * ! © 1996, 2000 BY * ! ELECTRONIC DATA SYSTEMS LIMITED * ! * ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ! OTHER PERSON. NO TITLE TO OR OWNERSHIP OF THE SOFTWARE IS HEREBY * ! TRANSFERRED. * ! * ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY COMPAQ COMPUTER * ! CORPORATION OR EDS. * ! * ! NEITHER COMPAQ NOR EDS ASSUME ANY RESPONSIBILITY FOR THE USE OR * ! RELIABILITY OF THIS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY * ! COMPAQ. * ! * !************************************************************************* ! !++ ! Facility: ! SCA - Source Code Analyzer ! REPORT - Report Subfacility ! ! Abstract: ! This module contains a variety of utility procedures. ! ! Table of Contents: ! ! 1. Initialization and cleanup procedures ! 2. Error and message handling procedures ! 3. Procedures to build report definitions ! 4. Procedures to process report definitions ! 5. Common action routines ! 6. SCA interface procedures ! 7. Formatting procedures ! 8. Miscellaneous procedures !-- VARIABLE sca$report_bad_files, sca$report_file_array, sca$report_file_index, sca$report_file_name_array, sca$report_valid_options; !============================================================================ ! Initialization and cleanup procedures PROCEDURE sca$report_common_cleanup !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine does cleanup that is needed at the end of a report. The ! corresponding initialization is done by sca$report_common_initialization. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! Global variables that contain various report-wide information are cleared. !-- ON_ERROR [OTHERWISE] : MESSAGE('Error signalled in report routine SCA$REPORT_COMMON_CLEANUP'); ABORT; ENDON_ERROR; ! Ensure that sca$report_command_context is set up (for DELETE QUERY). ! sca$report_command_context := lse$sca_command_context; ! Clean up things related to the query processing done during the report. ! sca$report_queries_cleanup; ! Clean up report definition arrays. ! sca$report_definition_cleanup; ! Delete the subprocess, if it still exists. ! IF GET_INFO (sca$report_subprocess_id, 'TYPE') = PROCESS THEN DELETE (sca$report_subprocess_id); ENDIF; ! Delete any remaining source file buffers (this usually indicates ! sloppiness by the report code, or an abnormal termination). ! sca$report_flush_file_array; ! Delete scratch buffers. ! IF GET_INFO (sca$report_code_fragment_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_code_fragment_buffer); ENDIF; IF GET_INFO (sca$report_output_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_output_buffer); ENDIF; IF GET_INFO (sca$report_parameter_description_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_parameter_description_buffer); ENDIF; IF GET_INFO (sca$report_scratch_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_scratch_buffer); ENDIF; IF GET_INFO (sca$report_subprocess_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_subprocess_buffer); ENDIF; IF GET_INFO (sca$report_tag_value_buffer, 'TYPE') = BUFFER THEN DELETE (sca$report_tag_value_buffer); ENDIF; ! Delete the local copy of the /DOMAIN query. ! IF sca$report_domain_query <> '' THEN sca$report_delete_query ('SCA$REPORT_DOMAIN'); sca$report_domain_query := ''; ENDIF; ! Clean up variables related to portable syntax and command line options. ! IF GET_INFO (PROCEDURES, 'DEFINED', 'sca$report_cleanup_options') THEN EXECUTE ('sca$report_cleanup_options'); ENDIF; ! Call user-specified cleanup procedure, if any. ! IF GET_INFO (PROCEDURES, 'DEFINED', 'sca_report_user_cleanup') THEN EXECUTE( 'sca_report_user_cleanup'); ENDIF; ! Restore editing position. ! sca$report_restore_editing_position; lse$set_status_line (CURRENT_WINDOW); RETURN; ENDPROCEDURE PROCEDURE sca$report_common_initialization( legal_targets_indices, default_target; rest_of_line_flag) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine does initialization that is needed at the beginning of ! a report. The corresponding cleanup is done by sca$report_common_cleanup. ! ! Note: this procedure is now obsolete. It is provided for backward ! compatibility with customized report code based on V3.1 and earlier ! versions. New report code should call sca$report_portable_initialization ! instead of this procedure. ! ! FORMAL PARAMETERS: ! ! legal_targets_indices ! ! An array of integers that correspond to the legal targets for the ! current report. IN parameter. ! ! default_target ! ! The default target to use if /TARGET was not specified. IN parameter. ! ! rest_of_line_flag ! ! A flag indicating whether or not rest_of_line parameters are allowed. ! If TRUE, they are allowed. If FALSE or UNSPECIFIED, they are ! not allowed. OPTIONAL IN parameter. ! ! IMPLICIT OUTPUTS: ! ! sca$report_target_index ! ! The value from legal_targets_indices that corresponds to ! SCA$REPORT_TARGET. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_COMMON_INITIALIZATION'); ENDON_ERROR; sca$report_new_and_old_init; IF sca$report_invoked_via_portable THEN ! Supply sca$report_xxx variables for the case where an old-style ! report is invoked by the portable REPORT command. All qualifier ! values are defaulted. ! sca$report_domain_query := ''; sca$report_fill := 1; sca$report_output := ''; sca$report_rest_of_line := ''; sca$report_target := ''; sca$report_languages := ''; sca$report_help_library := ''; ENDIF; ! Validate report parameters and supply defaults. ! sca$report_validate_implicit_parameters ( legal_targets_indices, default_target, sca$report_target_index, rest_of_line_flag); ! Call user-specified initialization procedure, if any. ! IF GET_INFO (PROCEDURES, 'DEFINED', 'sca_report_user_initialization') THEN EXECUTE ('sca_report_user_initialization'); ENDIF; RETURN; ENDPROCEDURE PROCEDURE sca$report_get_file_names !++ ! FUNCTIONAL DESCRIPTION: ! ! Determine file names for the output files generated by the report. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! sca$report_file_type_default - string giving default value for file type ! sca$report_option_output - string giving user-specified output file spec ! sca$report_target_index - integer indicating report target type ! ! IMPLICIT OUTPUTS: ! ! sca$report_output_file_name ! sca$report_work_file_name, sca$report_work_file_spec ! sca$report_temp_file_name, sca$report_temp_file_spec !-- LOCAL temp_directory; ON_ERROR [tpu$_parsefail] : sca$report_hard_error ( MESSAGE_TEXT(sca$_badrptoutput, 0, sca$report_option_output) ); [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_FILE_NAMES'); ENDON_ERROR; IF GET_INFO (sca$report_option_output, 'TYPE') = UNSPECIFIED THEN sca$report_option_output := ''; ENDIF; IF GET_INFO (sca$report_file_type_default, 'TYPE') = UNSPECIFIED THEN sca$report_file_type_default := ''; ENDIF; IF GET_INFO (sca$report_target_index, 'TYPE') = UNSPECIFIED THEN sca$report_target_index := sca$report_k_target_other; ENDIF; ! Parse OUTPUT option value. ! sca$report_output_file_name := FILE_PARSE( sca$report_option_output, sca$report_name + "." + sca$report_file_type_default); ! Get the node, device, and directory portion of the output file name, ! so that the temporary files can go to that same directory. ! temp_directory := FILE_PARSE (sca$report_output_file_name, '', '', NODE, DEVICE, DIRECTORY); ! Build the work file name (only different from the final output file ! for TEXT format) and initialize its file spec to null. ! IF sca$report_target_index = sca$report_k_target_text THEN sca$report_work_file_name := FILE_PARSE('.TMP1', sca$report_output_file_name, ''); ELSE sca$report_work_file_name := sca$report_output_file_name; ENDIF; sca$report_work_file_spec := ''; ! Build the temporary file name (used for dumping intermediate results, ! since we can't directly append the contents of a buffer to an existing ! file), and initialize its file spec to null. ! sca$report_temp_file_name := FILE_PARSE('.TMP', sca$report_output_file_name, ''); sca$report_temp_file_spec := ''; ENDPROCEDURE PROCEDURE sca$report_new_and_old_init !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure contains the initialization code that is common to the old ! (CLI-only) and new (CLI and portable) report interfaces. ! ! FORMAL PARAMETERS: ! ! None !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_NEW_AND_OLD_INIT'); ENDON_ERROR; IF GET_INFO (sca$report_invoked_via_portable, 'TYPE') = UNSPECIFIED THEN sca$report_invoked_via_portable := FALSE; ENDIF; sca$report_saved_window := CURRENT_WINDOW; sca$report_saved_position := MARK(FREE_CURSOR); ! Turn on traceback if requested by the user. ! IF sca$report_option_traceback_flag THEN SET(TRACEBACK,ON); ENDIF; ! Initialize the array used to store the list of files in use. ! sca$report_file_index := 0; IF GET_INFO (sca$report_file_array, 'TYPE') <> ARRAY THEN sca$report_file_array := CREATE_ARRAY; ENDIF; IF GET_INFO (sca$report_file_name_array, 'TYPE') <> ARRAY THEN sca$report_file_name_array := CREATE_ARRAY; ENDIF; ! Create the scratch buffer used to generate code fragments for the Body ! section of an INTERNALS report. ! sca$report_open_buffer ('SCA$CODE_FRAGMENT', sca$report_code_fragment_buffer); ! Create the buffer to hold report output. ! sca$report_open_buffer ('SCA$REPORT_OUTPUT_BUFFER', sca$report_output_buffer); ! Create the scratch buffer used to format parameter description text. ! sca$report_open_buffer ('SCA$PARAMETER_DESCRIPTION', sca$report_parameter_description_buffer); ! Create the general-purpose scratch buffer. ! sca$report_open_buffer ('SCA$SCRATCH', sca$report_scratch_buffer); ! Create the scratch buffer used by the subprocess. ! sca$report_open_buffer ('SCA$REPORT_SUBPROCESS_BUFFER', sca$report_subprocess_buffer); ! Create the scratch buffer used to format tag value text. ! sca$report_open_buffer ('SCA$TAG_VALUE', sca$report_tag_value_buffer); ! Create the subprocess used for DCL commands, if it does not already exist. ! IF GET_INFO (sca$report_subprocess_id, 'TYPE') = UNSPECIFIED THEN sca$report_subprocess_id := CREATE_PROCESS (sca$report_subprocess_buffer, '$ SET NOON'); ENDIF; ENDPROCEDURE PROCEDURE sca$report_portable_initialization !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine does initialization that is needed at the beginning of ! a report. The corresponding cleanup is done by sca$report_common_cleanup. ! This routine handles initialization for reports that may be invoked either ! by the portable interface or the VMS CLI interface. It assumes that there ! is a procedure to define the valid options for the current report. If ! not, it issues an error message and terminates the report. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL status; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_PORTABLE_INITIALIZATION'); ENDON_ERROR; sca$report_new_and_old_init; ! If options have not yet been defined, try to do so. ! IF sca$report_invoked_via_portable THEN sca$report_get_option_defs; ELSE sca$report_convert_CLI_options; ENDIF; ! Get file names for output files. ! sca$report_get_file_names; ! Call user-specified initialization procedure, if any. ! IF GET_INFO (PROCEDURES, 'DEFINED', 'sca_report_user_initialization') THEN EXECUTE ('sca_report_user_initialization'); ENDIF; RETURN; ENDPROCEDURE PROCEDURE sca$report_restore_editing_position !++ ! FUNCTIONAL DESCRIPTION: ! ! Restore the saved editing position when report processing is complete. ! ! FORMAL PARAMETERS: ! ! None !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_RESTORE_EDITING_POSITION'); ENDON_ERROR; IF GET_INFO(sca$report_saved_window, 'TYPE') = WINDOW THEN IF GET_INFO(sca$report_saved_window, 'BUFFER') = 0 THEN MAP (sca$report_saved_window, GET_INFO (sca$report_saved_position,'BUFFER')); ENDIF; POSITION (sca$report_saved_window); POSITION (sca$report_saved_position); MAP (sca$report_saved_window, CURRENT_BUFFER); ENDIF; ENDPROCEDURE !============================================================================ ! Error and message handling procedures PROCEDURE sca$report_bad_parameter (bad_parameter, called_routine) !++ ! FUNCTIONAL DESCRIPTION: ! ! Report a bad parameter. This happens when the parameter passed to ! a utility routine is not supported. ! ! FORMAL PARAMETERS: ! ! bad_parameter ! ! The bad parameter, as an integer. IN parameter. ! ! called_routine ! ! The name of the routine to which the bad parameter was passed, as a ! string. IN parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_BAD_PARAMETER'); ENDON_ERROR; sca$report_hard_error (MESSAGE_TEXT(sca$_badrptparm,0) + ' (' + STR(bad_parameter) + ') - ' + called_routine); ENDPROCEDURE PROCEDURE sca$report_check_sca (sca_status) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure checks the status returned by an SCA builtin. ! ! FORMAL PARAMETERS: ! ! sca_status ! ! The status value to be checked. !-- LOCAL severity, severity_index; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CHECK_SCA'); ENDON_ERROR; severity := message_text(sca_status, tpu$k_message_severity); severity := SUBSTR(severity,2,1); severity_index := INDEX('WEF',severity); IF sca$report_option_sca_debug_messages THEN MESSAGE (sca_status, tpu$k_message_facility OR tpu$k_message_severity OR tpu$k_message_id OR tpu$k_message_text); IF severity_index > 1 THEN MESSAGE(); ABORT ENDIF ENDIF; RETURN sca_status; ENDPROCEDURE VARIABLE sca$report_in_error_cleanup; PROCEDURE sca$report_common_error_cleanup (routine_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine does cleanup that is needed when an unrecoverable error occurs ! during a report. It then does an ABORT to terminate the report processing. ! ! FORMAL PARAMETERS: ! ! routine_name ! ! A string containing the name of the routine where the error was ! detected. IN parameter. !-- ON_ERROR [OTHERWISE] : MESSAGE('Error signalled in report routine SCA$REPORT_COMMON_ERROR_CLEANUP'); ABORT; ENDON_ERROR; IF GET_INFO (sca$report_in_error_cleanup, 'TYPE') = UNSPECIFIED THEN sca$report_in_error_cleanup := FALSE; ENDIF; IF sca$report_in_error_cleanup THEN MESSAGE ('Recursive entry to error cleanup - terminating report'); sca$report_in_error_cleanup := FALSE; ABORT; ENDIF; sca$report_in_error_cleanup := TRUE; MESSAGE('Error signalled in report routine ' + routine_name); sca$report_common_cleanup; sca$report_in_error_cleanup := FALSE; ABORT; RETURN; ENDPROCEDURE PROCEDURE sca$report_hard_error (message_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure reports a fatal error, and then aborts. ! ! FORMAL PARAMETERS: ! ! message_string ! ! The error message to report. ! ! SIDE EFFECTS: ! ! Aborts the report tool. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_HARD_ERROR'); ENDON_ERROR; MESSAGE (message_string); sca$report_common_cleanup; ABORT; ENDPROCEDURE PROCEDURE sca$report_status_message (message_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine generates a status message to show how the report ! processing is progressing. The global variable ! sca$report_option_status_messages controls whether the message gets ! written. ! ! FORMAL PARAMETERS: ! ! message_string ! ! The message to be displayed. IN parameter. !-- IF sca$report_option_status_messages THEN MESSAGE (message_string); ENDIF; RETURN; ENDPROCEDURE PROCEDURE sca$report_trace_message (message_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used for generating trace output. ! The global variable sca$report_option_trace_messages controls whether ! trace messages get written. !-- ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_TRACE_MESSAGE'); ENDON_ERROR; IF sca$report_option_trace_messages THEN MESSAGE (message_string); ENDIF; RETURN; ENDPROCEDURE !============================================================================ ! Procedures to build report definitions ! ! The following collection of procedures are used for building report ! definition tables. ! PROCEDURE sca$report_create_definition (number_entries) !++ ! FUNCTIONAL DESCRIPTION: ! ! Create the arrays for a report definition. ! ! FORMAL PARAMETERS: ! ! number_entries ! ! The approximate number of entries in this report definition (used to ! do the initial allocation of the definition arrays). IN parameter. ! ! SIDE EFFECTS: ! ! Memory is allocated. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CREATE_DEFINITION'); ENDON_ERROR; sca$report_level_array := CREATE_ARRAY(number_entries); sca$report_label_array := CREATE_ARRAY(number_entries); sca$report_option_array := CREATE_ARRAY(number_entries); sca$report_query_array := CREATE_ARRAY(number_entries); sca$report_info_arrays := CREATE_ARRAY(number_entries); sca$report_entity_name_array := CREATE_ARRAY(number_entries); sca$report_action_routine_arrays := CREATE_ARRAY(number_entries); sca$report_definition_max_index := 0; ENDPROCEDURE PROCEDURE sca$report_create_subdefinition (subdefinition_name, number_entries) !++ ! FUNCTIONAL DESCRIPTION: ! ! Create the arrays for a report subdefinition. ! Note that it is currently a requirement that all subdefinitions be done ! before the main definition is started. ! ! FORMAL PARAMETERS: ! ! subdefinition_name ! ! The name of this subdefinition (used in an INCLUDE entry in a higher- ! level definition), as a string. IN parameter. ! ! number_entries ! ! The approximate number of entries in this report definition (used to ! do the initial allocation of the definition arrays). IN parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CREATE_SUBDEFINITION'); ENDON_ERROR; ! Save the subdefinition name for use by sca$report_end_subdefinition. ! sca$report_subdefinition_name := subdefinition_name; ! Create new definition arrays for the subdefinition. ! sca$report_level_array := CREATE_ARRAY(number_entries); sca$report_label_array := CREATE_ARRAY(number_entries); sca$report_option_array := CREATE_ARRAY(number_entries); sca$report_query_array := CREATE_ARRAY(number_entries); sca$report_info_arrays := CREATE_ARRAY(number_entries); sca$report_entity_name_array := CREATE_ARRAY(number_entries); sca$report_action_routine_arrays := CREATE_ARRAY(number_entries); sca$report_definition_max_index := 0; ENDPROCEDURE PROCEDURE sca$report_definition_cleanup !++ ! FUNCTIONAL DESCRIPTION: ! ! Clean up a report definition when the report is complete. This consists ! of deleting the arrays that contain the report definition. ! ! FORMAL PARAMETERS: ! ! None !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_CLEANUP'); ENDON_ERROR; IF GET_INFO (sca$report_level_array, 'TYPE') = ARRAY THEN DELETE(sca$report_level_array); ENDIF; IF GET_INFO (sca$report_label_array, 'TYPE') = ARRAY THEN DELETE(sca$report_label_array); ENDIF; IF GET_INFO (sca$report_option_array, 'TYPE') = ARRAY THEN DELETE(sca$report_option_array); ENDIF; IF GET_INFO (sca$report_query_array, 'TYPE') = ARRAY THEN DELETE(sca$report_query_array); ENDIF; IF GET_INFO (sca$report_info_arrays, 'TYPE') = ARRAY THEN DELETE(sca$report_info_arrays); ENDIF; IF GET_INFO (sca$report_entity_name_array, 'TYPE') = ARRAY THEN DELETE(sca$report_entity_name_array); ENDIF; IF GET_INFO (sca$report_action_routine_arrays, 'TYPE') = ARRAY THEN DELETE(sca$report_action_routine_arrays); ENDIF; sca$report_definition_max_index := 0; ENDPROCEDURE PROCEDURE sca$report_definition_add_action_routine (routine_name, invoke_option) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add an action routine name to the current report definition entry. ! ! FORMAL PARAMETERS: ! ! routine_name ! ! The action routine name to be added, as a string. IN parameter. ! ! invoke_option ! ! A constant indicating when the action routine should be invoked. ! The possible values for this parameter are given in the file ! sca$report_globals.tpu, and all start with "sca$report_k_invoke_". ! IN parameter. !-- LOCAL action_routine_array, action_routine_info; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_ACTION_ROUTINE'); ENDON_ERROR; ! Build action routine description block. ! action_routine_info := CREATE_ARRAY(2); action_routine_info{sca$report_k_routine_name_index} := routine_name; action_routine_info{sca$report_k_invoke_option_index} := invoke_option; ! Update action routine count and add action routine info to array. ! action_routine_array := sca$report_action_routine_arrays{sca$report_definition_max_index}; action_routine_array{0} := action_routine_array{0} + 1; action_routine_array{ action_routine_array{0} } := action_routine_info; ENDPROCEDURE PROCEDURE sca$report_definition_add_entity_name (entity_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add the name to be used for query entities created during processing of the ! current report definition entry. ! ! FORMAL PARAMETERS: ! ! entity_name ! ! The entity name to be added. IN parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_ENTITY_NAME'); ENDON_ERROR; sca$report_entity_name_array{sca$report_definition_max_index} := entity_name; ENDPROCEDURE PROCEDURE sca$report_definition_add_entry (level_number, number_queries, number_attributes, number_action_routines) !++ ! FUNCTIONAL DESCRIPTION: ! ! Create the arrays needed for a new report definition entry and fill in ! its level number. ! ! FORMAL PARAMETERS: ! ! level_number ! ! The level number of the new entry. IN parameter. ! ! number_queries ! ! The number of query strings in this entry. IN parameter. ! ! number_attributes ! ! The number of attributes to be used in this entry. IN parameter. ! ! number_action_routines ! ! The number of action routines defined for this entry. IN parameter. ! ! IMPLICIT INPUTS: ! ! The report definition arrays so far created. ! ! IMPLICIT OUTPUTS: ! ! Updated definition arrays and sca$report_definition_max_index. !-- LOCAL new_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_ENTRY'); ENDON_ERROR; sca$report_definition_max_index := sca$report_definition_max_index + 1; sca$report_level_array{sca$report_definition_max_index} := level_number; sca$report_label_array{sca$report_definition_max_index} := 0; sca$report_option_array{sca$report_definition_max_index} := 0; sca$report_entity_name_array{sca$report_definition_max_index} := 0; IF number_queries <> 0 THEN new_array := CREATE_ARRAY(number_queries, 0); new_array{0} := 0; sca$report_query_array{sca$report_definition_max_index} := new_array; ELSE sca$report_query_array{sca$report_definition_max_index} := 0; ENDIF; IF number_attributes <> 0 THEN new_array := CREATE_ARRAY(number_attributes, 0); new_array{0} := 0; sca$report_info_arrays{sca$report_definition_max_index} := new_array; ELSE sca$report_info_arrays{sca$report_definition_max_index} := 0; ENDIF; IF number_action_routines <> 0 THEN new_array := CREATE_ARRAY(number_action_routines, 0); new_array{0} := 0; sca$report_action_routine_arrays{sca$report_definition_max_index} := new_array; ELSE sca$report_action_routine_arrays{sca$report_definition_max_index} := 0; ENDIF; ENDPROCEDURE PROCEDURE sca$report_definition_add_info (info_type, info_location_index; info_constant) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add attribute information to the current report definition entry. ! ! FORMAL PARAMETERS: ! ! info_type ! ! The attribute type to be added. ! The possible values for this parameter are given in the file ! sca$report_globals.tpu, and all start with "sca$report_k_info_type_". ! IN parameter. ! ! info_location_index ! ! The index within the result array where the attribute value will be ! stored. The possible values for this parameter are given in the file ! sca$report_globals.tpu, and all start with "sca$report_location_". ! IN parameter. ! ! info_constant ! ! (Optional) constant value to be stored. IN parameter. !-- LOCAL i, info_array, new_info, old_info; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_INFO'); ENDON_ERROR; ! Get info array for this entry. ! info_array := sca$report_info_arrays{sca$report_definition_max_index}; ! Check that location does not conflict with other info locations for this ! entry. ! i := 1; LOOP EXITIF i > info_array{0}; old_info := info_array{i}; IF info_location_index = old_info{2} THEN sca$report_status_message ('*** Location ' + STR(info_location_index) + ' already used for info'); EXITIF TRUE; ENDIF; i := i + 1; ENDLOOP; ! Update info_array count and add new type, location, and optional constant ! value to array. ! info_array{0} := info_array{0} + 1; new_info := CREATE_ARRAY(4); new_info{1} := info_type; new_info{2} := info_location_index; IF GET_INFO(info_constant, 'TYPE') <> UNSPECIFIED THEN new_info{3} := info_constant; ENDIF; info_array{ info_array{0} } := new_info; ENDPROCEDURE PROCEDURE sca$report_definition_add_label (label_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! Label the current report definition entry. ! ! FORMAL PARAMETERS: ! ! label_string ! ! The label string for the entry. IN parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_LABEL'); ENDON_ERROR; sca$report_label_array{sca$report_definition_max_index} := label_string; ENDPROCEDURE PROCEDURE sca$report_definition_add_option (option_value) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add one or more processing options to the current report definition entry. ! ! FORMAL PARAMETERS: ! ! option_value ! ! An integer containing one or more option flags. ! The possible values for this parameter are given in the file ! sca$report_globals.tpu, and all start with "sca$report_k_option_". ! IN parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_OPTION'); ENDON_ERROR; sca$report_option_array{sca$report_definition_max_index} := sca$report_option_array{sca$report_definition_max_index} OR option_value; ENDPROCEDURE PROCEDURE sca$report_definition_add_query (query_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add a query string to the current report definition entry. ! ! FORMAL PARAMETERS: ! ! query_string ! ! The query string to be added. IN parameter. !-- LOCAL query_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_QUERY'); ENDON_ERROR; ! Update query count and add new query string to array. ! query_array := sca$report_query_array{sca$report_definition_max_index}; query_array{0} := query_array{0} + 1; query_array{ query_array{0} } := query_string; ENDPROCEDURE PROCEDURE sca$report_definition_add_query_dynamic (query_string1; var1, query_string2, var2, query_string3) !++ ! FUNCTIONAL DESCRIPTION: ! ! Add a dynamic query string to the current report definition entry. A ! dynamic query string is formed by concatenating together a sequence of ! string constants and string variables to form a single query. It is used, ! for example, to build a query string that contains the name of the current ! source file. ! ! FORMAL PARAMETERS: ! ! query_string1, query_string2, query_string3 ! ! The constant strings to be used in the query. IN parameters. ! ! var1, var2 ! ! The names of variables to be used in forming the query. IN parameters. !-- LOCAL dynamic_query, query_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ADD_QUERY_DYNAMIC'); ENDON_ERROR; ! Build dynamic query description. ! dynamic_query := CREATE_ARRAY (5); IF GET_INFO (query_string1, 'TYPE') <> UNSPECIFIED THEN dynamic_query{1} := query_string1; ELSE dynamic_query{1} := ''; ENDIF; IF GET_INFO (var1, 'TYPE') <> UNSPECIFIED THEN dynamic_query{2} := var1; ELSE dynamic_query{2} := ''; ENDIF; IF GET_INFO (query_string2, 'TYPE') <> UNSPECIFIED THEN dynamic_query{3} := query_string2; ELSE dynamic_query{3} := ''; ENDIF; IF GET_INFO (var2, 'TYPE') <> UNSPECIFIED THEN dynamic_query{4} := var2; ELSE dynamic_query{4} := ''; ENDIF; IF GET_INFO (query_string3, 'TYPE') <> UNSPECIFIED THEN dynamic_query{5} := query_string3; ELSE dynamic_query{5} := ''; ENDIF; ! Update query count and add new query string pieces to array. ! query_array := sca$report_query_array{sca$report_definition_max_index}; query_array{0} := query_array{0} + 1; query_array{ query_array{0} } := dynamic_query; ENDPROCEDURE PROCEDURE sca$report_definition_entry_lookup (entry_label) !++ ! FUNCTIONAL DESCRIPTION: ! ! Given an entry label, find its index in the current report definition. ! ! FORMAL PARAMETERS: ! ! entry_label ! ! The entry label, as a TPU string. IN parameter. ! ! ROUTINE VALUE: ! ! The index of the entry with the specified label. 0 if no corresponding ! label was found. !-- LOCAL entry_label_upcased, i; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_ENTRY_LOOKUP'); ENDON_ERROR; i := 0; entry_label_upcased := CHANGE_CASE (entry_label, UPPER, NOT_IN_PLACE); LOOP i := i + 1; EXITIF i > sca$report_definition_max_index; IF sca$report_label_array{i} <> 0 THEN EXITIF CHANGE_CASE (sca$report_label_array{i},UPPER,NOT_IN_PLACE) = entry_label_upcased; ENDIF; ENDLOOP; ! Set return value to 0 if entry name was not found. ! IF i > sca$report_definition_max_index THEN i := 0; ENDIF; RETURN i; ENDPROCEDURE PROCEDURE sca$report_definition_include_subdefinition (level_number, subdefinition_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! Perform an INCLUDE of a subdefinition into the current definition. ! ! FORMAL PARAMETERS: ! ! level_number ! ! The base level number for the subdefinition. IN parameter. ! ! subdefinition_name ! ! The subdefinition name, as a string. IN parameter. !-- LOCAL i, subdefinition_array, subdefinition_level_array, subdefinition_label_array, subdefinition_option_array, subdefinition_query_array, subdefinition_info_arrays, subdefinition_entity_name_array, subdefinition_action_routine_arrays, subdefinition_definition_max_index; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_INCLUDE_SUBDEFINITION'); ENDON_ERROR; ! Find the indicated subdefinition. ! i := 0; LOOP EXITIF i >= sca$report_subdefinition_index; i := i + 1; subdefinition_array := sca$report_subdefinition_array{i}; EXITIF subdefinition_array{11} = subdefinition_name; ENDLOOP; IF (i = 0) OR (i > sca$report_subdefinition_index) THEN sca$report_hard_error ('*** No subdefinition found for ' + subdefinition_name); RETURN FALSE; ELSE subdefinition_array := sca$report_subdefinition_array{i}; subdefinition_level_array := subdefinition_array{1}; subdefinition_label_array := subdefinition_array{2}; subdefinition_option_array := subdefinition_array{3}; subdefinition_query_array := subdefinition_array{4}; subdefinition_info_arrays := subdefinition_array{5}; subdefinition_entity_name_array := subdefinition_array{7}; subdefinition_action_routine_arrays := subdefinition_array{8}; subdefinition_definition_max_index := subdefinition_array{9}; ! Copy subdefinition information to the current definition. ! NOTE - we are currently just copying pointers to the subdefinition ! arrays (for the case where an entry item is an array rather than a ! string or integer) - may want to copy the arrays element-by-element. ! The case where this makes a difference (besides efficiency issues) ! is for modify_query_name. ! i := 0; LOOP i := i + 1; EXITIF i > subdefinition_definition_max_index; sca$report_definition_max_index := sca$report_definition_max_index + 1; sca$report_level_array{sca$report_definition_max_index} := subdefinition_level_array{i} + level_number; sca$report_label_array{sca$report_definition_max_index} := subdefinition_label_array{i}; sca$report_option_array{sca$report_definition_max_index} := subdefinition_option_array{i}; sca$report_query_array{sca$report_definition_max_index} := subdefinition_query_array{i}; sca$report_info_arrays{sca$report_definition_max_index} := subdefinition_info_arrays{i}; sca$report_entity_name_array{sca$report_definition_max_index} := subdefinition_entity_name_array{i}; sca$report_action_routine_arrays{sca$report_definition_max_index} := subdefinition_action_routine_arrays{i}; ENDLOOP; RETURN TRUE; ENDIF; ENDPROCEDURE PROCEDURE sca$report_definition_modify_query (entry_label, query_string, query_index) !++ ! FUNCTIONAL DESCRIPTION: ! ! Modify a specified query string in the current report definition. ! ! FORMAL PARAMETERS: ! ! entry_label ! ! The label on the entry to be modified, as a TPU string. If null, the ! current entry is modified. IN parameter. ! ! query_string ! ! The new query string. IN parameter. ! ! query_index ! ! The index of the query string to be modified. IN parameter. !-- LOCAL entry_index, query_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DEFINITION_MODIFY_QUERY'); ENDON_ERROR; IF entry_label <> '' THEN entry_index := sca$report_definition_entry_lookup (entry_label); IF entry_index = 0 THEN ! The specified entry label doesn't exist - report an error and ! return. ! sca$report_status_message ('*** Cannot update nonexistent entry ' + entry_label); RETURN; ENDIF ELSE entry_index := sca$report_current_definition_index; ENDIF; query_array := sca$report_query_array{entry_index}; query_array{query_index} := query_string; ENDPROCEDURE PROCEDURE sca$report_end_subdefinition !++ ! FUNCTIONAL DESCRIPTION: ! ! End a subdescription entry. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL subdefinition; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_END_SUBDEFINITION'); ENDON_ERROR; subdefinition := CREATE_ARRAY(11); subdefinition{1} := sca$report_level_array; subdefinition{2} := sca$report_label_array; subdefinition{3} := sca$report_option_array; subdefinition{4} := sca$report_query_array; subdefinition{5} := sca$report_info_arrays; subdefinition{7} := sca$report_entity_name_array; subdefinition{8} := sca$report_action_routine_arrays; subdefinition{9} := sca$report_definition_max_index; subdefinition{10} := 0; subdefinition{11} := sca$report_subdefinition_name; sca$report_subdefinition_index := sca$report_subdefinition_index + 1; sca$report_subdefinition_array{sca$report_subdefinition_index} := subdefinition; ENDPROCEDURE !============================================================================ ! Procedures to process report definitions ! ! The following collection of procedures are used for report processing, based ! on the report definition table. ! PROCEDURE sca$report_clear_entry_result (entry_result) !++ ! FUNCTIONAL DESCRIPTION: ! ! Delete all the occurrences of an entry result array. This routine does not ! delete the entry result array itself, since that could interfere with ! subsequent fetch_entry operations for the parent occurrence. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The entry result to be cleared. !-- LOCAL i, occurrence_result; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CLEAR_ENTRY_RESULT'); ENDON_ERROR; ! Delete any remaining occurrences. ! i := 1; LOOP EXITIF i > entry_result{sca$report_k_entry_number_occurrences}; occurrence_result := entry_result{sca$report_k_entry_first_occurrence_offset + i}; IF GET_INFO (occurrence_result, 'TYPE') = ARRAY THEN sca$report_delete_occurrence_result(occurrence_result); ENDIF; i := i + 1; ENDLOOP; ENDPROCEDURE PROCEDURE sca$report_create_entry_result_array (label, level_number) !++ ! FUNCTIONAL DESCRIPTION: ! ! Create a result array for a definition entry. ! ! FORMAL PARAMETERS: ! ! label ! ! The entry label, as a string (or 0 if no label). IN parameter. ! ! level_number ! ! The level number of the current definition entry. IN parameter. ! ! IMPLICIT INPUTS: ! ! sca$report_current_entry_result ! sca$report_current_occurrence_result ! ! IMPLICIT OUTPUTS: ! ! sca$report_current_entry_result !-- LOCAL new_array, sibling; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CREATE_ENTRY_RESULT_ARRAY'); ENDON_ERROR; ! Allocate the new array and link it in. Allow space for an arbitrary ! guess of 10 entities plus overhead fields. ! new_array := CREATE_ARRAY (10 + (sca$report_k_entry_first_occurrence_offset)); ! Initialize easy fields. ! new_array{sca$report_k_entry_level_sibling_link} := 0; new_array{sca$report_k_entry_label} := label; new_array{sca$report_k_entry_level_number} := level_number; new_array{sca$report_k_entry_number_occurrences} := 0; ! Link to parent occurrence. ! new_array{sca$report_k_entry_parent_link} := sca$report_current_occurrence_result; ! Link from parent occurrence (if any) and previous sibling entry (if any). ! IF sca$report_current_occurrence_result <> 0 THEN IF sca$report_current_occurrence_result{sca$report_k_occurrence_sublevel_link} = 0 THEN sca$report_current_occurrence_result{sca$report_k_occurrence_sublevel_link} := new_array; ELSE sibling := sca$report_current_occurrence_result{sca$report_k_occurrence_sublevel_link}; LOOP EXITIF sibling{sca$report_k_entry_level_sibling_link} = 0; sibling := sibling{sca$report_k_entry_level_sibling_link}; ENDLOOP; sibling{sca$report_k_entry_level_sibling_link} := new_array; ENDIF; ENDIF; ! Make this new result array the current entry result array. ! sca$report_current_entry_result := new_array; ENDPROCEDURE PROCEDURE sca$report_create_occurrence_result_array (occurrence_index, n_results) !++ ! FUNCTIONAL DESCRIPTION: ! ! Create a result array for an occurrence. ! ! FORMAL PARAMETERS: ! ! occurrence_index ! ! Index of this occurrence within the query result. IN parameter. ! ! n_results ! ! Number of result values to be stored for this occurrence. IN parameter. ! ! IMPLICIT INPUTS: ! ! sca$report_current_occurrence_result ! ! IMPLICIT OUTPUTS: ! ! sca$report_current_occurrence_result !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CREATE_OCCURRENCE_RESULT_ARRAY'); ENDON_ERROR; ! Allocate the new array and link it in. Allow space for the result values ! plus links to this array's parent and children. ! sca$report_current_occurrence_result := CREATE_ARRAY (n_results + (sca$report_k_occurrence_first_result_offset)); ! Link from parent. ! sca$report_current_entry_result{sca$report_k_entry_first_occurrence_offset + occurrence_index} := sca$report_current_occurrence_result; ! Update occurrence count in parent entry. ! sca$report_current_entry_result{sca$report_k_entry_number_occurrences} := sca$report_current_entry_result{sca$report_k_entry_number_occurrences} + 1; ! Link to parent. ! sca$report_current_occurrence_result{sca$report_k_occurrence_parent_link} := sca$report_current_entry_result; ! Link to children. ! sca$report_current_occurrence_result{sca$report_k_occurrence_sublevel_link} := 0; ENDPROCEDURE PROCEDURE sca$report_delete_occurrence_result (occurrence_result) !++ ! FUNCTIONAL DESCRIPTION: ! ! Delete a result array for an occurrence. ! ! FORMAL PARAMETERS: ! ! occurrence_result ! ! The occurrence result to be deleted. IN parameter. !-- LOCAL parent_entry, temp_entry, temp2_entry; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_DELETE_OCCURRENCE_RESULT'); ENDON_ERROR; ! Delete any remaining subentries. ! temp_entry := occurrence_result{sca$report_k_occurrence_sublevel_link}; LOOP EXITIF temp_entry = 0; sca$report_clear_entry_result (temp_entry); temp_entry{sca$report_k_entry_parent_link} := 0; temp2_entry := temp_entry; temp_entry := temp_entry{sca$report_k_entry_level_sibling_link}; DELETE(temp2_entry); ENDLOOP; ! Clear link to parent. ! occurrence_result{sca$report_k_occurrence_parent_link} := 0; ! Delete the array. ! DELETE (occurrence_result); ENDPROCEDURE PROCEDURE sca$report_fetch_entry (occurrence_result, entry_index) !++ ! FUNCTIONAL DESCRIPTION: ! ! Fetch the indicated sub-entry result array for the specified occurrence ! array. ! ! FORMAL PARAMETERS: ! ! occurrence_result ! ! The occurrence result array. IN parameter. ! ! entry_index ! ! The index of the entry result to be returned. This may either be an ! integer or a string (giving the entry label). IN parameter. ! ! ROUTINE VALUE: ! ! The entry result array requested, or 0 if it does not exist. !-- LOCAL entry_index_upcased, i, temp_entry; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_FETCH_ENTRY'); ENDON_ERROR; temp_entry := occurrence_result{sca$report_k_occurrence_sublevel_link}; IF GET_INFO (entry_index, 'TYPE') = INTEGER THEN i := 1; LOOP EXITIF i = entry_index; EXITIF temp_entry = 0; temp_entry := temp_entry{sca$report_k_entry_level_sibling_link}; i := i + 1; ENDLOOP; ELSE ! entry_index should be a string, giving the entry label. ! entry_index_upcased := CHANGE_CASE (entry_index, UPPER, NOT_IN_PLACE); LOOP EXITIF temp_entry = 0; IF temp_entry{sca$report_k_entry_label} <> 0 THEN EXITIF entry_index_upcased = CHANGE_CASE (temp_entry{sca$report_k_entry_label}, UPPER, NOT_IN_PLACE); ENDIF; temp_entry := temp_entry{sca$report_k_entry_level_sibling_link}; ENDLOOP; ENDIF; IF GET_INFO(temp_entry, 'TYPE') <> ARRAY THEN ! Entry not found - return 0. ! temp_entry := 0; ENDIF; RETURN temp_entry; ENDPROCEDURE PROCEDURE sca$report_fetch_occurrence (entry_result, occurrence_index) !++ ! FUNCTIONAL DESCRIPTION: ! ! Fetch the indicated occurrence result array for the specified entry array. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The entry result array. IN parameter. ! ! occurrence_index ! ! The index of the occurrence result to be returned. ! ! ROUTINE VALUE: ! ! The occurrence result array requested. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_FETCH_OCCURRENCE'); ENDON_ERROR; ! Check for index out of range ! IF occurrence_index > entry_result{sca$report_k_entry_number_occurrences} THEN sca$report_trace_message('*** Occurrence index ' + STR(occurrence_index) + ' does not exist.'); RETURN 0; ENDIF; RETURN entry_result{sca$report_k_entry_first_occurrence_offset + occurrence_index}; ENDPROCEDURE PROCEDURE sca$report_fetch_result (occurrence_array, result_index, result_value) !++ ! FUNCTIONAL DESCRIPTION: ! ! Fetch a result value. ! ! FORMAL PARAMETERS: ! ! occurrence_array ! ! An occurrence result array containing the result. IN parameter. ! ! result_index ! ! The index within the result array where the result value is located. ! This is typically either an integer index or a constant of the form ! "sca$report_location_..." (defined in sca$report_globals.tpu). ! IN parameter. ! ! result_value ! ! The result value fetched. OUT parameter. ! ! ROUTINE VALUE: ! ! None !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_FETCH_RESULT'); ENDON_ERROR; ! Fetch the result value. ! result_value := occurrence_array {sca$report_k_occurrence_first_result_offset + result_index}; ENDPROCEDURE VARIABLE sca$report_temp; PROCEDURE sca$report_form_dynamic_query (current_query) !++ ! FUNCTIONAL DESCRIPTION: ! ! Form a query string for a dynamic query. ! ! FORMAL PARAMETERS: ! ! current_query - the description of the dynamic query, as an array of ! strings. IN parameter. ! ! ROUTINE VALUE: ! ! The resulting query string. !-- LOCAL query_string; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_FORM_DYNAMIC_QUERY'); ENDON_ERROR; query_string := current_query{1}; IF current_query{2} <> '' THEN EXECUTE ('sca$report_temp := ' + current_query{2}); query_string := query_string + sca$report_temp; ENDIF; query_string := query_string + current_query{3}; IF current_query{4} <> '' THEN EXECUTE ('sca$report_temp := ' + current_query{4}); query_string := query_string + sca$report_temp; ENDIF; query_string := query_string + current_query{5}; RETURN query_string; ENDPROCEDURE PROCEDURE sca$report_get_entity_info (entity, info_array) !++ ! FUNCTIONAL DESCRIPTION: ! ! Get attribute information of a specified type for a specified entity, and ! store it. ! ! FORMAL PARAMETERS: ! ! entity ! ! The SCA handle for the given entity. IN parameter. ! ! info_array ! ! Array containing information about what type of information to get and ! where to store it. IN parameter. !-- LOCAL decl_type, decl_class, entity_name, entity_type, file_name, mech, routine_range, sca_status, string_index, tag_text, temp_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_ENTITY_INFO'); ENDON_ERROR; CASE info_array{1} FROM 1 TO sca$report_k_info_type_max [sca$report_k_info_type_name ] : ! Get entity name and store it (as a string) in result location. ! sca$report_get_entity_name (entity, entity_name, sca$report_option_use_source_spelling); sca$report_store_result (info_array{2}, entity_name); [sca$report_k_info_type_name_SCA] : ! Get entity name and store it (as a string) in result location. ! Use the SCA (upcased) spelling - don't get the source file ! spelling. ! sca$report_get_entity_name (entity, entity_name, FALSE); sca$report_store_result (info_array{2}, entity_name); [sca$report_k_info_type_return_value_type] : ! Get routine type and store it (as a string) in result location. ! sca$report_get_routine_type (entity, entity_type); sca$report_store_result (info_array{2}, entity_type); [sca$report_k_info_type_variable_type] : ! Get variable type and store it (as a string) in result location. ! sca$report_get_entity_type (sca$report_current_entity_query_name, entity_type); sca$report_store_result (info_array{2}, entity_type); [sca$report_k_info_type_tag_name] : ! Get tag name for the given (tag) entity and store it (as a string) ! in result location. ! sca$report_get_entity_name (entity, entity_name, sca$report_option_use_source_spelling); IF SUBSTR(entity_name,1,1) = '$' THEN entity_name := SUBSTR(entity_name, 2); ENDIF; sca$report_store_result (info_array{2}, entity_name); [sca$report_k_info_type_tag_text] : ! Get tag text for the given (tag) entity and store it (as a range) ! in result location. ! sca$report_get_entity_name (entity, entity_name, sca$report_option_use_source_spelling); sca$report_get_tag_value (entity, entity_name, tag_text); sca$report_store_result (info_array{2}, tag_text); [sca$report_k_info_type_constant] : ! Store a specified constant value in result location. ! sca$report_store_result (info_array{2}, info_array{3}); [sca$report_k_info_type_source_file] : ! Get the name of the source file where the given entity occurs and ! store it (as a string) in result location. Store only the name ! and extension portions of the file spec. ! sca$get_attri_value_t ( entity, file_name, sca$k_attri_name_file_spec); file_name := FILE_PARSE(file_name,'','',name,type); sca$report_store_result (info_array{2}, file_name); [sca$report_k_info_type_source_location] : ! Get the source location for the given entity and store it (as a ! record, column pair of integers) in result location. ! temp_array := CREATE_ARRAY(2); sca$report_get_attri_value_ul ( entity, temp_array{1}, sca$k_attri_name_record_number); sca$report_get_attri_value_ul ( entity, temp_array{2}, sca$k_attri_name_char_offset); sca$report_store_result (info_array{2}, temp_array); [sca$report_k_info_type_decl_type] : ! Get the occurrence class for the routine declaration (primary or ! associated) and store it (as a string) in result location. ! sca$get_attri_value_t (entity, decl_type, sca$k_attri_occurrence); sca$report_store_result (info_array{2}, decl_type); [sca$report_k_info_type_routine_range] : ! Get the information needed to describe a range representing the ! executable portion of the given (routine) entity, and store it in ! result location. ! routine_range := CREATE_ARRAY(3); ! Find what source file the routine is in. ! sca$get_attri_value_t ( entity, routine_range{1}, sca$k_attri_begin_file_spec); ! Find the beginning of the executable part of the routine. ! sca_status := sca$get_attri_value_t ( entity, routine_range{2}, sca$k_attri_bexe_record_number); IF NOT INT(sca_status) THEN sca_status := sca$get_attri_value_t ( entity, routine_range{2}, sca$k_attri_name_record_number); ENDIF; ! Find the end of the routine. ! sca$get_attri_value_t ( entity, routine_range{3}, sca$k_attri_end_record_number); ! Check for bogus routine range. Report it as an error and fix up ! the routine range to avoid confusion when displaying it. ! IF INT(routine_range{2}) > INT(routine_range{3}) THEN sca$report_status_message ('*** Invalid routine range in file ' + STR(routine_range{1}) ); sca$report_status_message (' Starting line is ' + STR(routine_range{2})); sca$report_status_message (' Ending line is ' + STR(routine_range{3})); routine_range{3} := routine_range{2}; ENDIF; ! Store the range information in the info array for the result. ! sca$report_store_result (info_array{2}, routine_range); [sca$report_k_info_type_decl_class] : ! Get the declaration class for the declaration (language-specific ! text) and store it (as a string) in result location. ! sca$report_get_decl_class (entity, decl_class); sca$report_store_result (info_array{2}, decl_class); [sca$report_k_info_type_mechanism]: ! Get the calling mechanism for a routine parameter and store it ! (as a string) in result location. ! sca_status := sca$get_attri_value_t (entity, mech, sca$k_attri_passing_mechanism); sca$report_store_result (info_array{2}, mech); [INRANGE, OUTRANGE] : sca$report_status_message ('*** Attribute type ' + STR(info_array{1}) + ' is NYI.'); ENDCASE; RETURN; ENDPROCEDURE PROCEDURE sca$report_invoke_action_routine (action_routine_array, invoke_option) !++ ! FUNCTIONAL DESCRIPTION: ! ! Invoke the specified action routine, if it is supposed to be invoked at the ! current step within the processing of the entry. ! ! FORMAL PARAMETERS: ! ! action_routine_array ! ! Array of action routines for the current entry. IN parameter. ! ! invoke_option ! ! Constant value indicating the invoke_option to be matched. ! The possible values for this parameter are given in the file ! sca$report_globals.tpu, and all start with "sca$report_k_invoke_". ! IN parameter. !-- LOCAL action_routine_info, got_action, i; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_INVOKE_ACTION_ROUTINE'); ENDON_ERROR; ! Check whether there is an action routine to be invoked at this point of ! the processing of the current entry. ! i := 1; got_action := FALSE; LOOP EXITIF i > action_routine_array{0}; action_routine_info := action_routine_array{i}; IF action_routine_info{sca$report_k_invoke_option_index} = invoke_option THEN got_action := TRUE; EXITIF; ENDIF; i := i + 1; ENDLOOP; IF got_action THEN ! Check for existence of the action routine before invoking it. ! IF GET_INFO (PROCEDURES, 'DEFINED', action_routine_info{sca$report_k_routine_name_index} ) THEN sca$report_trace_message('Invoking action routine ' + action_routine_info{sca$report_k_routine_name_index}); EXECUTE(action_routine_info{sca$report_k_routine_name_index}); ELSE sca$report_hard_error ('Action routine ' + action_routine_info{sca$report_k_routine_name_index} + ' not found'); sca$report_common_error_cleanup('SCA$REPORT_INVOKE_ACTION_ROUTINE'); ENDIF; ENDIF; ENDPROCEDURE PROCEDURE sca$report_process_definition_entry (current_index, in_occurrence_index) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure processes a single report definition table entry. If the ! entry has sub-entries, they are processed by recursive calls to this ! procedure. ! ! FORMAL PARAMETERS: ! ! current_index ! ! The definition table index of the entry to be processed. This index ! is updated to point to the next entry to be processed (the next entry ! that is not a sub-entry of this entry). IN/OUT parameter. ! ! in_occurrence_index ! ! The occurrence index of the occurrence that is the parent of the entry ! to be processed. IN parameter. !-- LOCAL current_action_routine_array, current_entry_label, current_level, current_query, current_query_string, current_info_array, current_entity, current_entity_name, current_options, current_query_name, dynamic_query, i, info_index, inner_index, occurrence_index, order, query_index, query_status, result_array, saved_entry_result, saved_occurrence_result, saved_open_query_index, sca_status, temp_entity_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_PROCESS_DEFINITION_ENTRY'); ENDON_ERROR; ! Get current entry from each report definition array. ! current_entry_label := sca$report_label_array{current_index}; current_level := sca$report_level_array{current_index}; current_query := sca$report_query_array{current_index}; current_options := sca$report_option_array{current_index}; current_info_array := sca$report_info_arrays{current_index}; current_action_routine_array := sca$report_action_routine_arrays{current_index}; ! Check for once-only option or ignore_entry option. ! IF ( ((current_options AND sca$report_k_option_once_only) <> 0) AND (in_occurrence_index <> 1) ) OR ((current_options AND sca$report_k_option_ignore_entry) <> 0) THEN ! Update definition index to indicate how much of the definition ! has now been processed. ! i := current_index + 1; LOOP ! If we are past the end of the definition, we're done. ! EXITIF i > sca$report_definition_max_index; EXITIF sca$report_level_array{i} <= current_level; i := i + 1; ENDLOOP; current_index := i; RETURN; ENDIF; ! Save the current entry result and occurrence result arrays, so we can ! restore them when we return. ! saved_entry_result := sca$report_current_entry_result; saved_occurrence_result := sca$report_current_occurrence_result; ! Save the current open query index so we know how many queries to delete ! when we are through with this entry. ! saved_open_query_index := sca$report_open_query_index; ! Make the current entry index available to action routines. ! sca$report_current_definition_index := current_index; ! Invoke the before_query action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_before_query); ENDIF; ! Issue current_query_string(s) for this entry. ! query_index := 0; query_status := sca$_nooccur; LOOP ! If no more query strings, exit loop. ! query_index := query_index + 1; EXITIF query_index > current_query{0}; IF current_query{query_index} <> 0 THEN ! If this is a dynamic query, form the actual query string. ! IF GET_INFO (current_query{query_index}, 'TYPE') = STRING THEN current_query_string := current_query{query_index}; ELSE IF GET_INFO (current_query{query_index}, 'TYPE') = ARRAY THEN current_query_string := sca$report_form_dynamic_query (current_query{query_index}); ELSE sca$report_hard_error ('Bad query expression'); ENDIF; ENDIF; ! Issue the query. ! query_status := sca$report_find (current_query_string); ! Save the query name in the list of active queries, so that we can ! delete it later. ! IF INT(query_status) THEN sca$get_current_query (sca$report_command_context, current_query_name); sca$report_open_query_index := sca$report_open_query_index + 1; sca$report_open_queries{sca$report_open_query_index} := current_query_name; ENDIF; ENDIF; ENDLOOP; ! Store query result information, and process sub-levels. ! IF INT(query_status) THEN ! Invoke the after_query action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_after_query); ENDIF; ! Create a result array for this entry. ! sca$report_create_entry_result_array (current_entry_label, current_level); ! Loop over occurrences (unique symbols) within the query. ! occurrence_index := 0; current_entity := 0; LOOP ! Get the next occurrence of the query. ! IF (current_options AND sca$report_k_option_order_lexical) <> 0 THEN order := sca$k_occurrence_order_lexical; ELSE order := sca$k_occurrence_order_default; ENDIF; sca_status := sca$get_occurrence (sca$report_command_context, current_query_name, current_entity, order); sca$report_trace_message ('Get_occurrence status is ' + STR(sca_status) ); ! If there are no further occurrences, stop looping. ! EXITIF NOT INT(sca_status); ! Process this occurrence if we haven't already seen the same name, ! or if we want to process all occurrences, regardless of duplicate ! names. ! IF (sca_status = sca$_newname) OR ( ( (current_options AND sca$report_k_option_newitem) <> 0) AND (sca_status = sca$_newitem) ) OR ( (current_options AND sca$report_k_option_all_occurrences) <> 0) THEN ! Update the occurrence number (used to index into result ! array). ! occurrence_index := occurrence_index + 1; ! Get a query that corresponds to this occurrence, and associate ! the entity name from the description entry with it. ! sca_status := sca$select_occurrence (current_entity, temp_entity_name); current_entity_name := sca$report_entity_name_array{current_index}; IF current_entity_name <> 0 THEN sca$report_find ('MODIFY QUERY NAME ' + current_entity_name); ELSE current_entity_name := temp_entity_name; ENDIF; ! Save the query name in the list of active queries, so that we ! can delete it later. ! sca$report_open_query_index := sca$report_open_query_index + 1; sca$report_open_queries{sca$report_open_query_index} := current_entity_name; ! Make the current entity available to action routines. ! sca$report_current_entity := current_entity; sca$report_current_entity_query_name := current_entity_name; ! Fill in result data for this occurrence (name, type, etc.), if ! any is specified. ! IF current_info_array <> 0 THEN IF current_info_array{0} > 0 THEN sca$report_create_occurrence_result_array (occurrence_index, current_info_array{0}); info_index := 1; LOOP EXITIF info_index > current_info_array{0}; sca$report_get_entity_info (current_entity, current_info_array{info_index} ); info_index := info_index + 1; ENDLOOP; ENDIF; ENDIF; ! Invoke the before_each_entity action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_before_each_entity); ENDIF; ! Loop over lower-level definition entries. ! inner_index := current_index + 1; LOOP ! If we are past the end of the definition, we're done. ! EXITIF inner_index > sca$report_definition_max_index; ! If we have reached an entry with a level number <= the ! level we are working on, we are done with sublevels. ! EXITIF sca$report_level_array{inner_index} <= current_level; ! Process the sublevels. ! sca$report_process_definition_entry (inner_index, occurrence_index); ENDLOOP; ! Invoke the after_each_entity action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_after_each_entity); ENDIF; ! Delete current entity and remove it from the list of open ! queries. ! sca$report_delete_query (current_entity_name); sca$report_open_query_index := sca$report_open_query_index - 1; ENDIF; ENDLOOP; ! Invoke the after_all_entities action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_after_all_entities); ENDIF; ELSE ! Invoke the after_empty_query action routine, if any. ! IF current_action_routine_array <> 0 THEN sca$report_invoke_action_routine (current_action_routine_array, sca$report_k_invoke_after_empty_query); ENDIF; ! Create an empty result array for this description entry. ! sca$report_create_entry_result_array (current_entry_label, current_level); ENDIF; ! Delete query or queries that were created during the processing of the ! current entry. ! LOOP EXITIF sca$report_open_query_index <= saved_open_query_index; sca$report_delete_query (sca$report_open_queries{sca$report_open_query_index}); sca$report_open_query_index := sca$report_open_query_index - 1; ENDLOOP; ! Update definition index to indicate how much of the definition has now ! been processed. ! i := current_index + 1; LOOP ! If we are past the end of the definition, we're done. ! EXITIF i > sca$report_definition_max_index; EXITIF sca$report_level_array{i} <= current_level; i := i + 1; ENDLOOP; current_index := i; ! Restore current entry result and occurrence result. ! sca$report_current_entry_result := saved_entry_result; sca$report_current_occurrence_result := saved_occurrence_result; ENDPROCEDURE PROCEDURE sca$report_process_queries !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the top-level procedure for query processing. It processes the ! entire report definition table. !-- LOCAL current_index; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_PROCESS_QUERIES'); ENDON_ERROR; sca$report_queries_initialize; ! Loop until end of report definition array for this report ! current_index := 1; LOOP EXITIF current_index > sca$report_definition_max_index; sca$report_process_definition_entry (current_index, 1); ENDLOOP; sca$report_queries_cleanup; ENDPROCEDURE PROCEDURE sca$report_queries_initialize !++ ! FUNCTIONAL DESCRIPTION: ! ! Initialization for query processing done during the current report. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! sca$report_command_context ! ! SIDE EFFECTS: ! ! Memory is allocated. !-- LOCAL sca_status; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_QUERIES_INITIALIZE'); ENDON_ERROR; sca$report_command_context := lse$sca_command_context; ! Initialize open queries stack. ! sca$report_open_queries := CREATE_ARRAY(20); sca$report_open_query_index := 0; ! Initialize current result pointers. ! sca$report_current_entry_result := 0; sca$report_current_occurrence_result := 0; ENDPROCEDURE PROCEDURE sca$report_queries_cleanup !++ ! FUNCTIONAL DESCRIPTION: ! ! Clean up related to query processing for the current report. ! ! FORMAL PARAMETERS: ! ! None ! ! SIDE EFFECTS: ! ! Memory is freed. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_QUERIES_CLEANUP'); ENDON_ERROR; ! Delete any open queries and delete open queries stack. ! IF GET_INFO(sca$report_open_queries, 'TYPE') = ARRAY THEN LOOP EXITIF sca$report_open_query_index = 0; sca$report_delete_query (sca$report_open_queries{sca$report_open_query_index}); sca$report_open_query_index := sca$report_open_query_index - 1; ENDLOOP; DELETE(sca$report_open_queries); ENDIF; ! Delete report definition tables. ! IF GET_INFO(sca$report_level_array, 'TYPE') = ARRAY THEN DELETE(sca$report_level_array); ENDIF; IF GET_INFO(sca$report_label_array, 'TYPE') = ARRAY THEN DELETE(sca$report_label_array); ENDIF; IF GET_INFO(sca$report_option_array, 'TYPE') = ARRAY THEN DELETE(sca$report_option_array); ENDIF; IF GET_INFO(sca$report_query_array, 'TYPE') = ARRAY THEN DELETE(sca$report_query_array); ENDIF; IF GET_INFO(sca$report_info_arrays, 'TYPE') = ARRAY THEN DELETE(sca$report_info_arrays); ENDIF; IF GET_INFO(sca$report_entity_name_array, 'TYPE') = ARRAY THEN DELETE(sca$report_entity_name_array); ENDIF; IF GET_INFO(sca$report_action_routine_arrays, 'TYPE') = ARRAY THEN DELETE(sca$report_action_routine_arrays); ENDIF; ! Delete subdefinitions. ! IF GET_INFO (sca$report_subdefinition_index, 'TYPE') <> UNSPECIFIED THEN LOOP EXITIF sca$report_subdefinition_index = 0; sca$report_subdefinition_array{sca$report_subdefinition_index} := 0; sca$report_subdefinition_index := sca$report_subdefinition_index - 1; ENDLOOP; ENDIF; ! Delete any remaining result arrays. ! IF GET_INFO (sca$report_current_entry_result, 'TYPE') = ARRAY THEN LOOP sca$report_clear_entry_result (sca$report_current_entry_result); sca$report_current_occurrence_result := sca$report_current_entry_result{sca$report_k_entry_parent_link}; EXITIF sca$report_current_occurrence_result = 0; sca$report_current_entry_result := sca$report_current_occurrence_result{sca$report_k_occurrence_parent_link}; ! The following line is to catch cases where the report crashes in ! the middle of building a new result array, when the links are not ! yet completely filled in. It should rarely be true. ! EXITIF sca$report_current_entry_result = 0; ENDLOOP; ENDIF; sca$report_current_entry_result := 0; sca$report_current_occurrence_result := 0; ENDPROCEDURE PROCEDURE sca$report_store_result (result_index, result_value) !++ ! FUNCTIONAL DESCRIPTION: ! ! Store information about a query in a result array. ! ! FORMAL PARAMETERS: ! ! result_index ! ! The index within the result array where the result value is to be ! stored. This is typically either an integer index or a constant of the ! form "sca$report_location_..." (defined in sca$report_globals.tpu). ! IN parameter. ! ! result_value ! ! The result value to be stored. IN parameter. ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! A result array is updated. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_STORE_RESULT'); ENDON_ERROR; sca$report_current_occurrence_result{ sca$report_k_occurrence_first_result_offset + result_index} := result_value; ENDPROCEDURE !============================================================================ ! Common action routines ! ! The following procedures are action routines that do processing common to ! all (or at least more than one) report types. ! VARIABLE sca$report_current_decl_class, sca$report_current_parameter_name; PROCEDURE sca$report_cleanup_file !++ ! FUNCTIONAL DESCRIPTION: ! ! Perform cleanup that is commonly done at the end of processing a source ! file. ! ! FORMAL PARAMETERS: ! ! None !-- ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_CLEANUP_FILE'); ENDON_ERROR; ! Delete any buffers containing source files used during the processing of ! this file in order to conserve memory. ! sca$report_flush_file_array; ! Write the report output buffer to a file ! sca$report_write_buffer; ENDPROCEDURE PROCEDURE sca$report_do_comment_filter !++ ! FUNCTIONAL DESCRIPTION: ! ! This action routine decides which of a collection of comments should ! actually be associated with a specified declaration. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL decl_entity, decl_name_line, decl_occurrence_result, end_index, found_closer, i, in_decl_name_line, keep_array, nearby_index, occurrence_result, sca_status, source_position, start_index, tag_entity, tag_entity_query, tag_begin_line, tag_end_line, tag_index, temp_array; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_COMMENT_FILTER'); ENDON_ERROR; ! Get the source position of the declaration. ! decl_occurrence_result := sca$report_current_entry_result{sca$report_k_entry_parent_link}; sca$report_fetch_result (decl_occurrence_result, sca$report_location_source_location, source_position); in_decl_name_line := source_position{1}; ! Find the comments that this declaration is "closest" to, and use them. ! A declaration is "closest" to: ! 1. any comment that has at least part of its text on the same line as ! the declaration name ! ! 2. any comment that has no nearer containing declaration ! ! If there are multiple comments that this declaration is closest to, use ! the one that occurs on the same line as the declaration name. If no ! comments occur on that line, use all the comments that have no nearer ! containing declaration. ! keep_array := CREATE_ARRAY(1); nearby_index := 0; tag_index := 1; tag_entity := 0; LOOP sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TAGS', tag_entity); EXITIF NOT INT(sca_status); ! Find the source location of the tag value. ! sca$report_get_attri_value_ul (tag_entity, tag_begin_line, sca$k_attri_begin_record_number); sca$report_get_attri_value_ul (tag_entity, tag_end_line, sca$k_attri_end_record_number); IF (tag_begin_line <= in_decl_name_line) AND (tag_end_line >= in_decl_name_line) THEN ! At least part of the tag value is on the same line as the ! declaration name. Associate this tag value with the declaration. ! keep_array{1} := tag_index; ELSE ! No part of the tag value is on the same line as the declaration ! name. See whether this declaration is the only one or the closest ! one containing the tag value. ! sca$select_occurrence (tag_entity, tag_entity_query); sca_status := sca$report_find ( 'FIND -name SCA$REPORT_CONTAINING_DECLS ' + 'CONTAINING(@' + tag_entity_query + ',' + 'OCCUR=DECL,RESULT=BEGIN)' ); IF INT(sca_status) THEN decl_entity := 0; found_closer := FALSE; LOOP sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_CONTAINING_DECLS', decl_entity); EXITIF NOT INT(sca_status); ! Find the source location of the name for this declaration. ! sca$report_get_attri_value_ul (decl_entity, decl_name_line, sca$k_attri_name_record_number); IF decl_name_line <> in_decl_name_line THEN ! Find out if this name is closer to the comment than ! the input declaration. This name is closer if it ! occurs on the same line as part of the comment, or if ! it lies between the input declaration name and the ! comment. ! IF (tag_begin_line <= decl_name_line) AND (tag_end_line >= decl_name_line) THEN found_closer := TRUE; ENDIF; IF (in_decl_name_line < decl_name_line) AND (decl_name_line < tag_begin_line) THEN found_closer := TRUE; ENDIF; IF (in_decl_name_line > decl_name_line) AND (decl_name_line > tag_begin_line) THEN found_closer := TRUE; ENDIF; EXITIF found_closer; ENDIF; ENDLOOP; IF NOT found_closer THEN IF nearby_index = 0 THEN nearby_index := 2 ELSE nearby_index := nearby_index + 1; ENDIF; keep_array{nearby_index} := tag_index; ENDIF; ENDIF; sca$report_delete_query ('SCA$REPORT_CONTAINING_DECLS'); sca$report_delete_query (tag_entity_query); ENDIF; tag_index := tag_index + 1; ENDLOOP; ! Now decide which comments to keep ! IF keep_array{1} <> tpu$k_unspecified THEN start_index := 1; end_index := 1; ELSE start_index := 2; end_index := nearby_index; IF start_index > end_index THEN RETURN ENDIF; ENDIF; temp_array := CREATE_ARRAY((end_index - start_index) + 1); i := start_index; temp_index := 1; LOOP EXITIF i > end_index; temp_array{temp_index} := sca$report_fetch_occurrence(sca$report_current_entry_result, keep_array{i} ); sca$report_current_entry_result{ sca$report_k_entry_first_occurrence_offset + keep_array{i}} := 0; i := i + 1; temp_index := temp_index + 1; ENDLOOP; i := 1; LOOP EXITIF i > sca$report_current_entry_result{sca$report_k_entry_number_occurrences}; occurrence_result := sca$report_fetch_occurrence (sca$report_current_entry_result, i); IF occurrence_result <> 0 THEN sca$report_delete_occurrence_result (occurrence_result); ENDIF; i := i + 1; ENDLOOP; i := 1; LOOP EXITIF i > (end_index - start_index) + 1; sca$report_current_entry_result{sca$report_k_entry_first_occurrence_offset + i} := temp_array{i}; i := i + 1; ENDLOOP; sca$report_current_entry_result{sca$report_k_entry_number_occurrences} := (end_index - start_index) + 1; RETURN ENDPROCEDURE PROCEDURE sca$report_do_file_setup_all !++ ! FUNCTIONAL DESCRIPTION: ! ! Action routine invoked for each entity within the files query. ! This routine fills in the query strings for the module and non-module ! queries to be issued for the current file. The resulting queries will ! find all the primary (or for Ada, all primary and associated) declarations ! of compilation units within the current source file. ! This file also fills in global variables for the current source file, as a ! convenience for later action routines: sca$report_current_file, ! sca$report_current_language_SCA, sca$report_current_language_LSE. ! ! FORMAL PARAMETERS: ! ! None ! ! SIDE EFFECTS: ! ! Report definition entries for 'modules entry', 'nonmodules entry', ! and 'module routines entry' are updated. !-- LOCAL file_name, language_name, modules_query, nonmodules_query, routines_query; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_DO_FILE_SETUP_ALL'); ENDON_ERROR; ! Select appropriate query strings, based on language of current file. ! sca$report_get_language (sca$report_current_entity, language_name); IF language_name = 'ADA' THEN sca$report_current_decl_class := '(PRIMARY,ASSOCIATED)'; ELSE sca$report_current_decl_class := 'PRIMARY'; ENDIF; ! Fetch the name of the current file. ! sca$report_fetch_result (sca$report_current_occurrence_result, sca$report_location_file_name, sca$report_current_file); ! Make current file name and language easily available to subsequent action ! routines. ! sca$report_current_language_SCA := language_name; ! Specify whether declaration class information should be included in the ! report. We disable this for BLISS and BASIC because the declaration ! class description doesn't contribute any new information. ! IF (language_name = 'BLISS') OR (language_name = 'BASIC') THEN sca$report_option_decl_class_modules := False; sca$report_option_decl_class_routines := False; ELSE sca$report_option_decl_class_modules := True; sca$report_option_decl_class_routines := True; ENDIF; sca$report_status_message ('--- Processing file ' + sca$report_current_file + ' ---'); ENDPROCEDURE PROCEDURE sca$report_do_file_setup_specs !++ ! FUNCTIONAL DESCRIPTION: ! ! Action routine invoked for each entity within the files query. ! This routine fills in the query strings for the module and non-module ! queries to be issued for the current file. The resulting queries will ! find all the primary (or for Ada, all associated) declarations of ! compilation units within the current source file. ! ! This file also fills in global variables for the current source file, as a ! convenience for later action routines: sca$report_current_file, ! sca$report_current_language_SCA, sca$report_current_language_LSE. ! ! FORMAL PARAMETERS: ! ! None ! ! SIDE EFFECTS: ! ! Report definition entries for 'modules entry', 'nonmodules entry', and ! 'routines entry' are updated. !-- LOCAL file_name, language_name, modules_query, nonmodules_query, routines_query; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_DO_FILE_SETUP_SPECS'); ENDON_ERROR; ! Select appropriate query strings, based on language of current file. ! sca$report_get_language (sca$report_current_entity, language_name); IF language_name = 'ADA' THEN sca$report_current_decl_class := 'ASSOCIATED'; ELSE sca$report_current_decl_class := 'PRIMARY'; ENDIF; ! Append the name of the current file to the query strings. ! sca$report_fetch_result (sca$report_current_occurrence_result, sca$report_location_file_name, sca$report_current_file); ! Make current file name and language easily available to subsequent action ! routines. ! sca$report_current_language_SCA := language_name; ! Specify whether declaration class information should be included in the ! report. We disable this for BLISS and BASIC because the declaration ! class description doesn't contribute any new information. ! IF (language_name = 'BLISS') OR (language_name = 'BASIC') THEN sca$report_option_decl_class_modules := False; sca$report_option_decl_class_routines := False; ELSE sca$report_option_decl_class_modules := True; sca$report_option_decl_class_routines := True; ENDIF; sca$report_status_message ('--- Processing file ' + sca$report_current_file + ' ---'); ENDPROCEDURE PROCEDURE sca$report_do_routine_setup !++ ! FUNCTIONAL DESCRIPTION: ! ! Action routine invoked for each entity within the routines query. This ! routine issues a status message for the current routine. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL routine_name; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_DO_ROUTINE_SETUP'); ENDON_ERROR; sca$report_fetch_result (sca$report_current_occurrence_result, sca$report_location_routine_name, routine_name); sca$report_status_message('--- Processing routine ' + routine_name + ' ---'); RETURN; ENDPROCEDURE PROCEDURE sca$report_setup_file_query !++ ! FUNCTIONAL DESCRIPTION: ! ! Action routine invoked before issuing the files query. ! This routine fills in the query string for the top-level (find all files) ! query of the report. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! sca$report_domain_query !-- ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_SETUP_FILE_QUERY'); ENDON_ERROR; IF sca$report_domain_query <> '' THEN ! Process all files encompassed by the /DOMAIN qualifier on the current ! REPORT command. ! sca$report_definition_modify_query ( 'files entry', 'FIND @SCA$REPORT_DOMAIN AND SYMBOL=FILE AND OCCURRENCE=COMMAND', 1); ELSE ! Process all 'command line' files in the entire SCA library. ! sca$report_definition_modify_query ( 'files entry', 'FIND SYMBOL=FILE AND OCCURRENCE=COMMAND', 1); ENDIF; ENDPROCEDURE PROCEDURE sca$report_setup_parameter_subtag_query !++ ! FUNCTIONAL DESCRIPTION: ! ! Action routine invoked for each parameter of a routine. ! This routine stores the name of the current parameter in the global ! variable sca$report_current_parameter_name. This name is used to form a ! dynamic query to find the FORMAL PARAMETERS subtag (if any) for the ! parameter. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL parameter_name; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_SETUP_PARAMETER_SUBTAG_QUERY'); ENDON_ERROR; ! Fetch the current parameter name, using the SCA (upcased) spelling. ! sca$report_fetch_result (sca$report_current_occurrence_result, sca$report_location_parameter_name_SCA, sca$report_current_parameter_name); ! If the parameter name is null, don't form any query. This happens when ! there are optional parameters at the end of the parameter list, for ! example (e.g., in C: void func (int a,...) ). ! IF sca$report_current_parameter_name = "" THEN sca$report_definition_modify_query ( '', 0, 1); ELSE sca$report_definition_modify_query ( '', sca$report_k_query_parameter_one_subtag + '"' + sca$report_current_parameter_name + '"', 1); ENDIF; RETURN; ENDPROCEDURE VARIABLE sca$report_option_routine_depth; PROCEDURE sca$report_setup_routine_nesting !++ ! FUNCTIONAL DESCRIPTION: ! ! This action routine fills in the global variable sca$report_nesting_part ! appropriately, depending on the value of the routine_depth value. ! ! NOTE: This procedure assumes that the routine_depth option has been ! processed successfully, and that its value is either a string ! representing an integer > 0, or the string 'ALL'. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL temp_depth; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_SETUP_ROUTINE_NESTING'); ENDON_ERROR; IF sca$report_option_routine_depth = '1' THEN sca$report_nesting_part := ''; ELSE IF sca$report_option_routine_depth = 'ALL' THEN temp_depth := sca$report_option_routine_depth ELSE temp_depth := STR ( INT(sca$report_option_routine_depth) - 1); ENDIF; sca$report_nesting_part := ' OR CONTAINED_BY(@SCA$REPORT_CURRENT_MODULE,' + 'SYMBOL=ROUTINE AND OCCUR=PRIMARY,' + 'DEPTH=' + temp_depth + ',' + 'TRACE=(SYMBOL=ROUTINE AND OCCUR=PRIMARY),' + 'RESULT=BEGIN)'; ENDIF; ENDPROCEDURE !============================================================================ ! SCA interface procedures PROCEDURE sca$report_delete_query (query_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure deletes a specified query. ! ! FORMAL PARAMETERS: ! ! query_name ! ! A string containing the query name. IN parameter. ! ! ROUTINE VALUE: ! ! The status returned from the (SCA) DELETE QUERY operation. !-- LOCAL sca_status; ON_ERROR [OTHERWISE]: sca$report_status_message ('*** Unable to delete query ' + query_name); RETURN; ! sca$report_common_error_cleanup('SCA$REPORT_DELETE_QUERY'); ENDON_ERROR; ! Note: we don't need to set the SCA command language to portable, because ! the DELETE QUERY syntax is the same for portable and VMS styles. sca$report_trace_message ('Deleting query: ' + query_name); sca_status := sca$do_command (sca$report_command_context, 'DELETE QUERY ' + query_name); sca$report_trace_message (' Complete, status is ' + STR(sca_status) ); RETURN sca_status; ENDPROCEDURE PROCEDURE sca$report_find (query_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure issues a FIND for the specified query expression. ! ! FORMAL PARAMETERS: ! ! query_string ! ! A string containing the query expression. IN parameter. ! ! ROUTINE VALUE: ! ! The status returned from the (SCA) FIND operation. !-- LOCAL begin_time, elapsed_time_bin, elapsed_time_str, end_time, saved_comm_lang, sca_status; ON_ERROR ! Intercept expected non-success status codes, to prevent 'No ! occurrences' message from appearing. (nosymbolx is the status we ! expect most often.) ! [sca$_nooccur] : ; [sca$_nosymoccurx] : ; [sca$_nosymbol] : ; [sca$_nosymbolx] : ; ! Intercept status indicating that the current query relies on a ! non-existent query. This can happen if a no-result query is empty. ! [sca$_noqueryexists] : ; [OTHERWISE]: IF saved_comm_lang <> '' THEN sca$do_command (sca$report_command_context, 'SET COMM LANG ' + saved_comm_lang); ENDIF; sca$report_common_error_cleanup('SCA$REPORT_FIND'); ENDON_ERROR; saved_comm_lang := ''; IF NOT sca$report_invoked_via_portable THEN saved_comm_lang := 'VMS'; sca$do_command (sca$report_command_context, 'SET COMM LANG PORT'); ENDIF; ! If there is a "/" in the query string, assume that it's using VMS-style ! syntax, and set the command langage to VMS. ! IF INDEX (query_string, '/') <> 0 THEN IF sca$report_invoked_via_portable THEN saved_comm_lang := 'PORT'; ENDIF; sca$do_command (sca$report_command_context, 'SET COMM LANG VMS'); ENDIF; sca$report_trace_message ('Query: ' + query_string); begin_time := FAO('!%T',0); sca_status := sca$do_command (sca$report_command_context, query_string); end_time := FAO('!%T',0); sca$report_trace_message (' Complete, status is ' + STR(sca_status) ); IF saved_comm_lang <> '' THEN sca$do_command (sca$report_command_context, 'SET COMM LANG ' + saved_comm_lang); ENDIF; sca$report_get_elapsed_time (begin_time, end_time, elapsed_time_bin, elapsed_time_str); ticks := ' '; IF elapsed_time_bin > 100 THEN ticks := ticks + '<<' ENDIF; IF elapsed_time_bin > 1000 THEN ticks := ticks + '<<' ENDIF; IF elapsed_time_bin > 10000 THEN ticks := ticks + '<<' ENDIF; sca$report_trace_message ( ' Elapsed time for query is ' + elapsed_time_str + ticks); RETURN sca_status; ENDPROCEDURE PROCEDURE sca$report_find_file (file_name, resulting_file_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! Find a specified source file. This functionality is in its own ! procedure so that we can easily handle errors that occur in attempting ! to locate the file (bad filespec, no such device, etc.). ! ! NOTE: This procedure is now obsolete, and is kept only for backward ! compatibility. The equivalent functionality (and more) is now provided ! by the procedure sca$report_get_file. ! ! FORMAL PARAMETERS: ! ! file_name - the source file name (full filespec). IN parameter. ! resulting_file_name - the resulting file name (full filespec). ! OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if the file was found, FALSE otherwise. !-- LOCAL save_traceback; ON_ERROR [OTHERWISE]: ! Handle file_search errors. This should be just for RMS errors ! from the open (e.g., bad directory in file spec). ! sca$report_status_message ('*** Unable to open source file: "' + file_name + '"'); sca$report_bad_files := sca$report_bad_files + file_name + ' '; IF save_traceback THEN SET (TRACEBACK, ON); ENDIF; RETURN FALSE; ENDON_ERROR; IF GET_INFO (sca$report_bad_files, 'TYPE') = UNSPECIFIED THEN sca$report_bad_files := ' '; ENDIF; ! If we already tried to open this file and failed, return quietly - an ! error message has already been displayed about this file. ! IF INDEX (sca$report_bad_files, ' ' + file_name + ' ') <> 0 THEN RETURN FALSE; ENDIF; save_traceback := GET_INFO (SYSTEM, "traceback"); SET (LINE_NUMBER, OFF); resulting_file_name := FILE_SEARCH(file_name); IF resulting_file_name = '' THEN ! Handle file-not-found error from file_search. If the file spec itself ! is bad, that will be signalled and handled by the ON_ERROR block. ! sca$report_status_message ('÷³*** Unable to open source file: "' + file_name + '"'); sca$report_bad_files := sca$report_bad_files + file_name + ' '; IF save_traceback THEN SET (TRACEBACK, ON); ENDIF; RETURN FALSE; ENDIF; ! Clear out FILE_SEARCH for the next time. ! LOOP EXITIF FILE_SEARCH(file_name) = '' ENDLOOP; IF save_traceback THEN SET (TRACEBACK, ON); ENDIF; RETURN TRUE; ENDPROCEDURE PROCEDURE sca$report_follow_type_ref (entity, return_string) !++ ! FUNCTIONAL DESCRIPTION: ! ! Given an occurrence, try to get type information for it by expanding it ! and getting the name/decl class of the corresponding declaration. ! ! FORMAL PARAMETERS: ! ! entity - type entity that has no name or decl class associated with it. ! Normally, this is a reference node. IN parameter. ! ! return_string - type description. IN/OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if type information was found, FALSE if not. !-- LOCAL sca_status, type_entity, type_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('sca$report_follow_type_ref'); ENDON_ERROR; sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_XXX ' + 'EXPAND(@' + sca$report_current_type_query_name + ') AND ' + 'OCCURRENCE=DECL' ); IF NOT INT(sca_status) THEN RETURN FALSE; ENDIF; type_entity := 0; sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_XXX', type_entity); sca$report_get_entity_name (type_entity, type_name, sca$report_option_use_source_spelling); IF type_name <> '' THEN return_string := type_name; ELSE sca_status := sca$get_attri_value_t (type_entity, return_string, sca$k_attri_decl_class); ENDIF; sca$report_delete_query ('SCA$REPORT_TYPE_XXX'); RETURN TRUE; ENDPROCEDURE PROCEDURE sca$report_get_anonymous_type (type_entity_in, type_description) LOCAL decl_class, depth, is_name, keep_going, sca_status, string_index, sub_decl_class, temp_entity_name, temp_entity, type_entity, type_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('sca$report_get_anonymous_type'); ENDON_ERROR; type_entity := type_entity_in; depth := 0; LOOP sca$report_get_name_or_decl_class (type_entity, type_name, is_name); IF is_name THEN type_description := type_description + ' ' + type_name; EXITIF TRUE; ELSE ! This is an anonymous type - keep going. decl_class := type_name; ENDIF; ! Add this decl class information to the type description. ! IF type_description <> '' THEN type_description := type_description + ' '; ENDIF; IF (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "pointer") OR (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "access type") THEN keep_going := sca$report_type_pointer (decl_class, depth, type_description); ELSE IF (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "array") OR (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "table") OR (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "tree") THEN keep_going := sca$report_type_array (decl_class, depth, type_description); ELSE IF (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "function") OR (CHANGE_CASE (decl_class, LOWER, NOT_IN_PLACE) = "void function") THEN keep_going := sca$report_type_function (decl_class, depth, type_description); ELSE type_description := type_description + decl_class; keep_going := FALSE; ENDIF; ENDIF; ENDIF; EXITIF NOT keep_going; ! Get the type of the next level down (component type, return value ! type, etc.) ! sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_' + STR(depth+1) + ' ' + 'TYPING (@SCA$REPORT_TYPE_' + STR(depth) + ' AND OCCURRENCE=DECL,' + 'DEPTH=1, RESULT=BEGIN)' ); EXITIF NOT INT(sca_status); depth := depth + 1; sca$report_current_type_query_name := 'SCA$REPORT_TYPE_'+STR(depth); type_entity := 0; sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_'+STR(depth), type_entity); EXITIF NOT INT(sca_status); ENDLOOP; ! Delete all the queries that were created in the loop ! LOOP EXITIF depth = 0; sca$report_delete_query ('SCA$REPORT_TYPE_' + STR(depth)); depth := depth - 1; ENDLOOP; ENDPROCEDURE PROCEDURE sca$report_get_attri_value_ul( attribute_handle, attribute_value; attribute_kind) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure gets a specified attribute value for an entity or attribute ! and converts it from a string to an integer. ! ! FORMAL PARAMETERS: ! ! attribute_handle ! ! The SCA handle for the entity or attribute. IN parameter. ! ! attribute_value ! ! Attribute value returned. OUT parameter. ! ! attribute_kind ! ! (Optional) Attribute kind. IN parameter. ! ! ROUTINE VALUE: ! ! The status returned from the (SCA) get_attri_value_t operation used to get ! the attribute value. !-- LOCAL attribute_value_string, sca_status; ON_ERROR [OTHERWISE] : MESSAGE('Error occurred in SCA builtin: '); MESSAGE(ERROR); sca$report_common_error_cleanup('SCA$REPORT_GET_ATTRI_VALUE_UL'); ENDON_ERROR; ! Check to see whether the last parameter, which is optional, was provided. ! IF GET_INFO(attribute_kind,'TYPE') = UNSPECIFIED THEN sca_status := sca$$q_get_attr_val_t( attribute_handle, attribute_value_string) ELSE sca_status := sca$$q_get_attr_val_t ( attribute_handle, attribute_value_string, attribute_kind); IF NOT INT(sca_status) THEN attribute_value_string := '0'; ENDIF; ENDIF; attribute_value := INT(attribute_value_string); RETURN sca_status; ENDPROCEDURE PROCEDURE sca$report_get_decl_class (entity, decl_class) !++ ! FUNCTIONAL DESCRIPTION: ! ! Get the declaration class of a given entity. Strip off "uninteresting" ! text from the declaration class string, and return it. ! ! FORMAL PARAMETERS: ! ! entity - the entity to be processed. IN parameter. ! decl_class - the decl class, as a string. OUT parameter. ! ! ROUTINE VALUE: ! ! None !-- LOCAL sca_status, string_index; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('sca$report_get_decl_class'); ENDON_ERROR; sca_status := sca$get_attri_value_t (entity, decl_class, sca$k_attri_decl_class); IF NOT INT(sca_status) THEN sca_status := sca$report_follow_type_ref (entity, decl_class); ENDIF; ! Strip off trailing "(hidden)", "declaration", "definition", "tag" and ! white space (if present). ! decl_class := EDIT(decl_class, TRIM); IF INDEX (decl_class, '(hidden)') <> 0 THEN string_index := INDEX (decl_class, '(hidden)'); IF string_index + LENGTH('(hidden)') - 1 = LENGTH(decl_class) THEN decl_class := SUBSTR (decl_class, 1, string_index-1); decl_class := EDIT(decl_class, TRIM); ENDIF; ENDIF; IF INDEX (decl_class, 'declaration') <> 0 THEN string_index := INDEX (decl_class, 'declaration'); IF string_index + LENGTH('declaration') - 1 = LENGTH(decl_class) THEN decl_class := SUBSTR (decl_class, 1, string_index-1); decl_class := EDIT(decl_class, TRIM); ENDIF; ENDIF; IF INDEX (decl_class, 'definition') <> 0 THEN string_index := INDEX (decl_class, 'definition'); IF string_index + LENGTH('definition') - 1 = LENGTH(decl_class) THEN decl_class := SUBSTR (decl_class, 1, string_index-1); decl_class := EDIT(decl_class, TRIM); ENDIF; ENDIF; IF INDEX (decl_class, 'tag') <> 0 THEN string_index := INDEX (decl_class, 'tag'); IF string_index + LENGTH('tag') - 1 = LENGTH(decl_class) THEN decl_class := SUBSTR (decl_class, 1, string_index-1); decl_class := EDIT(decl_class, TRIM); ENDIF; ENDIF; decl_class := EDIT(decl_class, TRIM); ENDPROCEDURE PROCEDURE sca$report_get_entity_name (entity, entity_name; from_source) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns the name of an entity. ! ! FORMAL PARAMETERS: ! ! entity ! ! The entity whose name we want. IN parameter. ! ! entity_name ! ! The name of the entity, as a TPU string value. OUT parameter. ! ! from_source ! ! If FALSE or UNSPECIFIED (omitted), the name is taken directly from ! SCA. If TRUE, the name is taken from the source file, if possible. ! Optional IN parameter. !-- LOCAL entity_appearance, get_from_source, saved_position, source_entity_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_ENTITY_NAME'); ENDON_ERROR; IF from_source = tpu$k_unspecified THEN get_from_source := FALSE; ELSE get_from_source := from_source; ENDIF; sca$get_attri_value_t (entity, entity_name, sca$k_attri_name); ! Check whether the name of this entity is visible. ! sca$get_attri_value_t (entity, entity_appearance, sca$k_attri_appearance); CHANGE_CASE (entity_appearance, UPPER); IF entity_appearance = 'HIDDEN' THEN get_from_source := FALSE; ENDIF; IF NOT get_from_source THEN RETURN; ENDIF; start_entity := sca$report_get_source_position (entity, 'NAME'); IF start_entity = '' THEN ! There is no NAME lexical information. Return the name that SCA gave ! us. RETURN; ENDIF; saved_position := MARK(FREE_CURSOR); POSITION(start_entity); source_entity_name := SUBSTR(CURRENT_LINE, CURRENT_OFFSET + 1,LENGTH(entity_name)); ! Sanity check - if the source spelling is not a possible spelling of the ! name in the SCA library, then use the name from the SCA library. ! IF CHANGE_CASE (source_entity_name,UPPER,NOT_IN_PLACE) = CHANGE_CASE (entity_name,UPPER,NOT_IN_PLACE) THEN entity_name := source_entity_name; ENDIF; POSITION(saved_position); RETURN ENDPROCEDURE VARIABLE sca$report_current_type_query_name; PROCEDURE sca$report_get_entity_type (entity_query_name, type_description) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns the type of an entity, as computed by the TYPING ! relationship. For anonymous structured types, a string describing the ! type is returned. ! ! FORMAL PARAMETERS: ! ! entity_query_name ! ! The query name of the entity. This may be either a declaration or a ! reference occurrence. IN parameter. ! ! type_name ! ! The type of the entity, as a TPU string value. OUT parameter. ! ! NOTES: ! ! for arrays, interesting decl_class values are: ! array ! array component ! array index ! COBOL uses "table" rather than "array". SCAN uses "tree". ! ! for record, decl_classes for a record type are: ! record ! structure ! struct tag definition (for C) ! union tag definition (for C) ! data (for COBOL) ! union (for FORTRAN) ! ! pointer decl classes are "pointer", "access type" ! ! function decl classes (for C only?) are function, void function. ! function components are: ! function parameter ! function return value !-- LOCAL type_name, sca_status, type_entity, type_query; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_ENTITY_TYPE_AS_STRUCT'); ENDON_ERROR; type_description := ''; sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_0 ' + 'TYPING (EXPAND(@' + entity_query_name + ') AND OCCURRENCE=DECL,' + 'DEPTH=1, RESULT=BEGIN)' ); sca$report_current_type_query_name := 'SCA$REPORT_TYPE_0'; IF INT(sca_status) THEN type_entity := 0; sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_0', type_entity); IF INT(sca_status) THEN sca$report_get_entity_name (type_entity, type_name, sca$report_option_use_source_spelling); IF type_name = '' THEN sca$report_get_anonymous_type (type_entity, type_description); ELSE type_description := type_name; ENDIF; ENDIF; sca$report_delete_query ('SCA$REPORT_TYPE_0'); sca$report_trace_message ( ' ' + 'returning type ' + type_description); ENDIF; ENDPROCEDURE PROCEDURE sca$report_get_file (file_name, buffer_name, resulting_buffer) !++ ! FUNCTIONAL DESCRIPTION: ! ! Find and load a specified source file. This is a lower-level ! procedure used by sca$report_get_source_file. It is a separate ! procedure so that we can easily handle errors that occur in attempting ! to load the file (bad filespec, no such device, etc.). ! ! FORMAL PARAMETERS: ! ! file_name - the source file name (full filespec). IN parameter. ! buffer_name - name of the buffer to be created to hold the file. IN parameter. ! resulting_buffer - the buffer created to hold the file. OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if the file was found, FALSE otherwise. !-- LOCAL local_file_name, open_ok; ON_ERROR [TPU$_OPENIN, LSE$_COMMANDCANCEL, LSE$_FILEOPENFAIL]: open_ok := FALSE; [OTHERWISE]: ! If a buffer got created, delete it. ! IF GET_INFO (resulting_buffer, 'TYPE') = BUFFER THEN DELETE (resulting_buffer); ENDIF; sca$report_common_error_cleanup('sca$report_get_file'); ENDON_ERROR; IF GET_INFO (sca$report_bad_files, 'TYPE') = UNSPECIFIED THEN sca$report_bad_files := ' '; ENDIF; ! If we already tried to open this file and failed, return quietly - an ! error message has already been displayed about this file. ! IF INDEX (sca$report_bad_files, ' ' + file_name + ' ') <> 0 THEN RETURN FALSE; ENDIF; ! Try to load the file, using the full file spec specified. ! open_ok := TRUE; resulting_buffer := LSE$CREATE_BUFFER (buffer_name, file_name, eve$default_buffer, ! Defaults buffer tpu$k_unspecified, ! Journal file name off); ! don't create the file IF NOT open_ok THEN ! Give message indicating SET SOURCE list is being used to find the ! file. ! sca$report_status_message ('*** ' + MESSAGE_TEXT (lse$_notorigfil, 0, file_name) ); sca$report_status_message ('*** ' + MESSAGE_TEXT (lse$_usesource) ); ! If a buffer got created, delete it. ! IF GET_INFO (resulting_buffer, 'TYPE') = BUFFER THEN SET (LSE$MAX_UNDO,resulting_buffer, 0); DELETE (resulting_buffer); ENDIF; ! Try again with just file_name.ext part of filespec. ! local_file_name := FILE_PARSE (file_name, "", "", NAME, TYPE); open_ok := TRUE; resulting_buffer := LSE$CREATE_BUFFER (buffer_name, local_file_name, eve$default_buffer, ! Defaults buffer tpu$k_unspecified, ! Journal file name off); ! don't create the file IF NOT open_ok THEN ! Handle file-not-opened errors. ! sca$report_status_message ('*** ' + ERROR_TEXT ); sca$report_bad_files := sca$report_bad_files + file_name + ' '; ! If a buffer got created, delete it. ! IF GET_INFO (resulting_buffer, 'TYPE') = BUFFER THEN SET (LSE$MAX_UNDO,resulting_buffer, 0); DELETE (resulting_buffer); ENDIF; RETURN FALSE; ENDIF; ENDIF; SET (LSE$MAX_UNDO,resulting_buffer, 0); RETURN TRUE; ENDPROCEDURE PROCEDURE sca$report_get_language (entity, language_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure determines the language associated with a given entity. ! ! FORMAL PARAMETERS: ! ! entity ! ! The entity whose language is needed. IN parameter. ! ! language_name ! ! A string containing the (upcased) language name. OUT parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_LANGUAGE'); ENDON_ERROR; sca$get_attri_value_t ( entity, language_name, sca$k_attri_language); CHANGE_CASE (language_name, UPPER); RETURN; ENDPROCEDURE PROCEDURE sca$report_get_name_or_decl_class (entity, return_string, is_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! Get the name of a given (type) entity. If it is anonymous (has no name), ! get its declaration class. ! ! FORMAL PARAMETERS: ! ! entity - the entity to be processed. IN parameter. ! return_string - the name or decl class, as a string. OUT parameter. ! is_name - TRUE if the entity's name is returned, FALSE if its decl class is ! returned. OUT parameter. !-- LOCAL sca_status, string_index, type_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('sca$report_get_name_or_decl_class'); ENDON_ERROR; ! Get the type name, if there is one. ! sca$report_get_entity_name (entity, type_name, sca$report_option_use_source_spelling); IF type_name <> '' THEN is_name := TRUE; return_string := type_name; ELSE is_name := FALSE; sca$report_get_decl_class (entity, return_string); ENDIF; ENDPROCEDURE PROCEDURE sca$report_get_routine_type (routine_entity, type_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns the type of a routine, as computed by the TYPING ! relationship. ! ! FORMAL PARAMETERS: ! ! routine_entity ! ! The routine entity. This must be a declaration occurrence (not a ! reference occurrence). IN parameter. ! ! type_name ! ! The type of the routine, as a TPU string value. OUT parameter. ! ! DESIGN: ! ! The return value type of a routine is stored in the SCA database like ! this: ! routine declaration ! TYPE -> return value declaration ! ! return value declaration ! TYPE -> reference node ! ! reference node ! DECL -> type declaration ! lexlocs -> source location of reference to type name (within ! the routine declaration) ! ! type declaration ! NAME = type name ! ! So the queries we make are: ! q1 = FIND TYPING (routine, NOT SYMBOL=ARGUMENT, depth=1,...) ! (should yield a declaration occurrence for the return value) ! q2 = FIND TYPING (@q1, depth=1,...) ! (should yield a REFERENCE occurrence) ! get the name-lexloc and/or name attribute for q2 !-- LOCAL q1_entity, q1_entity_query, q2_entity, sca_status; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_ROUTINE_TYPE'); ENDON_ERROR; ! Initialize type name to null. This is what we return if we can't find ! a type name for the routine. ! type_name := ''; ! SCA considers the type of a routine to include the arguments to the ! routine. We're only interested in the type of the return value, so we ! exclude arguments from the following query. ! sca_status := sca$report_find ( 'FIND -name SCA$REPORT_ROUTINE_TYPE ' + 'TYPING (@SCA$REPORT_CURRENT_ROUTINE,' + 'NOT SYMBOL=ARGUMENT, DEPTH=1, RESULT=BEGIN)' ); IF INT(sca_status) THEN ! We found a return value declaration for the routine. Next we need ! to find its type, which should be a reference occurrence. ! q1_entity := 0; sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_ROUTINE_TYPE', q1_entity); IF INT (sca_status) THEN sca$select_occurrence (q1_entity, q1_entity_query); sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_0 ' + 'TYPING(@' + q1_entity_query + ',DEPTH=1,RESULT=BEGIN)' ); sca$report_delete_query (q1_entity_query); IF INT(sca_status) THEN ! We found the reference node - now find the name of the type ! that it points to. ! q2_entity := 0; sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_0', q2_entity); sca$report_current_type_query_name := 'SCA$REPORT_TYPE_0'; sca$report_get_entity_name ( q2_entity, type_name, sca$report_option_use_source_spelling); IF type_name = '' THEN sca$report_get_anonymous_type (q2_entity, type_name); ENDIF; sca$report_delete_query ('SCA$REPORT_TYPE_0'); ENDIF; ENDIF; sca$report_delete_query ('SCA$REPORT_ROUTINE_TYPE'); ENDIF; ENDPROCEDURE PROCEDURE sca$report_get_source_file (file_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure gets a source file into a scratch buffer. It first checks ! to see whether or not the file already exists in a buffer, and if not, ! creates one. ! ! FORMAL PARAMETERS: ! ! file_name: ! ! The name of the file, as a string. IN parameter. ! ! IMPLICIT INPUTS: ! ! sca$report_file_array ! sca$report_file_name_array ! sca$report_file_index ! ! ROUTINE VALUE: ! ! The buffer that results. If we can't find the file at all, we return the ! empty string. ! ! SIDE EFFECTS: ! ! A new file may be read into a buffer, and the buffer added to ! SCA$REPORT_FILE_ARRAY. !-- LOCAL buffer_name, i, lang, old_language, result_index, resulting_buffer, terminator_array; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_GET_SOURCE_FILE'); ENDON_ERROR; resulting_buffer:= 0; ! See if we already have the file in a report buffer. ! i := 1; LOOP EXITIF i > sca$report_file_index; EXITIF sca$report_file_name_array{i} = file_name; i := i + 1; ENDLOOP; ! If we don't have it yet, try to bring it in. ! IF i <= sca$report_file_index THEN resulting_buffer := sca$report_file_array {i}; ELSE buffer_name := 'SCA$REPORT_SOURCE_BUFFER_' + STR(sca$report_file_index+1); IF NOT sca$report_get_file (file_name, buffer_name, resulting_buffer) THEN RETURN ''; ENDIF; SET(NO_WRITE, resulting_buffer, ON); ! Save the buffer name to allow the clean up of buffers after each ! module is complete. ! sca$report_add_file_entry (resulting_buffer, file_name) ENDIF; POSITION(BEGINNING_OF(resulting_buffer)); ! Get tag-terminator info for the language associated with this file, if ! the current language is different than the language for the previous ! source file. ! old_language := sca$report_current_language_LSE; sca$report_current_language_LSE := GET_INFO (current_buffer, 'LANGUAGE'); IF old_language <> sca$report_current_language_LSE THEN ! Get tag terminators for the new current language. ! IF sca$report_terminator_array <> tpu$k_unspecified THEN DELETE (sca$report_terminator_array); ENDIF; sca$report_terminator_array := CREATE_ARRAY (20,0); lang := GET_INFO (current_buffer,'LANGUAGE_TYPE'); IF lang = tpu$k_unspecified THEN sca$report_terminator_array{0} := 0; ELSE terminator_array := GET_INFO(lang, 'TAG_TERMINATORS'); i := 0; result_index := GET_INFO (terminator_array, 'FIRST'); LOOP EXITIF result_index = tpu$k_unspecified; i := i + 1; sca$report_terminator_array{i} := terminator_array{result_index}; result_index := GET_INFO (terminator_array, 'NEXT'); ENDLOOP; sca$report_terminator_array{0} := i; ENDIF; ENDIF; RETURN resulting_buffer; ENDPROCEDURE PROCEDURE sca$report_get_source_position (entity, attribute_type) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure returns a marker that corresponds to a lexical location from ! SCA. ! ! FORMAL PARAMETERS: ! ! entity ! ! The entity whose position we want. IN parameter. ! ! attribute_type ! ! The type of lexical location - 'BEGIN', 'END', or 'NAME'. ! IN parameter. ! ! ROUTINE VALUE: ! ! A marker on the indicated lexical location. !-- LOCAL char_offset, file_name, old_position, record_number, result_marker, sca_status, source_buffer; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_SOURCE_POSITION'); ENDON_ERROR; old_position := MARK(FREE_CURSOR); CASE CHANGE_CASE (attribute_type, UPPER, NOT_IN_PLACE) ! BEGIN - location of beginning of declaration ! ['BEGIN'] : sca_status := sca$report_get_attri_value_ul ( entity, record_number, sca$k_attri_begin_record_number); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$report_get_attri_value_ul ( entity, char_offset, sca$k_attri_begin_char_offset); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$get_attri_value_t ( entity, file_name, sca$k_attri_begin_file_spec); IF NOT INT (sca_status) THEN RETURN '' ENDIF; ! END - location of end of declaration ! ['END'] : sca_status := sca$report_get_attri_value_ul ( entity, record_number, sca$k_attri_end_record_number); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$report_get_attri_value_ul ( entity, char_offset, sca$k_attri_end_char_offset); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$get_attri_value_t ( entity, file_name, sca$k_attri_begin_file_spec); ! Until SCA fixes their ! bug, we use the begin ! file spec for this. IF NOT INT (sca_status) THEN RETURN '' ENDIF; ! NAME - location of declared name ! ['NAME'] : sca_status := sca$report_get_attri_value_ul ( entity, record_number, sca$k_attri_name_record_number); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$report_get_attri_value_ul ( entity, char_offset, sca$k_attri_name_char_offset); IF NOT INT (sca_status) THEN RETURN '' ENDIF; sca_status := sca$get_attri_value_t ( entity, file_name, sca$k_attri_name_file_spec); IF NOT INT (sca_status) THEN RETURN '' ENDIF; ENDCASE; ! Check for record_number of zero - this (erroneously) occurs sometimes in ! ANA files. ! IF record_number = 0 THEN RETURN '' ENDIF; ! Get the source file into a buffer. ! source_buffer := sca$report_get_source_file (file_name); IF source_buffer = '' THEN RETURN '' ENDIF; ! Position to the indicated lexical location. ! POSITION(source_buffer); lse_line (record_number); ! Create a marker on the indicated position, and return it. ! lse$move_horizontal (char_offset); result_marker := MARK(FREE_CURSOR); POSITION(old_position); RETURN result_marker; ENDPROCEDURE PROCEDURE sca$report_get_tag_value (tag_entity, tag_name, tag_value) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine returns the value of a tag, as a TPU range, given the ! occurrence of the tag and the name of the tag. ! ! FORMAL PARAMETERS: ! ! tag_entity ! ! The occurrence of the tag whose value we want. IN parameter. ! ! tag_name ! ! The name of the tag whose value we want, as a TPU string value. This ! is used to strip the name from the tag value. It is updated if it is a ! hidden (implicit) tag name. IN/OUT parameter. ! ! tag_value ! ! The value of the tag. This is a TPU range if the tag has a value, ! otherwise it is the null string. OUT parameter. ! ! SIDE EFFECTS: ! ! Contents of buffers SCA$TAG_VALUE and SCA$SCRATCH are modified, and marks ! are created. !-- LOCAL close_delimiters, delimiter_length, end_tag_value, here, i, is_first_line, line, longest_match, margin_amount, new_line, old_position, open_delimiters, scratch_tag_value, source_tag_range, start_tag, start_tag_column, start_tag_value, tag_entity_appearance, tag_name_length, tag_position, term_len, text_after_tag; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_TAG_VALUE'); ENDON_ERROR; old_position := MARK(FREE_CURSOR); ! If the tag name has a leading $, assume it's an implicit tag, so it ! won't get removed from the tagged comment text. ! IF SUBSTR(tag_name,1,1) = '$' THEN tag_name_length := 0; ELSE tag_name_length := LENGTH(tag_name); ENDIF; ! Find the source location of the tag text ! tag_position := sca$report_get_source_position (tag_entity, 'BEGIN'); IF tag_position = '' THEN tag_value := ''; POSITION(old_position); RETURN; ENDIF; ! Set marker at start of tag value ! start_tag := sca$report_get_source_position (tag_entity, 'NAME'); IF start_tag = '' THEN tag_value := ''; POSITION(old_position); RETURN; ENDIF; ! Position past the "extra stuff" that precedes the tagged text: tag name, ! white space, delimiter. ! POSITION(start_tag); IF tag_name <> 0 THEN ! Position to just after the tag name. ! MOVE_HORIZONTAL(tag_name_length); ! Position to just after trailing white space (if any). ! text_after_tag := SEARCH_QUIETLY (ANCHOR + SPAN(eve$kt_whitespace), FORWARD); IF text_after_tag <> 0 THEN POSITION(END_OF(text_after_tag)); MOVE_HORIZONTAL(1); ENDIF; ! Position to just after the tag_terminator (if any). ! IF current_offset <> 0 THEN i := 1; longest_match := 0; LOOP EXITIF i > sca$report_terminator_array{0}; term_len := LENGTH (sca$report_terminator_array{i}); IF (SUBSTR (current_line, current_offset+1, term_len) = sca$report_terminator_array{i}) AND term_len > longest_match THEN longest_match := term_len; ENDIF; i := i + 1; ENDLOOP; IF longest_match > 0 THEN MOVE_HORIZONTAL (longest_match); ENDIF; ENDIF; ENDIF; start_tag_value := MARK(FREE_CURSOR); ! Get the column number of the start of the text. ! start_tag_column := CURRENT_COLUMN; ! Set marker at end of tag value ! end_tag_value := sca$report_get_source_position (tag_entity, 'END'); ! Create a range covering the tag value in the source file. ! source_tag_range := CREATE_RANGE(start_tag_value,end_tag_value,NONE); ! Copy tagged text to scratch buffer ! ERASE (sca$report_scratch_buffer); POSITION (sca$report_scratch_buffer); copy_text (source_tag_range); scratch_tag_value := CREATE_RANGE (BEGINNING_OF (sca$report_scratch_buffer), END_OF (sca$report_scratch_buffer)); POSITION (BEGINNING_OF (sca$report_scratch_buffer)); ! Insert blanks at the beginning of the first line of text, to retain the ! column offset from the source file. ! IF start_tag_column > 1 THEN COPY_TEXT (' ' * (start_tag_column - 1) ); ENDIF; IF sca$report_current_language_LSE <> 0 THEN lse_set_buffer_language (sca$report_current_language_LSE); ENDIF; ! Convert tabs to blanks. ! Note that this must be done before delimiters get stripped off, so that ! the original source column is still known. ! sca$report_convert_tabs_to_spaces (scratch_tag_value); ! Strip comment delimiters from the tagged text. (Don't do this for ! $REMARK, because the comment processing code already took care of it.) ! ! The comment text can be: ! line oriented comments or ! a single, large, bracketed comment or ! bracketed comments that are opened and closed on each line. ! ! A common C and PL/I style uses a bracketed comment, but inserts a ! special delimiter (such as *) at the beginning of each line. This is ! treated the same as line oriented comments. ! POSITION (BEGINNING_OF (sca$report_scratch_buffer)); LOOP EXITIF MARK(FREE_CURSOR) >= END_OF(current_buffer); IF (sca$report_current_language_LSE <> 0) AND (tag_name <> '$REMARK') THEN ! Delete comment delimiters from the current line. Replace ! delimiters at the beginning of the line with the corresponding ! number of blanks, to retain relative column positions for ! NOFILL mode. ! open_delimiters := lse$find_open_comment (MARK(FREE_CURSOR)); IF GET_INFO(open_delimiters,'TYPE') = RANGE THEN IF LENGTH (open_delimiters) > 0 THEN POSITION (open_delimiters); delimiter_length := LENGTH (open_delimiters); ERASE(open_delimiters); COPY_TEXT (' ' * delimiter_length); ENDIF; ENDIF; close_delimiters := lse$find_close_comment (MARK(FREE_CURSOR)); IF GET_INFO(close_delimiters,'TYPE') = RANGE THEN IF LENGTH (close_delimiters) > 0 THEN ERASE(close_delimiters); ENDIF; ENDIF; ENDIF; POSITION (LINE_BEGIN); MOVE_VERTICAL(1); ENDLOOP; ! Do common formatting on the tag value text ! scratch_tag_value := CREATE_RANGE (BEGINNING_OF (sca$report_scratch_buffer), END_OF (sca$report_scratch_buffer)); POSITION (BEGINNING_OF (sca$report_scratch_buffer)); sca$report_strip_blank_lines (scratch_tag_value); ! Do target-specific formatting of the text ! sca$report_format_tag (scratch_tag_value); ! Check for null text ! IF BEGINNING_OF (scratch_tag_value) = END_OF (scratch_tag_value) THEN tag_value := ''; POSITION(old_position); RETURN; ENDIF; sca$report_get_left_margin (scratch_tag_value, 0, margin_amount); ! Move the text into the SCA$TAG_VALUE buffer, formatting as we go. ! POSITION (BEGINNING_OF (scratch_tag_value)); is_first_line := TRUE; LOOP ! For each line, strip off enough space at the beginning to shift the ! entire fragment over to the left. We do this in string variables, ! which is more efficient that doing it within the buffer. ! here := MARK(NONE); EXITIF here >= END_OF(scratch_tag_value); sca$report_strip_left_margin (current_line, margin_amount, new_line); ! Copy final line to SCA$TAG_VALUE buffer ! POSITION (END_OF (sca$report_tag_value_buffer)); COPY_TEXT (new_line); IF is_first_line THEN POSITION(LINE_BEGIN); start_tag_value := MARK(NONE); is_first_line := FALSE; MOVE_VERTICAL (1); ENDIF; ! Move on to next line of text ! POSITION (here); MOVE_VERTICAL (1); ENDLOOP; ! Create a range covering the final text. ! POSITION (END_OF (sca$report_tag_value_buffer)); MOVE_HORIZONTAL (-1); end_tag_value := MARK(NONE); tag_value := CREATE_RANGE (start_tag_value, end_tag_value); ERASE (sca$report_scratch_buffer); POSITION(old_position); RETURN; ENDPROCEDURE PROCEDURE sca$report_type_array (array_decl_class, depth, type_description) !++ ! FUNCTIONAL DESCRIPTION: ! ! Generate a partial type description string for an array. This procedure ! adds "array (nn-dimensional) of" to the type description string, updates ! the type depth, and leaves the current type query at the array component ! type. ! ! FORMAL PARAMETERS: ! ! array_decl_class - array decl class, as a string. For most languages, ! this is 'array', but for COBOL, it is 'table', for example. IN ! parameter. ! depth - current type depth. IN/OUT parameter. ! type_description - type description string. IN/OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if a type node for the array component type was found (i.e., another ! level of type information is available). FALSE otherwise. !-- LOCAL array_dim, array_comp_type, decl_class, got_component_type, is_name, sca_status, type_entity, temp_entity_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_TYPE_ARRAY'); ENDON_ERROR; ! Get next level of type information - this should be array index and array ! component type nodes. ! sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_TEMP' + ' TYPING (@SCA$REPORT_TYPE_' + STR(depth) + ', DEPTH=1, RESULT=BEGIN)' ); IF NOT INT(sca_status) THEN type_description := type_description + array_decl_class; RETURN FALSE; ENDIF; ! Loop over occurrences for array's "children" types to find array ! dimensions and component type. ! array_dim := 0; array_comp_type := ''; got_component_type := FALSE; type_entity := 0; LOOP sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_TEMP', type_entity); EXITIF NOT INT(sca_status); sca$report_get_decl_class (type_entity, decl_class); IF ((decl_class = 'array component') OR (decl_class = 'array element')) AND (NOT got_component_type) THEN ! Save the array component type in a new query result, to be used ! as input for the next level of type processing. ! depth := depth + 1; got_component_type := TRUE; sca$select_occurrence (type_entity, temp_entity_name); sca$report_find ('MODIFY QUERY NAME SCA$REPORT_TYPE_'+STR(depth) ); ELSE IF ((decl_class = 'array index') OR (decl_class = 'conformant array index') OR (decl_class = 'table index') OR (decl_class = 'tree index') ) THEN array_dim := array_dim + 1; ENDIF; ENDIF; ENDLOOP; ! Append 'array (nn-dimensional) of' to type description string. ! type_description := type_description + array_decl_class + ' (' + STR(array_dim) + '-dimensional) of'; ! Clean up and return. ! sca$report_delete_query ('SCA$REPORT_TYPE_TEMP'); RETURN got_component_type; ENDPROCEDURE PROCEDURE sca$report_type_function (func_decl_class, depth, type_description) !++ ! FUNCTIONAL DESCRIPTION: ! ! Generate a partial type description string for a function. ! If the function has a return value, this procedure: ! adds "function returning" to the type description string, ! updates the type depth, ! leaves the current type query at the function return value type, ! returns TRUE. ! If the function has no return value, this procedure: ! adds "function" to the type description string, ! returns FALSE. ! ! FORMAL PARAMETERS: ! ! func_decl_class - func decl class, as a string. For C, this is either ! 'function' or 'void function'. IN parameter. ! depth - current type depth. IN/OUT parameter. ! type_description - type description string. IN/OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if a type node for the function return value was found (i.e., another ! level of type information is available). FALSE otherwise. !-- LOCAL return_value_type, decl_class, got_return_value_type, is_name, sca_status, type_entity, temp_entity_name; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_TYPE_FUNCTION'); ENDON_ERROR; ! Get next level of type information - this should be the function return ! value type (and parameter types??). ! sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_TEMP' + ' TYPING (@SCA$REPORT_TYPE_' + STR(depth) + ', DEPTH=1, RESULT=BEGIN)' ); IF NOT INT(sca_status) THEN type_description := type_description + func_decl_class; RETURN FALSE; ENDIF; ! Loop over occurrences for function type's "children" types to find ! return value type. ! got_return_value_type := FALSE; type_entity := 0; LOOP sca_status := sca$get_occurrence (sca$report_command_context, 'SCA$REPORT_TYPE_TEMP', type_entity); EXITIF NOT INT(sca_status); sca$report_get_name_or_decl_class (type_entity, decl_class, is_name); IF ((decl_class = 'function return value')) AND (NOT got_return_value_type) THEN ! Save the return value type in a new query result, to be used ! as input for the next level of type processing. ! depth := depth + 1; got_return_value_type := TRUE; sca$select_occurrence (type_entity, temp_entity_name); sca$report_find ('MODIFY QUERY NAME SCA$REPORT_TYPE_'+STR(depth) ); ENDIF; ENDLOOP; ! Append 'function returning' to type description string. ! IF got_return_value_type THEN type_description := type_description + func_decl_class + ' returning'; ELSE type_description := type_description + func_decl_class; ENDIF; ! Clean up and return. ! sca$report_delete_query ('SCA$REPORT_TYPE_TEMP'); RETURN got_return_value_type; ENDPROCEDURE PROCEDURE sca$report_type_pointer (ptr_decl_class, depth, type_description) !++ ! FUNCTIONAL DESCRIPTION: ! ! Generate a partial type description string for a pointer type. This ! procedure adds "pointer to" to the type description string, and leaves the ! current type query unchanged. ! ! FORMAL PARAMETERS: ! ! ptr_decl_class - pointer decl class, as a string. For most languages, ! this is 'pointer', but for Ada, it is 'access type', for example. IN ! parameter. ! depth - current type depth. IN parameter. ! type_description - type description string. IN/OUT parameter. ! ! ROUTINE VALUE: ! ! TRUE if a type node for the pointer component type was found (i.e., another ! level of type information is available). FALSE otherwise. !-- LOCAL sca_status; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_TYPE_POINTER'); ENDON_ERROR; ! Get next level of type information - this should be the pointer component ! type node. We don't keep this result - just use it to determine whether ! there is another level of type information. The caller re-issues this ! query after we return. ! sca_status := sca$report_find ( 'FIND -name SCA$REPORT_TYPE_TEMP' + ' TYPING (@SCA$REPORT_TYPE_' + STR(depth) + ', DEPTH=1, RESULT=BEGIN)' ); IF NOT INT(sca_status) THEN type_description := type_description + ptr_decl_class; RETURN FALSE; ENDIF; ! Append 'pointer to' to type description string. ! type_description := type_description + ptr_decl_class + ' to'; ! Clean up and return. ! sca$report_delete_query ('SCA$REPORT_TYPE_TEMP'); RETURN TRUE; ENDPROCEDURE !============================================================================ ! Formatting procedures PROCEDURE sca$report_add_table_body (text_block) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure writes a block of text on a line by line basis, with each ! line being an entry in a table. It is useful for those cases where a tag ! value should not be filled, such as the AUTHORS or MODIFICATION HISTORY ! tags. ! ! We strip leading blank lines from the block, but we don't strip any other ! blank lines. ! ! FORMAL PARAMETERS: ! ! text_block ! ! The text of the paragraph, as a TPU range value. It must contain at ! least one paragraph. IN parameter. !-- LOCAL saved_position, scratch_range, start_paragraph; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_ADD_TABLE_BODY'); ENDON_ERROR; saved_position := MARK(FREE_CURSOR); scratch_range := text_block; strip_blank_lines (scratch_range); POSITION (BEGINNING_OF (scratch_range)); LOOP EXITIF MARK(FREE_CURSOR) >= END_OF(scratch_range); sca$report_add_table_item (current_line); lse$move_vertical(1); ENDLOOP; DELETE (scratch_range); POSITION(saved_position); RETURN; ENDPROCEDURE PROCEDURE sca$report_convert_tabs_to_spaces (text_range) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure converts tabs to spaces in a given range. ! ! FORMAL PARAMETERS: ! ! text_range ! ! The range of lines to convert. IN parameter. ! ! IMPLICIT INPUTS: ! ! The current buffer is used to determine the tab_stops setting. !-- CONSTANT spaces := ' ' * 10, tab_char := ASCII(9); LOCAL column, line, new_line, pad_size, save_position, tab_index, tab_width; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_CONVERT_TABS_TO_SPACES'); ENDON_ERROR; save_position := MARK(NONE); ! Get the tab width for the source buffer. Default to 8. ! tab_width := GET_INFO(CURRENT_BUFFER,'TAB_STOPS'); IF GET_INFO(tab_width, 'TYPE') <> INTEGER THEN sca$report_status_message ('*** Tab stops must be a fixed integer.'); tab_width := 8; ENDIF; POSITION (BEGINNING_OF (text_range)); LOOP EXITIF MARK(NONE) >= END_OF(text_range); column := 0; line := CURRENT_LINE; new_line := ''; ! Replace each tab in the current line by the appropriate number of ! spaces. ! LOOP tab_index := INDEX(line,tab_char); EXITIF tab_index = 0; column := column + tab_index - 1; pad_size := (1 + column/tab_width) * tab_width - column; column := column + pad_size; new_line := new_line + SUBSTR(line, 1, tab_index - 1) + SUBSTR(spaces, 1, pad_size); line := SUBSTR(line, tab_index + 1); ENDLOOP; new_line := new_line + line; IF new_line <> CURRENT_LINE THEN ERASE_LINE; COPY_TEXT (new_line); SPLIT_LINE; MOVE_VERTICAL (-1); ENDIF; MOVE_VERTICAL (1); ENDLOOP; POSITION (save_position); RETURN; ENDPROCEDURE PROCEDURE sca$report_get_left_margin (block, id_text_size, margin_amount) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure computes the left margin of a range (the column position of ! the leftmost non-blank column in the range). ! ! FORMAL PARAMETERS: ! ! block ! ! The block that we wish to scan, as a TPU range value. IN parameter. ! ! id_text_size ! ! The number of columns that need to be set aside for the id number on ! the block. IN parameter. ! ! margin_amount ! ! The number of columns stripped off the left margin of each line in the ! block, as a signed integer. A negative value indicates that additional ! white space must be added to each line. OUT parameter. !-- LOCAL is_first, line, non_blank, saved_position, start_of_line; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_LEFT_MARGIN'); ENDON_ERROR; saved_position := MARK(FREE_CURSOR); ! Move to the first visible line within the group (the input range may ! include the overview line for the range). ! POSITION(BEGINNING_OF(block)); IF NOT lse$is_visible THEN MOVE_VERTICAL(1); ENDIF; POSITION(LINE_BEGIN); margin_amount := 999999; is_first := 1; LOOP EXITIF MARK(FREE_CURSOR) >= END_OF(block); ! Find the leftmost non-blank column in the line. Ignore blank lines - ! their indentation is not important. ! IF LENGTH (CURRENT_LINE) > 0 THEN line := CURRENT_LINE; IF SUBSTR (line, 1, 1) = ' ' THEN IF line <> (' ' * LENGTH(line)) THEN ! There are leading blanks, and the line is not entirely ! blank. ! current_margin := 1; LOOP EXITIF SUBSTR (line, current_margin+1, 1) <> ' '; current_margin := current_margin + 1; ENDLOOP; ! If this is the first line of the text block, allow space ! for the id text to its left. ! IF is_first THEN current_margin := current_margin - id_text_size; is_first := 0; ENDIF; ! If this line has the leftmost starting column that we've ! seen so far, update margin_amount. ! IF current_margin < margin_amount THEN margin_amount := current_margin; ENDIF; ENDIF; ELSE ! No leading white space on this line. Set the margin all the ! way to the left. ! margin_amount := 0; ! Allow for id text to the left of this text if this is the ! first line of the text block. ! IF is_first THEN margin_amount := - id_text_size; ENDIF; ! No other lines in the block can start any farther to the left, ! so return now. ! POSITION(saved_position); RETURN; ENDIF; ENDIF; ! Move to the next visible line (if any) in the text block. ! lse$move_vertical(1); ENDLOOP; POSITION(saved_position); ENDPROCEDURE PROCEDURE sca$report_remove_crlf !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure searches through the file, replacing carriage returns and ! line feeds with newlines. ! ! FORMAL PARAMETERS: ! ! None !-- LOCAL the_range; ! Ignore STRNOTFOUND error ! ON_ERROR IF ERROR <> tpu$_STRNOTFOUND THEN sca$report_common_error_cleanup('SCA$REPORT_REMOVE_CRLF_TEXT'); ENDIF; ENDON_ERROR; ! Remove each CRLF. If it is not at the EOL, add a line break. ! position(BUFFER_BEGIN); LOOP the_range := SEARCH_QUIETLY(ascii(13)+ascii(10), FORWARD); EXITIF the_range = 0; ERASE(the_range); position(beginning_of(the_range)); IF current_character <> '' THEN split_line; ENDIF; ENDLOOP; ! Remove each remaining LF. If the LF is not at the EOL, add a line break. ! position(BUFFER_BEGIN); LOOP the_range := SEARCH_QUIETLY(ascii(10), FORWARD); EXITIF the_range = 0; ERASE(the_range); position(beginning_of(the_range)); IF current_character <> '' THEN split_line; ENDIF; ENDLOOP; ! Remove each remaining CR. If the CR is not at the EOL, add a line break. ! position(BUFFER_BEGIN); LOOP the_range := SEARCH_QUIETLY(ascii(13), FORWARD); EXITIF the_range = 0; position(end_of(the_range)); IF current_offset <> 0 THEN split_line; ENDIF; ERASE(the_range); ENDLOOP; ENDPROCEDURE PROCEDURE sca$report_strip_blank_lines (text_range) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure strips leading and trailing blank lines from a range by ! resetting its beginning and end points as necessary. No text is modified ! or copied. ! ! FORMAL PARAMETERS: ! ! text_range ! ! The range to strip. IN/OUT parameter. !-- LOCAL end_text, saved_position, start_text; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_STRIP_BLANK_LINES'); ENDON_ERROR; saved_position := MARK(FREE_CURSOR); ! Adjust the range to start at the beginning of the first non-blank ! line in the input range. ! POSITION (BEGINNING_OF (text_range)); IF NOT lse$is_overview THEN start_text := SEARCH_QUIETLY( NOTANY(eve$kt_whitespace), FORWARD, EXACT, text_range); IF start_text <> 0 THEN POSITION(END_OF(start_text)); MODIFY_RANGE (text_range,LINE_BEGIN,END_OF(text_range)) ENDIF; ENDIF; ! Adjust the range to end at the end of the last non-blank line ! in the input range. ! POSITION (END_OF (text_range)); IF NOT lse$is_overview THEN end_text := SEARCH_QUIETLY( NOTANY(eve$kt_whitespace), REVERSE, EXACT, text_range); IF end_text <> 0 THEN POSITION(BEGINNING_OF(end_text)); MODIFY_RANGE(text_range,BEGINNING_OF(text_range),LINE_END) ENDIF; ENDIF; POSITION(saved_position); RETURN; ENDPROCEDURE PROCEDURE sca$report_strip_left_margin( original_line, margin_amount, stripped_line) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure strips leading columns from a line. The effect of this is to ! left justify the line, based on a given margin amount. This procedure also ! strips trailing blanks from the line. ! ! This procedure makes the following assumptions: ! ! 1. All tabs have been converted to an appropriate number of blanks. ! ! 2. The line has enough leading white space to perform this stripping. ! If there are visible characters in the margin area, they will be ! lost. ! ! FORMAL PARAMETERS: ! ! original_line ! ! The line we want to strip, as a TPU string. IN parameter. ! ! margin_amount ! ! The number of columns to be stripped. IN parameter. ! ! stripped_line ! ! The line with the margin area removed, as a TPU string value. ! OUT parameter. !-- ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_STRIP_LEFT_MARGIN'); ENDON_ERROR; ! Strip trailing white space from the line. If the line is all white space, ! no further work is needed - return. ! stripped_line := EDIT(original_line, TRIM_TRAILING); IF stripped_line = '' THEN RETURN; ENDIF; ! A positive margin amount gives the number of blanks to be removed ! from the beginning of the line. ! IF margin_amount > 0 THEN stripped_line := SUBSTR (stripped_line, margin_amount + 1); ENDIF; ! A negative margin amount gives the number of blanks to be added to the ! beginning of the line. ! IF margin_amount < 0 THEN stripped_line := ( ' ' * (-margin_amount)) + stripped_line; ENDIF; RETURN; ENDPROCEDURE PROCEDURE sca$report_write_by_line (text_block) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure writes a block of text on a line by line basis. ! ! FORMAL PARAMETERS: ! ! text_block ! ! The text of the paragraph, as a TPU range. IN parameter. !-- LOCAL saved_position; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_BY_LINE'); ENDON_ERROR; ! Ignore empty text block. ! IF BEGINNING_OF (text_block) >= END_OF (text_block) THEN RETURN; ENDIF; saved_position := MARK(FREE_CURSOR); POSITION (BEGINNING_OF (text_block)); LOOP EXITIF MARK(FREE_CURSOR) >= END_OF(text_block); sca$report_append_text (current_line, TRUE); sca$report_write_line_break; lse$move_vertical(1); ENDLOOP; POSITION(saved_position); ENDPROCEDURE PROCEDURE sca$report_write_by_list (text_block) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure writes a block of text, making each line a list element. ! ! FORMAL PARAMETERS: ! ! text_block ! ! The text of the paragraph, as a TPU range. IN parameter. !-- LOCAL saved_position; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_BY_LIST'); ENDON_ERROR; ! Ignore empty text block. ! IF BEGINNING_OF (text_block) >= END_OF (text_block) THEN RETURN; ENDIF; saved_position := MARK(FREE_CURSOR); POSITION (BEGINNING_OF (text_block)); sca$report_start_list (sca$report_option_list_style); LOOP EXITIF MARK(FREE_CURSOR) >= END_OF(text_block); sca$report_list_element (current_line); lse$move_vertical(1); ENDLOOP; sca$report_end_list; POSITION(saved_position); RETURN; ENDPROCEDURE PROCEDURE sca$report_write_tags_subsection( entry_result, how_to_write_flag; empty_subsection) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine writes a subsection containing the text associated with a ! given tag (or a set of synonymous tags). Typical subsections include ! FUNCTIONAL DESCRIPTION, IMPLICIT INPUTS, etc. The entire body of the tag ! is written to the subsection, along with a suitable header. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The entry result containing the tags we wish to write. ! ! how_to_write_flag ! ! A flag that indicates whether to write the tagged text verbatim (using ! sca$report_add_text), or one paragraph at a time (using ! sca$report_write_paragraph). This is independent of whether FILL is ! turned on, and independent of any formatting that is done by Runoff or ! Document. ! ! Possible values: ! ! SCA$REPORT_K_WRITE_AS_IS - use sca$report_add_text ! SCA$REPORT_K_WRITE_BY_PARAGRAPHS - use sca$report_write_paragraph ! ! Typically, reports that will be formatted use ! SCA$REPORT_K_WRITE_BY_PARAGRAPHS, and reports that go to other tools, ! such as HELP and PACKAGE reports, use SCA$REPORT_K_WRITE_AS_IS. ! ! empty_subsection ! ! A string containing the text to be written if there is no text for a ! given occurrence. This is an optional parameter - if not supplied, ! it defaults to sca$report_none. !-- LOCAL current_result, empty_heading, tag_index, tag_text; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_TAGS_SUBSECTION'); ENDON_ERROR; ! Check for empty result. ! IF entry_result{sca$report_k_entry_number_occurrences} > 0 THEN IF how_to_write_flag = sca$report_k_write_as_table THEN sca$report_start_table ('') ENDIF; IF how_to_write_flag = sca$report_k_write_as_list_element THEN sca$report_start_list (sca$report_option_list_style); ENDIF; tag_index := 1; LOOP EXITIF tag_index > entry_result{sca$report_k_entry_number_occurrences}; current_result := sca$report_fetch_occurrence (entry_result, tag_index); sca$report_fetch_result (current_result, sca$report_location_tag_text, tag_text); CASE how_to_write_flag FROM sca$report_k_first_how_to_write TO sca$report_k_last_how_to_write [sca$report_k_write_as_is] : sca$report_strip_blank_lines (tag_text); sca$report_append_text (tag_text, TRUE); [sca$report_k_write_by_paragraphs] : sca$report_paragraph (tag_text,TRUE); [sca$report_k_write_by_line] : sca$report_strip_blank_lines (tag_text); sca$report_write_by_line (tag_text); [sca$report_k_write_by_list] : sca$report_strip_blank_lines (tag_text); sca$report_write_by_list (tag_text); [sca$report_k_write_as_list_element] : sca$report_strip_blank_lines (tag_text); sca$report_list_element (tag_text); [sca$report_k_write_as_table] : sca$report_add_table_body (tag_text); [INRANGE, OUTRANGE] : sca$report_bad_parameter (how_to_write_flag, 'SCA$REPORT_WRITE_TAGS_SUBSECTION'); ENDCASE; DELETE (tag_text); tag_index := tag_index + 1; ENDLOOP; IF how_to_write_flag = sca$report_k_write_as_table THEN sca$report_end_table ENDIF; IF how_to_write_flag = sca$report_k_write_as_list_element THEN sca$report_end_list; ENDIF; ELSE IF empty_subsection = tpu$k_unspecified THEN empty_heading := sca$report_none ELSE empty_heading := empty_subsection ENDIF; CASE how_to_write_flag FROM sca$report_k_first_how_to_write TO sca$report_k_last_how_to_write [sca$report_k_write_as_is] : sca$report_append_text (empty_heading, TRUE); [sca$report_k_write_by_paragraphs] : sca$report_paragraph (empty_heading,TRUE); [sca$report_k_write_by_line] : sca$report_paragraph (empty_heading,TRUE); [sca$report_k_write_by_list] : sca$report_paragraph (empty_heading,TRUE); [sca$report_k_write_as_table] : sca$report_paragraph (empty_heading); [sca$report_k_write_as_list_element] : sca$report_paragraph (empty_heading); [INRANGE, OUTRANGE] : sca$report_bad_parameter (how_to_write_flag, 'SCA$REPORT_WRITE_TAGS_SUBSECTION'); ENDCASE; ENDIF; RETURN; ENDPROCEDURE PROCEDURE sca$report_write_tags (entry_result, format_type) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine writes the tagged text for all occurrences within a given ! entry. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The result array for the entry. IN parameter. ! ! format_type ! ! A flag that indicates how to format the tagged text: ! ! SCA$REPORT_K_WRITE_AS_IS - copy tag text to output buffer verbatim ! (used for HELP report) ! ! SCA$REPORT_K_WRITE_BY_PARAGRAPHS - write tag text as a sequence of ! paragraphs, influenced by the /[NO]FILL qualifier (SDML or ! RUNOFF or TEXT format). This format also implies that a ! section header needs to be written for each tag. !-- LOCAL current_result, tag_index, tag_name, tag_text; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_TAGS'); ENDON_ERROR; ! Check for empty result. ! IF entry_result{sca$report_k_entry_number_occurrences} = 0 THEN RETURN; ENDIF; tag_index := 1; LOOP EXITIF tag_index > entry_result{sca$report_k_entry_number_occurrences}; current_result := sca$report_fetch_occurrence (entry_result, tag_index); sca$report_fetch_result (current_result, sca$report_location_tag_name, tag_name); sca$report_fetch_result (current_result, sca$report_location_tag_text, tag_text); CASE format_type FROM sca$report_k_first_how_to_write TO sca$report_k_last_how_to_write [sca$report_k_write_as_is] : sca$report_append_text (tag_text, TRUE); [sca$report_k_write_by_paragraphs]: sca$report_start_header (1, tag_name); sca$report_paragraph (tag_text, TRUE); [INRANGE, OUTRANGE] : sca$report_bad_parameter (format_type, 'SCA$REPORT_WRITE_TAGS'); ENDCASE; DELETE (tag_text); tag_index := tag_index + 1; ENDLOOP; RETURN ENDPROCEDURE PROCEDURE sca$report_write_routine_tags (entry_result, format_type) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine writes the tagged text for all occurrences within a given ! entry, in a format suitable for a subsection within a routine section of an ! INTERNALS report. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The result array for the entry. IN parameter. ! ! format_type ! ! A flag that indicates how to format the tagged text: ! ! SCA$REPORT_K_WRITE_AS_IS - copy tag text to output buffer verbatim ! (used for HELP report) ! ! SCA$REPORT_K_WRITE_BY_PARAGRAPHS - write tag text as a sequence of ! paragraphs, influenced by the /[NO]FILL qualifier (SDML or ! RUNOFF or TEXT format). This format also implies that a ! routine subsection header needs to be written for each tag. !-- LOCAL current_result, tag_index, tag_name, tag_text; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_ROUTINE_TAGS'); ENDON_ERROR; ! Check for empty result. ! IF entry_result{sca$report_k_entry_number_occurrences} = 0 THEN RETURN; ENDIF; tag_index := 1; LOOP EXITIF tag_index > entry_result{sca$report_k_entry_number_occurrences}; current_result := sca$report_fetch_occurrence (entry_result, tag_index); sca$report_fetch_result (current_result, sca$report_location_tag_name, tag_name); sca$report_fetch_result (current_result, sca$report_location_tag_text, tag_text); CASE format_type FROM sca$report_k_first_how_to_write TO sca$report_k_last_how_to_write [sca$report_k_write_as_is] : sca$report_append_text (tag_text, TRUE); [sca$report_k_write_by_paragraphs]: sca$report_start_routine_subsection (tag_name); sca$report_paragraph (tag_text, TRUE); sca$report_end_routine_subsection; [INRANGE, OUTRANGE] : sca$report_bad_parameter (format_type, 'SCA$REPORT_WRITE_ROUTINE_TAGS'); ENDCASE; DELETE (tag_text); tag_index := tag_index + 1; ENDLOOP; RETURN; ENDPROCEDURE PROCEDURE sca$report_write_variable_tags (entry_result, format_type) !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine writes the tagged text for all occurrences within a given ! entry, in a format suitable for a variable or type description in INTERNALS. ! ! FORMAL PARAMETERS: ! ! entry_result ! ! The result array for the entry. IN parameter. ! ! format_type ! ! A flag that indicates how to format the tagged text: ! ! SCA$REPORT_K_WRITE_AS_IS - copy tag text to output buffer verbatim ! (used for HELP report) ! ! SCA$REPORT_K_WRITE_BY_PARAGRAPHS - write tag text as a sequence of ! paragraphs, influenced by the /[NO]FILL qualifier (SDML or ! RUNOFF or TEXT format). !-- LOCAL current_result, tag_index, tag_text; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_WRITE_VARIABLE_TAGS'); ENDON_ERROR; ! Check for empty result. ! IF entry_result{sca$report_k_entry_number_occurrences} = 0 THEN RETURN; ENDIF; tag_index := 1; LOOP EXITIF tag_index > entry_result{sca$report_k_entry_number_occurrences}; current_result := sca$report_fetch_occurrence (entry_result, tag_index); sca$report_fetch_result (current_result, sca$report_location_tag_text, tag_text); CASE format_type FROM sca$report_k_first_how_to_write TO sca$report_k_last_how_to_write [sca$report_k_write_as_is] : sca$report_append_text (tag_text, TRUE); [sca$report_k_write_by_paragraphs]: sca$report_paragraph (tag_text, TRUE); [INRANGE, OUTRANGE] : sca$report_bad_parameter (format_type, 'SCA$REPORT_WRITE_VARIABLE_TAGS'); ENDCASE; DELETE (tag_text); tag_index := tag_index + 1; ENDLOOP; RETURN; ENDPROCEDURE !============================================================================ ! Miscellaneous procedures PROCEDURE sca$report_add_file_entry (new_buffer, new_file_name) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure adds the specified buffer to the list of open ! files. We delete these buffers when report processing is finished, to ! minimize memory use. ! ! FORMAL PARAMETERS: ! ! new_buffer ! ! The buffer. IN parameter. ! ! new_file_name ! ! The file name (as supplied by SCA) that corresponds to the buffer. IN ! parameter. ! ! IMPLICIT INPUTS: ! ! sca$report_file_array ! sca$report_file_index ! sca$report_file_name_array !-- LOCAL i; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_ADD_FILE_ENTRY'); ENDON_ERROR; ! Insert the buffer at the end of the array. ! sca$report_file_index := sca$report_file_index + 1; sca$report_file_array {sca$report_file_index} := new_buffer; sca$report_file_name_array {sca$report_file_index} := new_file_name; ENDPROCEDURE PROCEDURE sca$report_flush_file_array !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure deletes the buffers associated with the source files used ! during a phase of report generation. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! sca$report_file_array ! sca$report_file_index ! sca$report_file_name_array !-- LOCAL i; ON_ERROR [OTHERWISE]: sca$report_common_error_cleanup('SCA$REPORT_FLUSH_FILE_ARRAY'); ENDON_ERROR; ! Restore the editing position. ! sca$report_restore_editing_position; IF GET_INFO (sca$report_file_index, 'TYPE') <> UNSPECIFIED THEN i := 1; LOOP EXITIF i > sca$report_file_index; IF sca$report_file_array {i} <> tpu$k_unspecified THEN DELETE (sca$report_file_array {i}); sca$report_file_array {i} := tpu$k_unspecified; sca$report_file_name_array {i} := tpu$k_unspecified; ENDIF; i := i + 1; ENDLOOP; ENDIF; ! Re-initialize the array index. ! sca$report_file_index := 0; ! Re-initialize the list of un-openable files. ! sca$report_bad_files := ' '; ENDPROCEDURE PROCEDURE sca$report_get_elapsed_time (begin_time, end_time, time_bin, time_str) !++ ! FUNCTIONAL DESCRIPTION: ! ! This procedure calculates the difference between two time values. ! ! FORMAL PARAMETERS: ! ! begin_time ! ! Beginning of elapsed time interval, as a string. IN parameter. ! ! end_time ! ! End of elapsed time interval, as a string. IN parameter. ! ! time_bin ! ! Elapsed time interval, as an integer, unit is .01 second. ! OUT parameter. ! ! time_str ! ! Elapsed time interval, as a string, in the format 'nnn.nn'. ! OUT parameter. !-- LOCAL begin_hours, begin_minutes, begin_seconds, begin_hundredths, end_hours, end_minutes, end_seconds, end_hundredths, first_colon, time_seconds; ON_ERROR [OTHERWISE] : sca$report_common_error_cleanup('SCA$REPORT_GET_ELAPSED_TIME'); ENDON_ERROR; first_colon := INDEX(begin_time, ':'); begin_hours := INT( SUBSTR( begin_time, 1, first_colon-1)); begin_minutes := INT( SUBSTR( begin_time, first_colon+1, 2)); begin_seconds := INT( SUBSTR( begin_time, first_colon+4, 2)); begin_hundredths := INT( SUBSTR( begin_time, first_colon+7, 2)); first_colon := INDEX(end_time, ':'); end_hours := INT( SUBSTR( end_time, 1, first_colon-1)); IF end_hours < begin_hours THEN end_hours := end_hours + 24; ENDIF; end_minutes := INT( SUBSTR( end_time, first_colon+1, 2)); end_seconds := INT( SUBSTR( end_time, first_colon+4, 2)); end_hundredths := INT( SUBSTR( end_time, first_colon+7, 2)); time_seconds :=( ((end_hours - begin_hours) * 60) + (end_minutes - begin_minutes) ) * 60 + (end_seconds - begin_seconds); time_hundredths := end_hundredths - begin_hundredths; IF time_hundredths < 0 THEN time_hundredths := time_hundredths + 100; time_seconds := time_seconds - 1; ENDIF; time_bin := (time_seconds * 100) + time_hundredths; IF time_hundredths >= 10 THEN time_str := STR(time_seconds) + '.' + STR(time_hundredths) ELSE time_str := STR(time_seconds) + '.0' + STR(time_hundredths); ENDIF; ENDPROCEDURE ENDMODULE