
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting: Process Record' ??
MODULE fdm$process_record;

{ PURPOSE:
{   This module creates, changes, and gets data about a form record definition.
{
{ DESIGN:
{   Do not make any changes to a form record definition if any of the chanages are invalid.

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

?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
*copyc fde$condition_identifiers
*copyc fdc$system_record_type
*copyc fdt$form_definition
*copyc fdt$form_identifier
*copyc fdt$form_module
*copyc fdt$form_status
*copyc fdt$form_table_definition
*copyc fdt$form_variable_definition
*copyc fdt$get_record_attributes
*copyc fdt$record_attribute_index
*copyc fdt$record_attributes
*copyc fdt$record_definition_key
*copyc fdt$table_index
*copyc fdt$table_variable_index
*copyc fdt$table_variable
*copyc fdt$table_variables
*copyc fdt$variable_index
*copyc fdt$variable_record_definition
*copyc ost$name
?? POP ??

*copyc clp$validate_name
*copyc fdp$find_change_form_definition
*copyc fdp$find_form_definition
*copyc fdp$find_table_definition
*copyc fdp$ptr_record_definitions
*copyc fdp$validate_name
*copyc pmp$continue_to_cause
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal

?? TITLE := 'fdp$change_form_record', EJECT ??
*copyc fdh$change_form_record

  PROCEDURE [XDCL] fdp$change_form_record
    (    form_identifier: fdt$form_identifier;
     VAR record_attributes: fdt$record_attributes;
     VAR status: ost$status);

    VAR
      n: fdt$record_attribute_index,
      name_exists: boolean,
      name_is_valid: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_status: ^fdt$form_status,
      p_form_table_definition: ^fdt$form_table_definition,
      table_index: fdt$table_index,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

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

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_form_record;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_form_record;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR n := LOWERBOUND (record_attributes) TO UPPERBOUND (record_attributes) DO
      record_attributes [n].put_value_status := fdc$unprocessed_put_value;
    FOREND;

    p_form_definition := p_form_status^.p_form_definition;

  /process_record_attributes/
    FOR n := LOWERBOUND (record_attributes) TO UPPERBOUND (record_attributes) DO

      CASE record_attributes [n].key OF

      = fdc$record_deck_name =
        IF record_attributes [n].record_deck_name = ' ' THEN
          p_form_definition^.record_deck_name := '';
          record_attributes [n].put_value_status := fdc$put_value_accepted;
        ELSE
          clp$validate_name (record_attributes [n].record_deck_name, valid_name, name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_deck_name,
                  record_attributes [n].record_deck_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  p_form_definition^.form_name, status);
            RETURN;
          IFEND;
          p_form_definition^.record_deck_name := valid_name;
          record_attributes [n].put_value_status := fdc$put_value_accepted;
        IFEND;

      = fdc$record_name =
        IF record_attributes [n].record_name = ' ' THEN
          p_form_definition^.record_name := ' ';
          record_attributes [n].put_value_status := fdc$put_value_accepted;

        ELSE
          fdp$validate_name (record_attributes [n].record_name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_record_name,
                  record_attributes [n].record_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                  p_form_definition^.form_name, status);
            RETURN;
          IFEND;
          p_form_definition^.record_name := valid_name;
          record_attributes [n].put_value_status := fdc$put_value_accepted;
        IFEND;

      = fdc$record_type =
        IF ((record_attributes [n].record_type = fdc$program_data_type_record) OR
              (record_attributes [n].record_type = fdc$character_record)) THEN
          p_form_definition^.record_type := record_attributes [n].record_type;
          record_attributes [n].put_value_status := fdc$put_value_accepted;

        ELSE
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_record_type,
                record_attributes [n].table_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

      = fdc$table_access =
        fdp$validate_name (record_attributes [n].table_name, p_form_definition^.processor, valid_name,
              name_is_valid);
        IF NOT name_is_valid THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_table_name,
                record_attributes [n].table_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        fdp$find_table_definition (valid_name, p_form_status^.p_form_table_definitions,
              p_form_definition^.form_table_definitions.active_number, p_form_table_definition, table_index,
              name_exists);
        IF NOT name_exists THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_table_name,
                record_attributes [n].table_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;
        IFEND;

        p_form_table_definition^.access_all_occurrences := record_attributes [n].access_all_occurrences;
        record_attributes [n].put_value_status := fdc$put_value_accepted;

      = fdc$unused_record_entry =
        record_attributes [n].put_value_status := fdc$put_value_accepted;

      ELSE

{ The record attribute is invalid.

        osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_record_attribute,
              p_form_definition^.form_name, status);
        RETURN;

      CASEND;
    FOREND /process_record_attributes/;

  PROCEND fdp$change_form_record;

?? TITLE := 'fdp$get_record_attributes', EJECT ??
*copyc fdh$get_record_attributes

  PROCEDURE [XDCL] fdp$get_record_attributes
    (    form_identifier: fdt$form_identifier;
     VAR get_record_attributes: fdt$get_record_attributes;
     VAR status: ost$status);

    VAR
      current_name_index: fdt$variable_index,
      j: fdt$variable_index,
      n: fdt$record_attribute_index,
      name_exists: boolean,
      name_is_valid: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      p_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_variable_record_definition: ^fdt$variable_record_definition,
      record_definition_key: fdt$record_definition_key,
      table_index: fdt$table_index,
      table_variable_index: fdt$table_variable_index,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

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

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_record_attributes;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_record_attributes;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    FOR n := LOWERBOUND (get_record_attributes) TO UPPERBOUND (get_record_attributes) DO
      get_record_attributes [n].get_value_status := fdc$unprocessed_get_value;
    FOREND;

    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    current_name_index := 1;
    p_record_definitions := p_form_status^.p_form_record_definitions;
    p_form_definition := p_form_status^.p_form_definition;
    p_form_module := p_form_status^.p_form_module;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    FOR n := LOWERBOUND (get_record_attributes) TO UPPERBOUND (get_record_attributes) DO

    /process_record_attributes/
      BEGIN
        CASE get_record_attributes [n].key OF

        = fdc$get_record_deck_name =
          get_record_attributes [n].record_deck_name := p_form_definition^.record_deck_name;
          IF p_form_definition^.record_deck_name = osc$null_name THEN
            get_record_attributes [n].get_value_status := fdc$undefined_value;
          ELSE
            get_record_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_record_length =
          get_record_attributes [n].record_length := p_form_definition^.program_record_length;
          get_record_attributes [n].get_value_status := fdc$system_computed_value;

        = fdc$get_record_name =
          IF p_form_definition^.record_name = osc$null_name THEN
            get_record_attributes [n].get_value_status := fdc$undefined_value;
          ELSE
            get_record_attributes [n].record_name := p_form_definition^.record_name;
            get_record_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_record_type =
          get_record_attributes [n].record_type := p_form_definition^.record_type;
          IF p_form_definition^.record_type = fdc$system_record_type THEN
            get_record_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_record_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_table_access =
          fdp$validate_name (get_record_attributes [n].table_name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_table_name,
                  get_record_attributes [n].table_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          fdp$find_table_definition (valid_name, p_form_status^.p_form_table_definitions,
                p_form_definition^.form_table_definitions.active_number, p_form_table_definition, table_index,
                name_exists);
          IF NOT name_exists THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_table_name,
                  get_record_attributes [n].table_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          get_record_attributes [n].access_all_occurrences := p_form_table_definition^.access_all_occurrences;

        = fdc$get_unused_record_entry =
          get_record_attributes [n].get_value_status := fdc$undefined_value;

        ELSE

{ Invalid record attribute.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_record_attribute,
                p_form_definition^.form_name, status);
          RETURN;
        CASEND;
      END /process_record_attributes/;
    FOREND;

  PROCEND fdp$get_record_attributes;

MODEND fdm$process_record;
