?? RIGHT := 110 ??
?? NEWTITLE := 'PACKAGE_SOFTWARE Utility: CREATE_SUBPRODUCT_CORRECTION Subutility.' ??
MODULE ram$create_subproduct_corr;

{ PURPOSE:
{   This module contains the command to establish the CREATE_SUBPRODUCT_CORRECTION
{   subutility environment.
{
{ DESIGN:
{   This module sets up the environment for the CREATE_SUBPRODUCT_CORRECTION
{   utility.
{
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rat$correction_process_record
?? POP ??
*copyc clp$begin_utility
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc mmp$create_segment
*copyc mmp$delete_segment
*copyc osp$establish_block_exit_hndlr
*copyc osp$disestablish_cond_handler
*copyc rap$reset_correction_environ

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    rav$correction_process_record: [XDCL] rat$correction_process_record;

  VAR
    rav$cresc_utility_name: [XDCL] ost$name := 'CREATE_SUBPRODUCT_CORRECTION';

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$create_subproduct_corr', EJECT ??

{ PURPOSE:
{   This procedure opens the utility.
{
{ DESIGN:
{   This procedure creates and initializes the correction process record.
{   The correction process record is used by the
{   CREATE_SUBPRODUCT_CORRECTION utility to communicate information among
{   the various utility subcommands.
{
{   A memory sequence is created.  This sequence will have subproduct
{   correction information written to it by the other utility subcommands.
{   When a correction has been generated, the memory sequence will be
{   written to a permanent file.
{
{   The utility session is opened.
{
{ NOTES:
{

  PROCEDURE [XDCL] rap$create_subproduct_corr
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ PROCEDURE cresc_pdt (
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 1] of clt$pdt_parameter_name,
        parameters: array [1 .. 1] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 7, 12, 12, 46, 9, 596], clc$command, 1, 1, 0, 0, 0, 0, 1, 'CRESC_PDT'],
            [['STATUS                         ', clc$nominal_entry, 1]], [
{ PARAMETER 1
      [1, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_parameter, 0, 0]],
{ PARAMETER 1
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;


{ table n=cresc_command_table t=command s=xdcl
{ command n=(change_correction_attributes, chaca) p=rap$change_correction_attrib cm=xref
{ command n=(define_correction, defc) p=rap$define_correction cm=xref
{ command n=(display_correction_attributes, disca) p=rap$display_correction_attrib cm=xref
{ command n=(generate_correction, genc) p=rap$generate_correction_pacs cm=xref
{ command n=(quit, qui) p=rap$quit_cresc cm=xref
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  cresc_command_table: [XDCL, READ] ^clt$command_table := ^cresc_command_table_entries,

  cresc_command_table_entries: [STATIC, READ] array [1 .. 10] of clt$command_table_entry := [
  {} ['CHACA                          ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$change_correction_attrib],
  {} ['CHANGE_CORRECTION_ATTRIBUTES   ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$linked_call, ^rap$change_correction_attrib],
  {} ['DEFC                           ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$define_correction],
  {} ['DEFINE_CORRECTION              ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$linked_call, ^rap$define_correction],
  {} ['DISCA                          ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$display_correction_attrib],
  {} ['DISPLAY_CORRECTION_ATTRIBUTES  ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$automatically_log, clc$linked_call, ^rap$display_correction_attrib],
  {} ['GENC                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$generate_correction_pacs],
  {} ['GENERATE_CORRECTION            ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$automatically_log, clc$linked_call, ^rap$generate_correction_pacs],
  {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$quit_cresc],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$automatically_log, clc$linked_call, ^rap$quit_cresc]];

  PROCEDURE [XREF] rap$change_correction_attrib
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] rap$define_correction
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] rap$display_correction_attrib
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] rap$generate_correction_pacs
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] rap$quit_cresc
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? POP ??


    CONST
      prompt_size = 5,
      prompt_value = 'CRESC';

    VAR
      local_status: ost$status,
      memory_segment_pointer: mmt$segment_pointer,
      utility_attributes_p: ^clt$utility_attributes;

?? OLDTITLE ??
?? NEWTITLE := 'abort_handler', EJECT ??
{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If the files or memory segments are open, they will be closed before the
{   the procedure returns.
{
{ NOTES:
{
{

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF memory_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (memory_segment_pointer, 1, ignore_status);
      IFEND;

      rap$reset_correction_environ (rav$correction_process_record, ignore_status);

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??


    status.normal := TRUE;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

      { Create the segment that will contain the memory sequence.

      mmp$create_segment (NIL, mmc$sequence_pointer, 1, memory_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      { Initialize the correction process record.

      rav$correction_process_record.new_subproduct_info_pointers.subproduct_info_seq_p :=
            memory_segment_pointer.seq_pointer;
      rav$correction_process_record.correction_in_progress := FALSE;
      rav$correction_process_record.base_level_sif.file_opened := FALSE;
      rav$correction_process_record.current_level_sif.file_opened := FALSE;
      rav$correction_process_record.previous_correction_sif.file_opened := FALSE;

      PUSH utility_attributes_p: [1 .. 3];
      utility_attributes_p^ [1].key := clc$utility_command_search_mode;
      utility_attributes_p^ [1].command_search_mode := clc$global_command_search;
      utility_attributes_p^ [2].key := clc$utility_command_table;
      utility_attributes_p^ [2].command_table := cresc_command_table;
      utility_attributes_p^ [3].key := clc$utility_prompt;
      utility_attributes_p^ [3].prompt.size := prompt_size;
      utility_attributes_p^ [3].prompt.value := prompt_value;

      clp$begin_utility (rav$cresc_utility_name, utility_attributes_p^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$include_file (clc$current_command_input, prompt_value, rav$cresc_utility_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$end_utility (rav$cresc_utility_name, status);

    END /main/;

    IF memory_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (memory_segment_pointer, 1, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$create_subproduct_corr;

MODEND ram$create_subproduct_corr;
