?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := 'NOS/VE Screen Formatter : Design Form' ??
MODULE fdm$design_form;
?? NEWTITLE := 'Global Declarations', EJECT ??
*copyc amp$put_next

*copyc clp$trimmed_string_size

*copyc cyd$run_time_error_condition

*copyc fdc$im_smart_capability
*copyc fdc$integer_length
*copyc fdc$message_form_capability
*copyc fdc$real_length
*copyc fdc$reassign_event_capability
*copyc fdc$system_design_variable_name
*copyc fdc$system_design_table_name
*copyc fdc$screen_formatting_version
*copyc fdc$validation_capability
*copyc fdc$screen_generator_version
*copyc fde$condition_identifiers
*copyc fdp$change_form
*copyc fdp$change_object
*copyc fdp$check_for_active_form
*copyc fdp$check_for_overlayed_objects
*copyc fdp$close_form
*copyc fdp$convert_to_cobol_name
*copyc fdp$convert_to_fortran_name
*copyc fdp$convert_terminal_status
*copyc fdp$convert_to_screen_variable
*copyc fdp$create_form
*copyc fdp$create_form_status
*copyc fdp$create_object
*copyc fdp$create_table
*copyc fdp$create_variable
*copyc fdp$end_form
*copyc fdp$delete_object
*copyc fdp$find_change_form_definition
*copyc fdp$find_display_name
*copyc fdp$find_form_definition
*copyc fdp$find_form_status
*copyc fdp$find_object_definition
*copyc fdp$find_variable_definition
*copyc fdp$get_string_variable
*copyc fdp$locate_added_variable_facts
*copyc fdp$open_form
*copyc fdp$ptr_comments
*copyc fdp$ptr_displays
*copyc fdp$ptr_events
*copyc fdp$ptr_event_command
*copyc fdp$ptr_objects
*copyc fdp$ptr_record_definitions
*copyc fdp$ptr_tables
*copyc fdp$ptr_table_objects
*copyc fdp$ptr_table_variables
*copyc fdp$ptr_text
*copyc fdp$ptr_valid_integers
*copyc fdp$ptr_valid_reals
*copyc fdp$ptr_valid_strings
*copyc fdp$ptr_variable
*copyc fdp$ptr_variables
*copyc fdp$record_screen_change
*copyc fdp$rel_comments
*copyc fdp$rel_displays
*copyc fdp$rel_event_command
*copyc fdp$rel_events
*copyc fdp$rel_objects
*copyc fdp$rel_tables
*copyc fdp$rel_table_objects
*copyc fdp$rel_table_variables
*copyc fdp$rel_text
*copyc fdp$rel_record_definitions
*copyc fdp$rel_valid_integers
*copyc fdp$rel_valid_reals
*copyc fdp$rel_valid_strings
*copyc fdp$rel_variables
*copyc fdp$replace_string_variable
*copyc fdt$comment_index
*copyc fdt$display_index
*copyc fdt$event_index
*copyc fdt$number_record_variables
*copyc fdt$table_variable_index
*copyc fdt$valid_integer_index
*copyc fdt$valid_real_index
*copyc fdt$valid_string_index
*copyc fdt$error_header

*copyc i#current_sequence_position
*copyc i#move

*copyc llt$identification
*copyc llt$module_generator
*copyc llt$module_kind
*copyc llt$object_text_descriptor
*copyc llt$object_record_kind

*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$verify_access

*copyc pmp$continue_to_cause
*copyc pmp$generate_unique_name
*copyc pmp$get_legible_date_time

*copyc osp$append_status_parameter
*copyc osp$append_status_integer
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal
*copyc ost$name

*copyc fdv$colors
*copyc fdv$to_cobol
*copyc fdv$to_cybil
*copyc fdv$to_fortran
*copyc fdv$to_extended_fortran
*copyc fdv$screen_status

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

  PROCEDURE [XDCL] fdp$copy_area
    (    form_identifier: fdt$form_identifier;
         from_x_position: fdt$x_position;
         from_y_position: fdt$y_position;
         width: fdt$width;
         height: fdt$height;
         to_x_position: fdt$x_position;
         to_y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      active_objects: fdt$number_objects,
      copy_objects: fdt$number_objects,
      form_object_definition: fdt$form_object_definition,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      from_occurrence: fdt$occurrence,
      local_status: ost$status,
      object_attributes: array [1 .. 1] of fdt$object_attribute,
      object_definition: fdt$object_definition,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_copied_text: ^fdt$text,
      p_form_definition: ^fdt$form_definition,
      p_form_image: ^fdt$form_image,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_copy_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_copy_text: ^fdt$text,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      p_text_sequence: ^SEQ ( * ),
      text_length: fdt$text_length,
      to_occurrence: fdt$occurrence,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      x_increment: integer,
      x_position: fdt$x_position,
      y_increment: integer,
      y_position: fdt$y_position;

?? 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$copy_area;
      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$copy_area;
      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_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;

{ The destination area must be inside area occupied by form. }

    IF p_form_definition^.form_area.key = fdc$defined_area THEN
      IF (to_x_position - 1 + width) > p_form_definition^.form_area.width THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$copy_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;

      IF (to_y_position - 1 + height) > p_form_definition^.form_area.height THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$copy_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;
    IFEND;

    high_y_position := from_y_position + height - 1;
    high_x_position := from_x_position + width - 1;
    active_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_module := p_form_status^.p_form_module;

{ The source area must not slice any existing objects.
{ Free text may be slieced

    check_for_sliced_objects (p_form_status, p_form_definition, p_form_module, p_form_object_definitions,
          active_objects, from_x_position, from_y_position, high_x_position, high_y_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ The destination area must not overlay any existing objects.

    form_object_definition.key := fdc$form_constant_text_box;
    form_object_definition.constant_box_height := height;
    form_object_definition.constant_box_width := width;
    form_object_definition.x_position := to_x_position;
    form_object_definition.y_position := to_y_position;
    p_form_image := p_form_status^.p_form_image;
    IF p_form_image <> NIL THEN
      fdp$check_for_overlayed_objects (p_form_image,
           ^form_object_definition, p_form_definition^.form_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Free text must not overlay any objects. }

    IF p_form_status^.design_form THEN
      variable_name := p_form_status^.design_variable_name;
      PUSH p_text: [p_form_definition^.form_area.width];

    /check_free_text_overlay/
      FOR y_position := 1 TO height DO
        to_occurrence := to_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area get failed', status);
          RETURN;
        IFEND;

        FOR x_position := to_x_position TO to_x_position + width - 1 DO
          IF p_text^ (x_position, 1) <> ' ' THEN
            IF p_form_image <> NIL THEN
              IF p_form_image^ [to_occurrence] (x_position, 1) <> ' ' THEN
                osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
                osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position),
                    10, FALSE, status);
                osp$append_status_integer (osc$status_parameter_delimiter,
                     $INTEGER (to_occurrence), 10, FALSE, status);
                osp$append_status_parameter (osc$status_parameter_delimiter,
                      p_form_definition^.form_name, status);
                RETURN;
              IFEND;
            IFEND;
          IFEND;
        FOREND;
      FOREND /check_free_text_overlay/;
    IFEND;

    x_increment := to_x_position - from_x_position;
    y_increment := to_y_position - from_y_position;
    copy_objects := 0;
    IF active_objects > 0 THEN

{ Form list of objects contained in the source area to copy. }

      PUSH p_copy_object_definitions: [1 .. active_objects];

    /find_objects_to_copy/
      FOR object_index := 1 TO active_objects DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =

{ Do not copy variable for design form. It is only the background for other
{ objects created by the form designer.

          IF p_form_status^.design_form THEN
            IF p_form_object_definition^.name = variable_name THEN
              CYCLE /find_objects_to_copy/;
            IFEND;
          IFEND;

        = fdc$form_text_box_fragment, fdc$form_unused_object,
          fdc$form_stored_variable =

{ Stored objects do not appear on the screen.
{ Fragments will be created from source object.

          CYCLE /find_objects_to_copy/;

         ELSE
         CASEND;

        IF p_form_object_definition^.y_position >= from_y_position THEN
          IF p_form_object_definition^.y_position <= high_y_position THEN
            IF p_form_object_definition^.x_position >= from_x_position THEN
              IF p_form_object_definition^.x_position <= high_x_position THEN
                copy_objects := copy_objects + 1;
                p_copy_object_definitions^ [copy_objects] := p_form_object_definition^;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND /find_objects_to_copy/;
    IFEND;

{ Save the free text in the area to copy. }

    IF p_form_status^.design_form THEN
      PUSH p_text_sequence: [[REP (height * width) OF CHAR]];
      RESET p_text_sequence;

    /get_free_text/
      FOR y_position := 1 TO height DO
        from_occurrence := from_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, from_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area get failed', status);
          RETURN;
        IFEND;
        NEXT p_copy_text: [width] IN p_text_sequence;
        p_copy_text^ := p_text^ (from_x_position, width);
      FOREND /get_free_text/;

      RESET p_text_sequence;

{ Copy free text in area. }

    /copy_free_text/
      FOR y_position := 1 TO height DO
        to_occurrence := to_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area get failed', status);
          RETURN;
        IFEND;
        NEXT p_copy_text: [width] IN p_text_sequence;
        p_text^ (to_x_position, width) := p_copy_text^;
        fdp$replace_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area replace failed', status);
          RETURN;
        IFEND;
      FOREND /copy_free_text/;
    IFEND;

    object_attributes [1].key := fdc$object_display;

{ Copy objects in area. }

  /copy_area_objects/
    FOR object_index := 1 TO copy_objects DO
      p_form_object_definition := ^p_copy_object_definitions^ [object_index];
      object_attributes [1].display_attribute := p_form_object_definition^.display_attribute;
      x_position := p_form_object_definition^.x_position + x_increment;
      y_position := p_form_object_definition^.y_position + y_increment;

      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        object_definition.key := fdc$box;
        object_definition.box_width := p_form_object_definition^.box_width;
        object_definition.box_height := p_form_object_definition^.box_height;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_line =
        object_definition.key := fdc$line;
        object_definition.x_increment := p_form_object_definition^.x_increment;
        object_definition.y_increment := p_form_object_definition^.y_increment;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_variable_text =
        object_definition.key := fdc$variable_text;
        object_definition.variable_text_width := p_form_object_definition^.text_variable_width;
        object_definition.p_variable_text := fdp$ptr_text (p_form_object_definition^.text_variable_text,
              p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_variable_text_box =
        object_definition.key := fdc$variable_text_box;
        object_definition.variable_box_height := p_form_object_definition^.variable_box_height;
        object_definition.variable_box_width := p_form_object_definition^.variable_box_width;
        object_definition.variable_box_processing := p_form_object_definition^.variable_box_processing;
        object_definition.p_variable_box_text := fdp$ptr_text
              (p_form_object_definition^.variable_box_text, p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object', status);
          RETURN;
        IFEND;

      = fdc$form_constant_text =
        object_definition.key := fdc$constant_text;
        object_definition.p_constant_text := fdp$ptr_text (p_form_object_definition^.constant_text,
              p_form_module);
        object_definition.constant_text_width := p_form_object_definition^.constant_text_width;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_constant_text_box =
        object_definition.key := fdc$constant_text_box;
        object_definition.constant_box_height := p_form_object_definition^.constant_box_height;
        object_definition.constant_box_processing := p_form_object_definition^.constant_box_processing;
        object_definition.constant_box_width := p_form_object_definition^.constant_box_width;
        object_definition.p_constant_box_text := fdp$ptr_text
              (p_form_object_definition^.constant_box_text, p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_table =
        object_definition.key := fdc$table;
        object_definition.table_width := p_form_object_definition^.table_width;
        object_definition.table_height := p_form_object_definition^.table_height;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy area create object failed', status);
          RETURN;
        IFEND;

      ELSE
      CASEND;
    FOREND /copy_area_objects/;

  PROCEND fdp$copy_area;

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

  PROCEDURE [XDCL] fdp$delete_area
    (    form_identifier: fdt$form_identifier;
         x_position: fdt$x_position;
         y_position: fdt$y_position;
         width: fdt$width;
         height: fdt$height;
     VAR status: ost$status);

    VAR
      active_objects: fdt$number_objects,
      delete_objects: fdt$number_objects,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      object_index: fdt$object_index,
      object_x_position: fdt$x_position,
      object_y_position: fdt$y_position,
      occurrence: fdt$occurrence,
      p_delete_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      variable_name: ost$name,
      variable_status: fdt$variable_status;

?? 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$delete_area;
      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$delete_area;
      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_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;

{ Delete area must be inside area occupied by form. }

    IF p_form_definition^.form_area.key = fdc$defined_area THEN
      IF (x_position - 1 + width) > p_form_definition^.form_area.width THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$delete_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;

      IF (y_position - 1 + height) > p_form_definition^.form_area.height THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$delete_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;
    IFEND;

    high_y_position := y_position + height - 1;
    high_x_position := x_position + width - 1;
    active_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_module := p_form_status^.p_form_module;

{ Delete area must not slice any objects. }

    check_for_sliced_objects (p_form_status, p_form_definition, p_form_module, p_form_object_definitions,
          active_objects, x_position, y_position, high_x_position, high_y_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    delete_objects := 0;
    IF active_objects > 0 THEN
      PUSH p_delete_object_definitions: [1 .. active_objects];
      variable_name := p_form_status^.design_variable_name;

{ Form list of objects to delete. }
{ Do not delete design variable objects used for free text on }
{ the design form. }

    /find_objects_to_delete/
      FOR object_index := 1 TO active_objects DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =

{ The design variable is only used as a background for
{ doing work on the design form.  Do not delete it.

          IF p_form_status^.design_form THEN
            IF p_form_object_definition^.name = variable_name THEN
              CYCLE /find_objects_to_delete/;
            IFEND;
          IFEND;

        = fdc$form_text_box_fragment, fdc$form_unused_object,
          fdc$form_stored_variable =

{ Stored objects do not appear on the screen.
{ Fragments will be deleted when the source object is deleted.

            CYCLE /find_objects_to_delete/;

        ELSE
        CASEND;

        IF p_form_object_definition^.y_position >= y_position THEN
          IF p_form_object_definition^.y_position <= high_y_position THEN
            IF p_form_object_definition^.x_position >= x_position THEN
              IF p_form_object_definition^.x_position <= high_x_position THEN
                delete_objects := delete_objects + 1;
                p_delete_object_definitions^ [delete_objects] := p_form_object_definition^;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND /find_objects_to_delete/;
    IFEND;

{ Delete the objects in the area. }

  /delete_form_objects/
    FOR object_index := 1 TO delete_objects DO
      p_form_object_definition := ^p_delete_object_definitions^ [object_index];
      fdp$delete_object (form_identifier, p_form_object_definition^.x_position, p_form_object_definition^.
            y_position, status);
      IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'delete area delete object failed', status);
        RETURN;
      IFEND;
    FOREND /delete_form_objects/;

    IF p_form_status^.design_form THEN
      PUSH p_text: [p_form_definition^.form_area.width];

{ Delete free text in the area. }

    /delete_free_text/
      FOR occurrence := y_position TO high_y_position DO
        fdp$get_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'delete area get failed', status);
          RETURN;
        IFEND;

        IF p_text^ (x_position, width) <> ' ' THEN
          p_text^ (x_position, width) := ' ';
          fdp$replace_string_variable (form_identifier, variable_name, occurrence, p_text^, variable_status,
                status);
          IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'delete area replace failed', status);
            RETURN;
          IFEND;
        IFEND;
      FOREND /delete_free_text/;
    IFEND;

  PROCEND fdp$delete_area;

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

  PROCEDURE [XDCL] fdp$move_area
    (    form_identifier: fdt$form_identifier;
         from_x_position: fdt$x_position;
         from_y_position: fdt$y_position;
         width: fdt$width;
         height: fdt$height;
         to_x_position: fdt$x_position;
         to_y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      active_objects: fdt$number_objects,
      form_object_definition: fdt$form_object_definition,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      from_occurrence: fdt$occurrence,
      local_status: ost$status,
      move_objects: fdt$number_objects,
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition,
      object_exists: boolean,
      object_index: fdt$object_index,
      p_copied_text: ^fdt$text,
      p_form_definition: ^fdt$form_definition,
      p_form_image: ^fdt$form_image,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      p_move_text: ^fdt$text,
      p_move_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_text: ^fdt$text,
      p_text_sequence: ^SEQ ( * ),
      text_length: fdt$text_length,
      to_high_x_position: fdt$x_position,
      to_high_y_position: fdt$y_position,
      to_occurrence: fdt$occurrence,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      x_increment: integer,
      x_position: fdt$x_position,
      y_increment: integer,
      y_position: fdt$y_position;

?? 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$move_area;
      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$move_area;
      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_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;

{ Move destination area must not go outside boundaries of form. }

    IF p_form_definition^.form_area.key = fdc$defined_area THEN
      IF (to_x_position - 1 + width) > p_form_definition^.form_area.width THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$move_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;

      IF (to_y_position - 1 + height) > p_form_definition^.form_area.height THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$move_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;
    IFEND;

    high_y_position := from_y_position + height - 1;
    high_x_position := from_x_position + width - 1;
    active_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_module := p_form_status^.p_form_module;

{ On a move to exactly the same area, do nothing. }

    IF ((from_x_position = to_x_position) AND (from_y_position = to_y_position)) THEN
      RETURN;
    IFEND;

{ The source area must not slice any existing objects. }
{ Free text may be sliced. }

    check_for_sliced_objects (p_form_status, p_form_definition, p_form_module, p_form_object_definitions,
          active_objects, from_x_position, from_y_position, high_x_position, high_y_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ The objects in the from area must not collide with any existing objects in the }
{ to area.  Check for collisions in areas formed by intersections of to and from areas }
{ outside of the from area. }

    to_high_y_position := to_y_position + height - 1;
    to_high_x_position := to_x_position + width - 1;
    p_form_image := p_form_status^.p_form_image;
    form_object_definition.key := fdc$form_constant_text_box;

    IF (to_high_x_position >= from_x_position) AND
         (to_high_y_position >= from_y_position) AND
         (to_high_x_position <= high_x_position) AND
         (to_high_y_position <= high_y_position) THEN

{ Lower right corner of to area is inside of from area. }
{ Check to area above from area. }

      IF from_y_position > to_y_position THEN
        form_object_definition.constant_box_height := from_y_position - to_y_position;
        form_object_definition.constant_box_width := width;
        form_object_definition.x_position := to_x_position;
        form_object_definition.y_position := to_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

{ Check to area to left of from area. }

      IF from_x_position > to_x_position THEN
        form_object_definition.constant_box_height := to_high_y_position - from_y_position + 1;
        form_object_definition.constant_box_width := from_x_position - to_x_position;
        form_object_definition.x_position := to_x_position;
        form_object_definition.y_position := from_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

    ELSEIF (to_x_position >= from_x_position) AND
         (to_high_y_position >= from_y_position) AND
         (to_x_position <= high_x_position) AND
         (to_high_y_position <= high_y_position) THEN

{ Lower left corner of to area is inside of from area. }
{ Check to area above from area. }

      IF from_y_position > to_y_position THEN
        form_object_definition.constant_box_height := from_y_position - to_y_position;
        form_object_definition.constant_box_width := width;
        form_object_definition.x_position := to_x_position;
        form_object_definition.y_position := to_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

{ Check to area to right of from area. }

      IF to_high_x_position > high_x_position THEN
        form_object_definition.constant_box_height :=
             to_high_y_position - from_y_position + 1;
        form_object_definition.constant_box_width := to_high_x_position - high_x_position;
        form_object_definition.x_position := high_x_position + 1;
        form_object_definition.y_position := from_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

    ELSEIF (to_high_x_position >= from_x_position) AND
         (to_y_position >= from_y_position) AND
         (to_high_x_position <= high_x_position) AND
         (to_y_position <= high_y_position) THEN

{ Upper right corner of to area is inside of from area. }
{ Check to area below from area. }

      IF to_high_y_position > high_y_position THEN
        form_object_definition.constant_box_height := to_high_y_position - high_y_position;
        form_object_definition.constant_box_width := width;
        form_object_definition.x_position := to_x_position;
        form_object_definition.y_position := high_y_position + 1;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

{ Check to area to left of from area. }

      IF from_x_position > to_x_position THEN
        form_object_definition.constant_box_height := high_y_position - y_position + 1;
        form_object_definition.constant_box_width := from_x_position - to_x_position;
        form_object_definition.x_position := to_x_position;
        form_object_definition.y_position := to_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;

    ELSEIF (to_x_position >= from_x_position) AND
         (to_y_position >= from_y_position) AND
         (to_x_position <= high_x_position) AND
         (to_y_position <= high_y_position) THEN

{ Upper left corner of to area is inside of from area. }
{ Check to area below from area. }


    IF to_high_y_position > high_y_position THEN
      form_object_definition.constant_box_height := to_high_y_position - high_y_position;
      form_object_definition.constant_box_width := width;
      form_object_definition.x_position := to_x_position;
      form_object_definition.y_position := high_y_position + 1;
      IF p_form_image <> NIL THEN
        fdp$check_for_overlayed_objects (p_form_image,
             ^form_object_definition, p_form_definition^.form_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

{ Check to area to right of from area. }

      IF to_high_x_position > high_x_position THEN
        form_object_definition.constant_box_height := high_y_position - to_y_position + 1;
        form_object_definition.constant_box_width := to_high_x_position - high_x_position;
        form_object_definition.x_position := high_x_position + 1;
        form_object_definition.y_position := to_y_position;
        IF p_form_image <> NIL THEN
          fdp$check_for_overlayed_objects (p_form_image,
               ^form_object_definition, p_form_definition^.form_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
       IFEND;
     IFEND;

    ELSE { The to area does not overlay the from area. }
      form_object_definition.constant_box_height := height;
      form_object_definition.constant_box_width := width;
      form_object_definition.x_position := to_x_position;
      form_object_definition.y_position := to_y_position;
      IF p_form_image <> NIL THEN
        fdp$check_for_overlayed_objects (p_form_image,
             ^form_object_definition, p_form_definition^.form_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

{ Check that free text will not overlay any objects. }

    IF p_form_status^.design_form THEN
      variable_name := p_form_status^.design_variable_name;
      PUSH p_text: [p_form_definition^.form_area.width];

    /check_free_text_overlay/
      FOR y_position := 1 TO height DO
        to_occurrence := to_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area get failed', status);
          RETURN;
        IFEND;
        FOR x_position := to_x_position TO to_x_position + width - 1 DO
          IF p_text^ (x_position, 1) <> ' ' THEN
            IF p_form_image <> NIL THEN
              IF p_form_image^ [to_occurrence] (x_position, 1) <> ' ' THEN
                osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
                osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position),
                    10, FALSE, status);
                osp$append_status_integer (osc$status_parameter_delimiter,
                     $INTEGER (to_occurrence), 10, FALSE, status);
                osp$append_status_parameter (osc$status_parameter_delimiter,
                     p_form_definition^.form_name, status);
                RETURN;
              IFEND;
            IFEND;
          IFEND;
        FOREND;
      FOREND /check_free_text_overlay/;
    IFEND;

{ Form list of objects to move. }

    x_increment := to_x_position - from_x_position;
    y_increment := to_y_position - from_y_position;
    move_objects := 0;
    IF active_objects > 0 THEN

      PUSH p_move_object_definitions: [1 .. active_objects];

    /find_objects_to_move/
      FOR object_index := 1 TO active_objects DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =

{ Do not move design variable on the design form.
{ It is only a background for other objects created by the form designer.

          IF p_form_status^.design_form THEN
            IF p_form_object_definition^.name = variable_name THEN
              CYCLE /find_objects_to_move/;
             IFEND;
          IFEND;

       = fdc$form_text_box_fragment, fdc$form_unused_object,
         fdc$form_stored_variable =

{ Stored objects do not appear on the screen.
{ Fragments will be moved when the source item is moved.

         CYCLE /find_objects_to_move/;

       ELSE
       CASEND;

        IF p_form_object_definition^.y_position >= from_y_position THEN
          IF p_form_object_definition^.y_position <= high_y_position THEN
            IF p_form_object_definition^.x_position >= from_x_position THEN
              IF p_form_object_definition^.x_position <= high_x_position THEN
                move_objects := move_objects + 1;
                p_move_object_definitions^ [move_objects] := p_form_object_definition^;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND /find_objects_to_move/;
    IFEND;

    IF p_form_status^.design_form THEN
      PUSH p_text_sequence: [[REP (height * width) OF CHAR]];
      RESET p_text_sequence;

{ Move free text on the design form. }

    /find_free_text/
      FOR y_position := 1 TO height DO
        from_occurrence := from_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, from_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area get failed', status);
          RETURN;
        IFEND;

        NEXT p_move_text: [width] IN p_text_sequence;
        p_move_text^ := p_text^ (from_x_position, width);
      FOREND /find_free_text/;

{ Delete the free text in the from area. }

    /delete_free_text/
      FOR y_position := 1 TO height DO
        from_occurrence := from_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, from_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area get failed', status);
          RETURN;
        IFEND;

        p_text^ (from_x_position, width) := ' ';
        fdp$replace_string_variable (form_identifier, variable_name, from_occurrence, p_text^,
              variable_status, status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area replace failed', status);
          RETURN;
        IFEND;
      FOREND /delete_free_text/;

      RESET p_text_sequence;

{ Add the free text in the to area. }

    /move_free_text/
      FOR y_position := 1 TO height DO
        to_occurrence := to_y_position + y_position - 1;
        fdp$get_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area get failed', status);
          RETURN;
        IFEND;
        NEXT p_move_text: [width] IN p_text_sequence;
        p_text^ (to_x_position, width) := p_move_text^;
        fdp$replace_string_variable (form_identifier, variable_name, to_occurrence, p_text^, variable_status,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area replace failed', status);
          RETURN;
        IFEND;
      FOREND /move_free_text/;
    IFEND;

{ Delete the objects in the from area so that they will not collide when they are }
{ added in the to area. }

    FOR object_index := 1 TO move_objects DO
      fdp$delete_object (form_identifier, p_move_object_definitions^ [object_index].x_position,
            p_move_object_definitions^ [object_index].y_position, status);
      IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area delete object failed', status);
        RETURN;
      IFEND;
    FOREND;

    object_attributes [1].key := fdc$object_display;

{ Create new objects in the to area. }

  /move_objects_in_area/
    FOR object_index := 1 TO move_objects DO
      p_form_object_definition := ^p_move_object_definitions^ [object_index];
      object_attributes [1].display_attribute := p_form_object_definition^.display_attribute;
      IF p_form_object_definition^.name <> osc$null_name THEN
        object_attributes [2].key := fdc$object_name;
        object_attributes [2].object_name := p_form_object_definition^.name;
        object_attributes [2].occurrence := p_form_object_definition^.occurrence;
      ELSE
        object_attributes [2].key := fdc$unused_object_entry;
      IFEND;

      x_position := p_form_object_definition^.x_position + x_increment;
      y_position := p_form_object_definition^.y_position + y_increment;
      CASE p_form_object_definition^.key OF

      = fdc$form_box =
        object_definition.key := fdc$box;
        object_definition.box_width := p_form_object_definition^.box_width;
        object_definition.box_height := p_form_object_definition^.box_height;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_line =
        object_definition.key := fdc$line;
        object_definition.x_increment := p_form_object_definition^.x_increment;
        object_definition.y_increment := p_form_object_definition^.y_increment;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_variable_text =
        object_definition.key := fdc$variable_text;
        object_definition.variable_text_width := p_form_object_definition^.text_variable_width;
        object_definition.p_variable_text := fdp$ptr_text (p_form_object_definition^.text_variable_text,
              p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_variable_text_box =
        object_definition.key := fdc$variable_text_box;
        object_definition.variable_box_height := p_form_object_definition^.variable_box_height;
        object_definition.variable_box_width := p_form_object_definition^.variable_box_width;
        object_definition.variable_box_processing := p_form_object_definition^.variable_box_processing;
        object_definition.p_variable_box_text := fdp$ptr_text
              (p_form_object_definition^.variable_box_text, p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_constant_text =
        object_definition.key := fdc$constant_text;
        object_definition.p_constant_text := fdp$ptr_text (p_form_object_definition^.constant_text,
              p_form_module);
        object_definition.constant_text_width := p_form_object_definition^.constant_text_width;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_constant_text_box =
        object_definition.key := fdc$constant_text_box;
        object_definition.constant_box_height := p_form_object_definition^.constant_box_height;
        object_definition.constant_box_processing := p_form_object_definition^.constant_box_processing;
        object_definition.constant_box_width := p_form_object_definition^.constant_box_width;
        object_definition.p_constant_box_text := fdp$ptr_text
              (p_form_object_definition^.constant_box_text, p_form_module);
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      = fdc$form_table =
        object_definition.key := fdc$table;
        object_definition.table_width := p_form_object_definition^.table_width;
        object_definition.table_height := p_form_object_definition^.table_height;
        fdp$create_object (form_identifier, x_position, y_position, object_definition, object_attributes,
              status);
        IF NOT status.normal THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'move area create object failed', status);
          RETURN;
        IFEND;

      ELSE
        { Do nothing for remaining objects. }
      CASEND;

    FOREND /move_objects_in_area/;

  PROCEND fdp$move_area;

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

  PROCEDURE [XDCL] fdp$copy_form
    (    from_form_identifier: fdt$form_identifier;
     VAR to_form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      form_work_area: amt$segment_pointer,
      local_status: ost$status,
      p_from_form_module: ^fdt$form_module,
      p_from_form_status: ^fdt$form_status,
      p_to_form_status: ^fdt$form_status;

?? 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);
      IF form_work_area.sequence_pointer <> NIL THEN
        mmp$delete_scratch_segment (p_to_form_status^.segment_pointer, local_status);
      IFEND;
      IF p_to_form_status <> NIL THEN
        p_to_form_status^.entry_used := FALSE;
      IFEND;
        EXIT fdp$copy_form;
      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);
      IF form_work_area.sequence_pointer <> NIL THEN
        mmp$delete_scratch_segment (p_to_form_status^.segment_pointer, local_status);
      IFEND;
      IF p_to_form_status <> NIL THEN
        p_to_form_status^.entry_used := FALSE;
      IFEND;
        EXIT fdp$copy_form;
      IFEND;

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

?? OLDTITLE, EJECT ??

    p_to_form_status := NIL;
    form_work_area.kind := amc$sequence_pointer;
    form_work_area.sequence_pointer := NIL;
    osp$establish_condition_handler (^condition_handler, TRUE);
    fdp$find_form_definition (from_form_identifier, p_from_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$create_form_status (to_form_identifier, p_to_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_to_form_status^ := p_from_form_status^;
    p_to_form_status^.active_form_object_statuses := 0;
    p_to_form_status^.added := FALSE;
    p_to_form_status^.defined_dynamically := TRUE;
    p_to_form_status^.displayed_on_screen := FALSE;
    p_to_form_status^.event_form_defined := FALSE;
    p_to_form_status^.events_active := FALSE;
    p_to_form_status^.field_number_defined := FALSE;
    p_to_form_status^.graphic_identifier_defined := FALSE;
    p_to_form_status^.last_cursor_position_valid := FALSE;
    p_to_form_status^.mark_defined := FALSE;
    p_to_form_status^.opened := FALSE;
    p_to_form_status^.opened_for_query_only := FALSE;
    p_to_form_status^.owned_by_system := FALSE;
    p_to_form_status^.p_form_event_statuses := NIL;
    p_to_form_status^.p_form_image := NIL;
    p_to_form_status^.p_form_object_statuses := NIL;
    p_to_form_status^.p_form_table_statuses := NIL;
    p_to_form_status^.p_program_record := NIL;
    p_to_form_status^.p_screen_record := NIL;
    p_to_form_status^.push_count := 0;
    p_to_form_status^.storage_allocated := FALSE;
    p_to_form_status^.total_form_object_statuses := 0;
    p_to_form_status^.validate_variable_values := FALSE;
    p_to_form_status^.fast_form_creation := FALSE;
    p_from_form_module := p_from_form_status^.p_form_module;

{ The definition for the form is placed in a sequence in a scratch segment. }
{ All pointers in the sequence must be relative pointers so  that the sequence may }
{ later be saved on an object code library. }

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, form_work_area,
          status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      p_to_form_status^.entry_used := FALSE;
      RETURN;
    IFEND;

    p_to_form_status^.segment_pointer := form_work_area;
    RESET p_to_form_status^.segment_pointer.sequence_pointer;
    p_to_form_status^.p_form_module := p_to_form_status^.segment_pointer.sequence_pointer;
    copy_form (p_from_form_status, p_to_form_status, status);
    IF NOT status.normal THEN
      mmp$delete_scratch_segment (p_to_form_status^.segment_pointer, local_status);
      p_to_form_status^.entry_used := FALSE;
    IFEND;
  PROCEND fdp$copy_form;

?? TITLE := 'copy_form', EJECT ??

  PROCEDURE copy_form
    (    p_from_form_status: ^fdt$form_status;
         p_to_form_status: ^fdt$form_status;
     VAR status: ost$status);

    VAR
      p_from_form_definition: ^fdt$form_definition,
      p_from_form_module: ^fdt$form_module,
      p_from_help_message: ^fdt$help_message,
      p_to_form_definition: ^fdt$form_definition,
      p_to_form_module: ^fdt$form_module,
      p_to_help_message: ^fdt$help_message;

?? NEWTITLE := 'copy_added_variable_definition', EJECT ??
{  PURPOSE:
{    This procedure handles overflow from the original form variable definition.
{  DESIGN:
{    If the old form was created before the IM/SMART feature, create an additional
{    data area for the variable on the new form.

    PROCEDURE copy_added_variable_definition
      (    p_old_form_definition: ^fdt$form_definition;
           p_old_form_variable_definition: ^fdt$form_variable_definition;
           p_old_form_module: ^fdt$form_module;
           p_new_form_variable_definition: {output} ^fdt$form_variable_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        p_new_added_variable_definition: ^fdt$added_variable_definition,
        p_new_comment: ^fdt$comment,
        p_new_sequence: ^SEQ (*),
        p_old_added_variable_definition: ^fdt$added_variable_definition,
        p_old_comment: ^fdt$comment,
        p_new_comments: ^array [1 .. * ] of fdt$comment_definition,
        p_old_comments: ^array [1 .. * ] of fdt$comment_definition;

      status.normal := TRUE;

{ Make a form created before the IM SMART capability look like one created after
{ the IM SMART capability.  For a form created before the IM SMART capability create
{ a temporary additional data area for the variable.

      IF p_old_form_definition^.screen_formatting_version <
            fdc$im_smart_capability THEN
        PUSH p_old_added_variable_definition;
        i#move (^p_old_form_variable_definition^.additional_variable_facts,
              ^p_old_added_variable_definition^.comment_definitions,
              #SIZE (fdt$comment_definitions));
        p_old_added_variable_definition^.form_cobol_display_clause.defined := FALSE;
        p_old_added_variable_definition^.form_cobol_program_clause.defined := FALSE;
      ELSE

{ The form was created using the IM SMART capability.  The comment field of the
{ form variable definition was replaced to point to the additional data area for the
{ variable.

        fdp$locate_added_variable_facts (p_old_form_module, p_old_form_variable_definition,
             p_old_added_variable_definition);
      IFEND;

{ Create the new additional data area for the form variable definition. All copied
{ forms will have the additional data area and a version greater-equal to the
{ fdc$im_smart_capability.

      NEXT p_new_sequence: [[REP #SIZE(fdt$added_variable_definition) OF cell]] IN
            p_new_form_module;
      IF p_new_sequence = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier,
             fde$no_space_available, '', status);
        RETURN;
      IFEND;

      RESET p_new_sequence;
      NEXT p_new_added_variable_definition IN p_new_sequence;
      p_new_added_variable_definition^ := p_old_added_variable_definition^;
      p_new_form_variable_definition^.additional_variable_facts.additional_definitions :=
            #REL(p_new_sequence, p_new_form_module^);
      copy_comments (p_old_added_variable_definition^.comment_definitions.active_number,
            p_old_added_variable_definition^.comment_definitions,  p_old_form_module,
            p_new_form_module, p_new_added_variable_definition^.comment_definitions, status);

    PROCEND copy_added_variable_definition;

?? OLDTITLE ??
?? NEWTITLE := 'copy_comments', EJECT ??

    PROCEDURE  copy_comments
      (    active_number: fdt$number_comments;
           old_comment_definitions: fdt$comment_definitions;
           p_old_form_module: ^fdt$form_module;
       VAR p_new_form_module: ^fdt$form_module;
       VAR new_comment_definitions: fdt$comment_definitions;
       VAR status: ost$status);

      VAR
        comment_index: fdt$comment_index,
        p_new_comment: ^fdt$comment,
        p_old_comment: ^fdt$comment,
        p_new_comments: ^array [1 .. * ] of fdt$comment_definition,
        p_old_comments: ^array [1 .. * ] of fdt$comment_definition;

      status.normal := TRUE;
      IF active_number > 0 THEN
        p_old_comments := fdp$ptr_comments (old_comment_definitions, p_old_form_module);
        NEXT p_new_comments: [1 .. active_number] IN p_new_form_module;
        IF p_new_comments <> NIL THEN
          fdp$rel_comments (p_new_comments, p_new_form_module, new_comment_definitions);
          new_comment_definitions.active_number := active_number;

        /copy_comment_definitions/
          FOR comment_index := 1 TO active_number DO
            p_old_comment := #PTR (p_old_comments^ [comment_index].p_comment, p_old_form_module^);
            NEXT p_new_comment: [STRLENGTH (p_old_comment^)] IN p_new_form_module;
            IF p_new_comment <> NIL THEN
              p_new_comment^ := p_old_comment^;
              p_new_comments^ [comment_index].p_comment := #REL (p_new_comment, p_new_form_module^);

            ELSE { No space could be allocated to copy comment. }
              fdp$rel_comments (NIL, p_new_form_module, new_comment_definitions);
              new_comment_definitions.active_number := 0;
              osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
              EXIT /copy_comment_definitions/;
            IFEND;
          FOREND /copy_comment_definitions/;

        ELSE { No space for new comments. }
          fdp$rel_comments (NIL, p_new_form_module, new_comment_definitions);
          new_comment_definitions.active_number := 0;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old comments are active. }
        fdp$rel_comments (NIL, p_new_form_module, new_comment_definitions);
        new_comment_definitions.active_number := 0;
      IFEND;

    PROCEND copy_comments;


?? OLDTITLE ??
?? NEWTITLE := 'copy_display_definitions', EJECT ??

    PROCEDURE [INLINE] copy_display_definitions
      (    active_number: fdt$number_object_displays;
           p_old_display_definitions: ^array [1 .. * ] OF fdt$display_definition;
           p_new_form_status: ^fdt$form_status;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        display_index: fdt$display_index,
        p_new_display_definitions: ^array [1 .. * ] of fdt$display_definition;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_display_definitions: [1 .. active_number] IN p_new_form_module;

        IF p_new_display_definitions <> NIL THEN
          fdp$rel_displays (p_new_display_definitions, p_new_form_status);
          p_new_form_definition^.display_definitions.active_number := active_number;
          FOR display_index := 1 TO active_number DO
            p_new_display_definitions^ [display_index] := p_old_display_definitions^ [display_index];
          FOREND;

        ELSE { No space for new displays. }
          fdp$rel_displays (NIL, p_new_form_status);
          p_new_form_definition^.display_definitions.active_number := 0;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old displays are active. }
        fdp$rel_displays (NIL, p_new_form_status);
        p_new_form_definition^.display_definitions.active_number := 0;
      IFEND;
    PROCEND copy_display_definitions;

?? OLDTITLE ??
?? NEWTITLE := 'copy_event_definitions', EJECT ??

    PROCEDURE [INLINE] copy_event_definitions
      (    p_old_form_definition: ^fdt$form_definition;
           active_number: fdt$number_events;
           p_old_event_definitions: ^array [1 .. * ] OF fdt$event_definition;
           p_new_form_status: ^fdt$form_status;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        event_index: fdt$event_index,
        p_new_event_definitions: ^array [1 .. * ] of fdt$event_definition;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_event_definitions: [1 .. active_number] IN p_new_form_module;
        IF p_new_event_definitions <> NIL THEN
          fdp$rel_events (p_new_event_definitions, p_new_form_status);
          p_new_form_definition^.event_definitions.active_number := active_number;
          FOR event_index := 1 TO active_number DO
            p_new_event_definitions^ [event_index] := p_old_event_definitions^ [event_index];
            IF (p_old_form_definition^.screen_formatting_version <
                  fdc$reassign_event_capability) THEN
               p_new_event_definitions^ [event_index].event_trigger_reassignment := TRUE;
            IFEND;
          FOREND;

        ELSE { No space for new events. }
          fdp$rel_events (NIL, p_new_form_status);
          p_new_form_definition^.event_definitions.active_number := 0;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No events are defined. }
        fdp$rel_events (NIL, p_new_form_status);
        p_new_form_definition^.event_definitions.active_number := 0;
      IFEND;
    PROCEND copy_event_definitions;

?? OLDTITLE ??
?? NEWTITLE := 'copy_object_definitions', EJECT ??

    PROCEDURE copy_object_definitions
      (    active_number: fdt$number_objects;
           p_old_form_module: ^fdt$form_module;
           p_old_object_definitions: ^array [1 .. * ] OF fdt$form_object_definition;
           p_new_form_status: ^fdt$form_status;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        form_object_key: fdt$form_object_key,
        old_object_index: fdt$object_index,
        p_new_object_definition: ^fdt$form_object_definition,
        p_new_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
        p_old_object_definition: ^fdt$form_object_definition,
        p_new_text: ^fdt$text,
        p_old_text: ^fdt$text;

      status.normal := TRUE;
      IF active_number = 0 THEN
        fdp$rel_objects (NIL, p_new_form_status);
        p_new_form_definition^.form_object_definitions.active_number := 0;
        RETURN;
      IFEND;

      NEXT p_new_object_definitions: [1 .. active_number] IN p_new_form_module;
      IF p_new_object_definitions = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      fdp$rel_objects (p_new_object_definitions, p_new_form_status);
      p_new_form_definition^.form_object_definitions.active_number := active_number;

    /copy_objects/
      FOR old_object_index := 1 TO active_number DO
        p_old_object_definition := ^p_old_object_definitions^ [old_object_index];
        p_new_object_definitions^ [old_object_index] := p_old_object_definition^;
        form_object_key := p_old_object_definition^.key;
        CASE form_object_key OF

        = fdc$form_box, fdc$form_line, fdc$form_table, fdc$form_text_box_fragment,
          fdc$form_unused_object =

{ Do nothing. }

        = fdc$form_constant_text =
          p_new_object_definition := ^p_new_object_definitions^ [old_object_index];
          p_old_text := fdp$ptr_text (p_old_object_definition^.constant_text, p_old_form_module);
          NEXT p_new_text: [STRLENGTH (p_old_text^)] IN p_new_form_module;
          IF p_new_text <> NIL THEN
            p_new_text^ := p_old_text^;
            fdp$rel_text (p_new_text, p_new_form_module, p_new_object_definition^.constant_text);

          ELSE { No space for text. }
            p_new_object_definition^.key := fdc$form_unused_object;
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

        = fdc$form_constant_text_box =
          p_new_object_definition := ^p_new_object_definitions^ [old_object_index];
          p_old_text := fdp$ptr_text (p_old_object_definition^.constant_box_text, p_old_form_module);
          NEXT p_new_text: [STRLENGTH (p_old_text^)] IN p_new_form_module;
          IF p_new_text <> NIL THEN
            p_new_text^ := p_old_text^;
            fdp$rel_text (p_new_text, p_new_form_module, p_new_object_definition^.constant_box_text);

          ELSE { No space for text. }
            p_new_object_definition^.key := fdc$form_unused_object;
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

        = fdc$form_stored_variable =
          p_new_object_definition := ^p_new_object_definitions^ [old_object_index];
          p_old_text := fdp$ptr_text (p_old_object_definition^.stored_variable_text, p_old_form_module);
          NEXT p_new_text: [STRLENGTH (p_old_text^)] IN p_new_form_module;
          IF p_new_text <> NIL THEN
            p_new_text^ := p_old_text^;
            fdp$rel_text (p_new_text, p_new_form_module, p_new_object_definition^.stored_variable_text);

          ELSE { No space for text. }
            p_new_object_definition^.key := fdc$form_unused_object;
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

        = fdc$form_variable_text =
          p_new_object_definition := ^p_new_object_definitions^ [old_object_index];
          p_old_text := fdp$ptr_text (p_old_object_definition^.text_variable_text, p_old_form_module);
          NEXT p_new_text: [STRLENGTH (p_old_text^)] IN p_new_form_module;
          IF p_new_text <> NIL THEN
            p_new_text^ := p_old_text^;
            fdp$rel_text (p_new_text, p_new_form_module, p_new_object_definition^.text_variable_text);

          ELSE { No space for text. }
            p_new_object_definition^.key := fdc$form_unused_object;
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

        = fdc$form_variable_text_box =
          p_new_object_definition := ^p_new_object_definitions^ [old_object_index];
          p_old_text := fdp$ptr_text (p_old_object_definition^.variable_box_text, p_old_form_module);
          NEXT p_new_text: [STRLENGTH (p_old_text^)] IN p_new_form_module;
          IF p_new_text <> NIL THEN
            p_new_text^ := p_old_text^;
            fdp$rel_text (p_new_text, p_new_form_module, p_new_object_definition^.variable_box_text);

          ELSE { No space for text. }
            p_new_object_definition^.key := fdc$form_unused_object;
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

        ELSE { Invalid object definition key. }
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
               'copy found invalid object', status);
          RETURN;
        CASEND;
      FOREND /copy_objects/;
    PROCEND copy_object_definitions;

?? OLDTITLE ??
?? NEWTITLE := 'copy_record_definitions', EJECT ??

    PROCEDURE [INLINE] copy_record_definitions
      (    active_number: fdt$number_record_variables;
           p_old_record_definitions: ^array [1 .. * ] OF fdt$variable_record_definition;
           p_new_form_definition: ^fdt$form_definition;
           p_new_form_status: ^fdt$form_status;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        record_index: fdt$number_record_variables,
        p_new_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_record_definitions: [1 .. active_number] IN p_new_form_module;
        IF p_new_record_definitions <> NIL THEN
          fdp$rel_record_definitions (p_new_record_definitions, p_new_form_status);
          p_new_form_definition^.record_definitions.active_number := active_number;
          FOR record_index := 1 TO active_number DO
            p_new_record_definitions^ [record_index] := p_old_record_definitions^ [record_index];
          FOREND;

        ELSE { No space for copying record definitions. }
          fdp$rel_record_definitions (NIL, p_new_form_status);
          p_new_form_definition^.record_definitions.active_number := 0;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old record definitions exist. }
        fdp$rel_record_definitions (NIL, p_new_form_status);
        p_new_form_definition^.record_definitions.active_number := 0;
      IFEND;
    PROCEND copy_record_definitions;

?? OLDTITLE ??
?? NEWTITLE := 'copy_table_definitions', EJECT ??

    PROCEDURE copy_table_definitions
      (    active_number: fdt$number_tables;
           p_old_form_module: ^fdt$form_module;
           p_old_table_definitions: ^array [1 .. * ] OF fdt$form_table_definition;
           p_new_form_status: ^fdt$form_status;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        number_objects: fdt$number_objects,
        number_table_variables: fdt$number_table_variables,
        object_index: fdt$object_index,
        p_new_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
        p_new_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_new_table_variables: ^array [1 .. * ] of fdt$table_variable,
        p_old_table_object: ^fdt$table_object,
        p_old_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_old_table_definition: ^fdt$form_table_definition,
        p_old_table_variable: ^fdt$table_variable,
        p_old_table_variables: ^array [1 .. * ] of fdt$table_variable,
        table_index: fdt$table_index,
        table_variable_index: fdt$table_variable_index;

      status.normal := TRUE;
      IF active_number = 0 THEN
        fdp$rel_tables (NIL, p_new_form_status);
        p_new_form_definition^.form_table_definitions.active_number := 0;
        RETURN;
      IFEND;

      NEXT p_new_table_definitions: [1 .. active_number] IN p_new_form_module;
      IF p_new_table_definitions = NIL THEN
        fdp$rel_tables (NIL, p_new_form_status);
        p_new_form_definition^.form_table_definitions.active_number := 0;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      fdp$rel_tables (p_new_table_definitions, p_new_form_status);
      p_new_form_definition^.form_table_definitions.active_number := active_number;

    /copy_tables/
      FOR table_index := 1 TO active_number DO
        p_old_table_definition := ^p_old_table_definitions^ [table_index];
        p_new_table_definitions^ [table_index] := p_old_table_definition^;
        number_table_variables := p_old_table_definition^.table_variables.active_number;
        IF number_table_variables > 0 THEN
          p_old_table_variables := fdp$ptr_table_variables (p_old_table_definition^.table_variables,
                p_old_form_module);
          NEXT p_new_table_variables: [1 .. number_table_variables] IN p_new_form_module;
          IF p_new_table_variables <> NIL THEN
            fdp$rel_table_variables (p_new_table_variables, p_new_form_module,
                  p_new_table_definitions^ [table_index].table_variables);
            p_new_table_definitions^ [table_index].table_variables.active_number := number_table_variables;

          /copy_table_variables/
            FOR table_variable_index := 1 TO number_table_variables DO
              p_old_table_variable := ^p_old_table_variables^ [table_variable_index];
              p_new_table_variables^ [table_variable_index] := p_old_table_variable^;
              number_objects := p_old_table_variable^.table_objects.active_number;
              IF number_objects > 0 THEN
                p_old_table_objects := fdp$ptr_table_objects (p_old_table_variable^.table_objects,
                      p_old_form_module);
                NEXT p_new_table_objects: [1 .. number_objects] IN p_new_form_module;
                IF p_new_table_objects <> NIL THEN
                  fdp$rel_table_objects (p_new_table_objects, p_new_form_module,
                        p_new_table_variables^ [table_variable_index].table_objects);
                  p_new_table_variables^ [table_variable_index].table_objects.active_number := number_objects;

                /copy_variable_occurrences/
                  FOR object_index := 1 TO number_objects DO
                    p_new_table_objects^ [object_index] := p_old_table_objects^ [object_index];
                  FOREND /copy_variable_occurrences/;

                ELSE { No space for variable occurrences. }
                  osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
                  RETURN;
                IFEND;
              IFEND;

            FOREND /copy_table_variables/;
          IFEND;
        IFEND;
      FOREND /copy_tables/;
    PROCEND copy_table_definitions;

?? OLDTITLE ??
?? NEWTITLE := 'copy_valid_integers', EJECT ??

    PROCEDURE [INLINE] copy_valid_integers
      (    active_number: fdt$number_valid_integers;
           p_old_valid_integers: ^array [1 .. * ] OF fdt$valid_integer_range;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR p_new_valid_integers: ^array [1 .. * ] of fdt$valid_integer_range;
       VAR status: ost$status);

      VAR
        valid_integer_index: fdt$valid_integer_index;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_valid_integers: [1 .. active_number] IN p_new_form_module;
        IF p_new_valid_integers <> NIL THEN
          FOR valid_integer_index := 1 TO active_number DO
            p_new_valid_integers^ [valid_integer_index] := p_old_valid_integers^ [valid_integer_index];
          FOREND;

        ELSE { No space for new valid_integers. }
          p_new_valid_integers := NIL;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old valid_integers are active. }
        p_new_valid_integers := NIL;
      IFEND;
    PROCEND copy_valid_integers;

?? OLDTITLE ??
?? NEWTITLE := 'copy_valid_reals', EJECT ??

    PROCEDURE [INLINE] copy_valid_reals
      (    active_number: fdt$number_valid_reals;
           p_old_valid_reals: ^array [1 .. * ] OF fdt$valid_real_range;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR p_new_valid_reals: ^array [1 .. * ] of fdt$valid_real_range;
       VAR status: ost$status);

      VAR
        valid_real_index: fdt$valid_real_index;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_valid_reals: [1 .. active_number] IN p_new_form_module;

        IF p_new_valid_reals <> NIL THEN
          FOR valid_real_index := 1 TO active_number DO
            p_new_valid_reals^ [valid_real_index] := p_old_valid_reals^ [valid_real_index];
          FOREND;

        ELSE { No space for new valid_reals. }
          p_new_valid_reals := NIL;
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old valid_reals are active. }
        p_new_valid_reals := NIL;
      IFEND;
    PROCEND copy_valid_reals;

?? OLDTITLE ??
?? NEWTITLE := 'copy_valid_strings', EJECT ??

    PROCEDURE [INLINE] copy_valid_strings
      (    active_number: fdt$number_valid_strings;
           p_old_valid_strings: ^array [1 .. * ] OF fdt$valid_string_definition;
           p_old_form_module: ^fdt$form_module;
       VAR p_new_form_module: ^fdt$form_module;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_valid_strings: ^array [1 .. * ] of fdt$valid_string_definition;
       VAR status: ost$status);

      VAR
        p_new_valid_string: ^fdt$valid_string,
        p_old_valid_string: ^fdt$valid_string,
        valid_string_index: fdt$valid_string_index;

      status.normal := TRUE;
      IF active_number > 0 THEN
        NEXT p_new_valid_strings: [1 .. active_number] IN p_new_form_module;
        IF p_new_valid_strings <> NIL THEN

        /copy_strings/
          FOR valid_string_index := 1 TO active_number DO
            p_old_valid_string := #PTR (p_old_valid_strings^ [valid_string_index].p_valid_string,
                  p_old_form_module^);
            NEXT p_new_valid_string: [STRLENGTH (p_old_valid_string^)] IN p_new_form_module;
            IF p_new_valid_string <> NIL THEN
              p_new_valid_string^ := p_old_valid_string^;
              p_new_valid_strings^ [valid_string_index].p_valid_string :=
                    #REL (p_new_valid_string, p_new_form_module^);

            ELSE { No space for new valid string. }
              p_new_valid_strings := NIL;
              osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
              EXIT /copy_strings/;
            IFEND;
          FOREND /copy_strings/;

        ELSE { No space for new valid_strings. }
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        IFEND;

      ELSE { No old valid_strings are active. }
        p_new_valid_strings := NIL;
      IFEND;
    PROCEND copy_valid_strings;

?? OLDTITLE ??
?? NEWTITLE := 'copy_variable_definitions', EJECT ??

    PROCEDURE [INLINE] copy_variable_definitions
      (    active_number: fdt$number_variables;
           p_old_form_module: ^fdt$form_module;
           p_old_form_definition: ^fdt$form_definition;
           p_old_variable_definitions: ^array [1 .. * ] OF fdt$form_variable_definition;
           p_new_form_status: ^fdt$form_status;
           p_new_form_definition: ^fdt$form_definition;
       VAR p_new_form_module: ^fdt$form_module;
       VAR status: ost$status);

      VAR
        p_new_error_message: ^fdt$error_message,
        p_new_help_message: ^fdt$help_message,
        p_new_text: ^fdt$text,
        p_new_valid_integers: ^array [1 .. * ] of fdt$valid_integer_range,
        p_new_valid_reals: ^array [1 .. * ] of fdt$valid_real_range,
        p_new_valid_strings: ^array [1 .. * ] of fdt$valid_string_definition,
        p_new_variable_definition: ^fdt$form_variable_definition,
        p_new_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
        p_old_error_message: ^fdt$error_message,
        p_old_help_message: ^fdt$help_message,
        p_old_text: ^fdt$text,
        p_old_variable_definition: ^fdt$form_variable_definition,
        variable_index: fdt$variable_index;

      status.normal := TRUE;
      IF active_number = 0 THEN
        fdp$rel_variables (NIL, p_new_form_status);
        p_new_form_definition^.form_variable_definitions.active_number := 0;
        EXIT copy_variable_definitions;
      IFEND;

      NEXT p_new_variable_definitions: [1 .. active_number] IN p_new_form_module;
      IF p_new_variable_definitions = NIL THEN
        fdp$rel_variables (NIL, p_new_form_status);
        p_new_form_definition^.form_variable_definitions.active_number := 0;
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        EXIT copy_variable_definitions;
      IFEND;

      fdp$rel_variables (p_new_variable_definitions, p_new_form_status);
      p_new_form_definition^.form_variable_definitions.active_number := active_number;

    /copy_variables/
      FOR variable_index := 1 TO active_number DO
        p_new_variable_definition := ^p_new_variable_definitions^ [variable_index];
        p_old_variable_definition := ^p_old_variable_definitions^ [variable_index];
        p_new_variable_definition^ := p_old_variable_definition^;
        copy_added_variable_definition (p_old_form_definition,
              p_old_variable_definition, p_old_form_module,
              p_new_variable_definition, p_new_form_module, status);
        IF NOT status.normal THEN
          EXIT copy_variable_definitions;
        IFEND;

        IF (p_old_form_definition^.screen_formatting_version <
              fdc$validation_capability) THEN
          p_new_variable_definition^.terminal_user_entry := $fdt$terminal_user_entry
               [fdc$entry_optional];
        IFEND;

        CASE p_old_variable_definition^.error_definition.key OF

        = fdc$no_error_response, fdc$error_form =

{ Do nothing. The information has already been copied.

        = fdc$error_message =

          p_old_error_message := #PTR (p_old_variable_definition^.error_definition.p_error_message,
                p_old_form_module^);
          NEXT p_new_error_message: [STRLENGTH (p_old_error_message^)] IN p_new_form_module;
          IF p_new_error_message = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;
          p_new_error_message^ := p_old_error_message^;
          p_new_variable_definition^.error_definition.p_error_message :=
                #REL (p_new_error_message, p_new_form_module^);

         = fdc$system_default_error =
           IF (p_old_form_definition^.screen_formatting_version <
                 fdc$validation_capability) THEN
             p_new_variable_definition^.error_definition.key := fdc$no_error_response;
           IFEND;

        ELSE { Invalid error definition key. }
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
          EXIT copy_variable_definitions;
        CASEND;

        CASE p_old_variable_definition^.help_definition.key OF

        = fdc$no_help_response, fdc$help_form =

{ Do nothing. The information has already been copied.

        = fdc$help_message =

          p_old_help_message := #PTR (p_old_variable_definition^.help_definition.p_help_message,
                p_old_form_module^);
          NEXT p_new_help_message: [STRLENGTH (p_old_help_message^)] IN p_new_form_module;
          IF p_new_help_message = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            EXIT copy_variable_definitions;
          IFEND;
          p_new_help_message^ := p_old_help_message^;
          p_new_variable_definition^.help_definition.p_help_message :=
                #REL (p_new_help_message, p_new_form_module^);

         = fdc$system_default_help =
           IF (p_old_form_definition^.screen_formatting_version <
                 fdc$validation_capability) THEN
             p_new_variable_definition^.help_definition.key := fdc$no_help_response;
           IFEND;

        ELSE { Invalid error definition key. }
          osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
          EXIT copy_variable_definitions;
        CASEND;

        copy_valid_integers (p_old_variable_definition^.valid_integer_ranges.active_number,
              fdp$ptr_valid_integers (p_old_variable_definition^.valid_integer_ranges, p_old_form_module),
              p_new_form_definition, p_new_form_module, p_new_valid_integers, status);
        IF NOT status.normal THEN
          fdp$rel_valid_integers (p_new_valid_integers, p_new_form_module, p_new_variable_definition^.
                valid_integer_ranges);
          p_new_variable_definition^.valid_integer_ranges.active_number := 0;
          EXIT copy_variable_definitions;
        IFEND;

        fdp$rel_valid_integers (p_new_valid_integers, p_new_form_module, p_new_variable_definition^.
              valid_integer_ranges);
        p_new_variable_definition^.valid_integer_ranges.active_number := p_new_variable_definition^.
              valid_integer_ranges.total_number;
        copy_valid_reals (p_old_variable_definition^.valid_real_ranges.active_number,
              fdp$ptr_valid_reals (p_old_variable_definition^.valid_real_ranges, p_old_form_module),
              p_new_form_definition, p_new_form_module, p_new_valid_reals, status);
        IF NOT status.normal THEN
          fdp$rel_valid_reals (p_new_valid_reals, p_new_form_module, p_new_variable_definition^.
                valid_real_ranges);
          p_new_variable_definition^.valid_real_ranges.active_number := 0;
           EXIT copy_variable_definitions;
        IFEND;
        fdp$rel_valid_reals (p_new_valid_reals, p_new_form_module, p_new_variable_definition^.
              valid_real_ranges);
        p_new_variable_definition^.valid_real_ranges.active_number := p_new_variable_definition^.
              valid_real_ranges.total_number;

        copy_valid_strings (p_old_variable_definition^.valid_strings.active_number,
              fdp$ptr_valid_strings (p_old_variable_definition^.valid_strings, p_old_form_module),
              p_old_form_module, p_new_form_module, p_new_form_definition, p_new_valid_strings, status);
        IF NOT status.normal THEN
          fdp$rel_valid_strings (p_new_valid_strings, p_new_form_module, p_new_variable_definition^.
                valid_strings);
          p_new_variable_definition^.valid_strings.active_number := 0;
          EXIT copy_variable_definitions;
        IFEND;
        fdp$rel_valid_strings (p_new_valid_strings, p_new_form_module, p_new_variable_definition^.
              valid_strings);
        p_new_variable_definition^.valid_strings.active_number := p_new_variable_definition^.valid_strings.
              total_number;
      FOREND /copy_variables/;
    PROCEND copy_variable_definitions;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    p_to_form_module := p_to_form_status^.p_form_module;
    p_from_form_module := p_from_form_status^.p_form_module;
    p_from_form_definition := p_from_form_status^.p_form_definition;

{ Copy form definition. }

    NEXT p_to_form_definition IN p_to_form_status^.p_form_module;
    p_to_form_definition^ := p_from_form_definition^;
    p_to_form_status^.p_form_definition := p_to_form_definition;

    CASE p_from_form_definition^.help_definition.key OF

    = fdc$no_help_response, fdc$help_form =

{ Do nothing. The help definition has already been copied. }

    = fdc$help_message =
      p_from_help_message := #PTR (p_from_form_definition^.help_definition.p_help_message,
            p_from_form_module^);
      NEXT p_to_help_message: [STRLENGTH (p_from_help_message^)] IN p_to_form_status^.p_form_module;
      IF p_to_help_message = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;
      p_to_help_message^ := p_from_help_message^;
      p_to_form_definition^.help_definition.p_help_message := #REL (p_to_help_message, p_to_form_module^);

     = fdc$system_default_help =
       IF p_from_form_definition^.screen_formatting_version <
             fdc$validation_capability THEN
         p_to_form_definition^.help_definition.key := fdc$no_help_response;
       IFEND;

    ELSE { Invalid help key. }
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
          'invalid help key', status);
      RETURN;
    CASEND;

{ Initialize help_message_form for prior versions of forms.

    IF p_from_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
      p_to_form_definition^.help_message_form := osc$null_name;
    IFEND;

    copy_comments (p_from_form_definition^.comment_definitions.active_number, p_to_form_definition^.
          comment_definitions, p_from_form_module, p_to_form_status^.p_form_module,
          p_to_form_definition^.comment_definitions, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_display_definitions (p_from_form_definition^.display_definitions.active_number,
          p_from_form_status^.p_display_definitions, p_to_form_status, p_to_form_definition,
          p_to_form_status^.p_form_module, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_event_definitions (p_from_form_definition,
          p_from_form_definition^.event_definitions.active_number, p_from_form_status^.
          p_event_definitions, p_to_form_status, p_to_form_definition, p_to_form_status^.p_form_module,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_object_definitions (p_from_form_definition^.form_object_definitions.active_number,
          p_from_form_module, p_from_form_status^.p_form_object_definitions, p_to_form_status,
          p_to_form_definition, p_to_form_status^.p_form_module, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_table_definitions (p_from_form_definition^.form_table_definitions.active_number,
          p_from_form_module, p_from_form_status^.p_form_table_definitions, p_to_form_status,
          p_to_form_definition, p_to_form_status^.p_form_module, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_variable_definitions (p_from_form_definition^.form_variable_definitions.active_number,
         p_from_form_module, p_from_form_definition,
         p_from_form_status^.p_form_variable_definitions, p_to_form_status,
         p_to_form_definition, p_to_form_status^.p_form_module, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    copy_record_definitions (p_from_form_definition^.record_definitions.active_number,
         p_from_form_status^.p_form_record_definitions, p_to_form_definition, p_to_form_status,
         p_to_form_status^.p_form_module, status);

    IF p_to_form_definition^.screen_formatting_version < fdc$im_smart_capability THEN
      p_to_form_definition^.invalid_data_character.defined := FALSE;
    IFEND;
    p_to_form_definition^.screen_formatting_version := fdc$screen_formatting_version;

  PROCEND copy_form;

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

  PROCEDURE [XDCL] fdp$create_design_text
    (    target_form_identifier: fdt$form_identifier;
         design_form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      display_attribute_set: fdt$display_attribute_set,
      initial_value_length: fdt$program_variable_length,
      number_objects: fdt$number_objects,
      object_attributes: array [1 .. 2] of fdt$object_attribute,
      object_definition: fdt$object_definition,
      form_object_key: fdt$form_object_key,
      object_index: fdt$object_index,
      occurrence: fdt$occurrence,
      p_design_text: ^fdt$text,
      p_design_form_status: ^fdt$form_status,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_program_variable: ^cell,
      p_saved_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_target_form_status: ^fdt$form_status,
      p_text: ^fdt$text,
      text_length: fdt$text_length,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      x_increment: fdt$x_increment,
      y_increment: fdt$y_increment,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

?? 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$create_design_text;
      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$create_design_text;
      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_form_status (design_form_identifier, p_design_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT p_design_form_status^.design_form THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_design_form, p_design_form_status^.
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    fdp$find_change_form_definition (target_form_identifier, p_target_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_target_form_status^.p_form_definition;
    number_objects := p_form_definition^.form_object_definitions.active_number;
    IF number_objects = 0 THEN
      RETURN;
    IFEND;

    p_form_object_definitions := p_target_form_status^.p_form_object_definitions;
    p_form_module := p_target_form_status^.p_form_module;
    PUSH p_design_text: [p_design_form_status^.p_form_definition^.width];
    variable_name := p_design_form_status^.design_variable_name;

    IF p_form_definition^.form_area.key = fdc$defined_area THEN
      x_increment := p_form_definition^.form_area.x_position - 1;
      y_increment := p_form_definition^.form_area.y_position - 1;

    ELSE
      x_increment := 0;
      y_increment := 0;
    IFEND;

    display_attribute_set := p_form_definition^.display_attribute * fdv$colors;
    object_attributes [1].key := fdc$object_display;

{ Create objects on the design form from the target form. }
{ Constant text objects with the same attributes of the form }
{ and no name will become free text on the design form. }

    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      x_position := p_form_object_definition^.x_position + x_increment;
      y_position := p_form_object_definition^.y_position + y_increment;
      form_object_key := p_form_object_definition^.key;
      object_attributes [1].display_attribute := p_form_object_definition^.display_attribute -
          $fdt$display_attribute_set [fdc$hidden];
      IF p_form_object_definition^.name <> osc$null_name THEN
        object_attributes [2].key := fdc$object_name;
        object_attributes [2].object_name := p_form_object_definition^.name;
        object_attributes [2].occurrence := p_form_object_definition^.occurrence;
      ELSE
        object_attributes [2].key := fdc$unused_object_entry;
      IFEND;
      CASE form_object_key OF

      = fdc$form_box =
        object_definition.key := fdc$box;
        object_definition.box_width := p_form_object_definition^.box_width;
        object_definition.box_height := p_form_object_definition^.box_height;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_line =
        object_definition.key := fdc$line;
        object_definition.x_increment := p_form_object_definition^.x_increment;
        object_definition.y_increment := p_form_object_definition^.y_increment;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_table =
        object_definition.key := fdc$table;
        object_definition.table_width := p_form_object_definition^.table_width;
        object_definition.table_height := p_form_object_definition^.table_height;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text =
        object_definition.key := fdc$constant_text;
        object_definition.p_constant_text := fdp$ptr_text (p_form_object_definition^.text_variable_text,
              p_form_module);
        object_definition.constant_text_width := p_form_object_definition^.text_variable_width;
        IF ((object_attributes [1].display_attribute -
           $fdt$display_attribute_set [fdc$protect, fdc$display_left_to_right, fdc$display_right_to_left])
          = display_attribute_set) THEN
          object_attributes [1].display_attribute := p_design_form_status^.design_display_attribute;
        IFEND;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text_box =
        object_definition.key := fdc$constant_text_box;
        object_definition.p_constant_box_text := fdp$ptr_text
              (p_form_object_definition^.variable_box_text, p_form_module);
        object_definition.constant_box_width := p_form_object_definition^.variable_box_width;
        object_definition.constant_box_height := p_form_object_definition^.variable_box_height;
        object_definition.constant_box_processing := p_form_object_definition^.variable_box_processing;
        IF ((object_attributes [1].display_attribute -
          $fdt$display_attribute_set [fdc$protect, fdc$display_left_to_right, fdc$display_right_to_left])
          = display_attribute_set) THEN
          object_attributes [1].display_attribute := p_design_form_status^.design_display_attribute;
        IFEND;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_constant_text =
        p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_module);
        text_length := STRLENGTH (p_text^);

        IF (((object_attributes [1].display_attribute -
               $fdt$display_attribute_set [fdc$protect, fdc$display_left_to_right,
               fdc$display_right_to_left ])  =
               display_attribute_set) AND
              (p_form_object_definition^.name = osc$null_name)) THEN
          occurrence := y_position;
          fdp$get_string_variable (design_form_identifier, variable_name, occurrence, p_design_text^,
                variable_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_design_text^ (x_position, text_length) := p_text^;
          fdp$replace_string_variable (design_form_identifier, variable_name, occurrence, p_design_text^,
                variable_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        ELSE { The constant text has non color attributes. }
          IF ((object_attributes [1].display_attribute -
            $fdt$display_attribute_set [fdc$protect, fdc$display_left_to_right,
            fdc$display_right_to_left]) =
            display_attribute_set) THEN
            object_attributes [1].display_attribute := p_design_form_status^.design_display_attribute;
          IFEND;

          object_definition.key := fdc$constant_text;
          object_definition.p_constant_text := p_text;
          object_definition.constant_text_width := p_form_object_definition^.constant_text_width;
          fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
                object_attributes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

      = fdc$form_constant_text_box =
        object_definition.key := fdc$constant_text_box;
        object_definition.p_constant_box_text := fdp$ptr_text
              (p_form_object_definition^.constant_box_text, p_form_module);
        object_definition.constant_box_width := p_form_object_definition^.constant_box_width;
        object_definition.constant_box_height := p_form_object_definition^.constant_box_height;
        object_definition.constant_box_processing := p_form_object_definition^.constant_box_processing;
        fdp$create_object (design_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE { Ignore objects not generated  by the user directly.  }
      CASEND;
    FOREND;


   IF ((x_increment = 0) AND (y_increment = 0)) THEN

{ The design and target forms have the same origin. }
{ Delete constant text objects from the target from that }
{ are free text on the design form.  The constant text objects }
{ on the target form will be re-created by the fdp$create_constant_text request. }


  /delete_constant_text/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      CASE p_form_object_definition^.key OF

      = fdc$form_constant_text =
        IF (((p_form_object_definition^.display_attribute -
              $fdt$display_attribute_set [fdc$protect, fdc$display_left_to_right,
              fdc$display_right_to_left])  =
               display_attribute_set) AND
              (p_form_object_definition^.name = osc$null_name)) THEN
          fdp$delete_object (target_form_identifier, p_form_object_definition^.x_position,
                p_form_object_definition^.y_position, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      ELSE { Ignore objects not generated by the user directly.  }
      CASEND;
    FOREND /delete_constant_text/;

  ELSE { The design form and the target form do not same origin.}

{ Relocate objects on the target form to match those of the design form. }

    IF number_objects > 0 THEN
      PUSH p_saved_object_definitions: [1 .. number_objects];
      FOR object_index := 1 TO number_objects DO
        p_saved_object_definitions^ [object_index] := p_form_object_definitions^ [object_index];
      FOREND;
    IFEND;

  /delete_objects/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_saved_object_definitions^ [object_index];
      fdp$delete_object (target_form_identifier, p_form_object_definition^.x_position,
           p_form_object_definition^.y_position, status);
    FOREND /delete_objects/;

{ Make target form area equal to design form area. }

    p_form_definition^.form_area := p_design_form_status^.p_form_definition^.form_area;

  /relocate_target_form/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_saved_object_definitions^ [object_index];
      x_position := p_form_object_definition^.x_position + x_increment;
      y_position := p_form_object_definition^.y_position + y_increment;
      form_object_key := p_form_object_definition^.key;
      object_attributes [1].display_attribute := p_form_object_definition^.display_attribute -
           $fdt$display_attribute_set [fdc$hidden];
      IF p_form_object_definition^.name <> osc$null_name THEN
        object_attributes [2].key := fdc$object_name;
        object_attributes [2].object_name := p_form_object_definition^.name;
        object_attributes [2].occurrence := p_form_object_definition^.occurrence;
      ELSE
        object_attributes [2].key := fdc$unused_object_entry;
      IFEND;

      CASE form_object_key OF

      = fdc$form_box =
        object_definition.key := fdc$box;
        object_definition.box_width := p_form_object_definition^.box_width;
        object_definition.box_height := p_form_object_definition^.box_height;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_line =
        object_definition.key := fdc$line;
        object_definition.x_increment := p_form_object_definition^.x_increment;
        object_definition.y_increment := p_form_object_definition^.y_increment;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_table =
        object_definition.key := fdc$table;
        object_definition.table_width := p_form_object_definition^.table_width;
        object_definition.table_height := p_form_object_definition^.table_height;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text =
        object_definition.key := fdc$variable_text;
        object_definition.p_variable_text := fdp$ptr_text (p_form_object_definition^.text_variable_text,
              p_form_module);
        object_definition.variable_text_width := p_form_object_definition^.text_variable_width;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_variable_text_box =
        object_definition.key := fdc$variable_text_box;
        object_definition.p_variable_box_text := fdp$ptr_text
              (p_form_object_definition^.variable_box_text, p_form_module);
        object_definition.variable_box_width := p_form_object_definition^.variable_box_width;
        object_definition.variable_box_height := p_form_object_definition^.variable_box_height;
        object_definition.variable_box_processing := p_form_object_definition^.variable_box_processing;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = fdc$form_constant_text =
        p_text := fdp$ptr_text (p_form_object_definition^.constant_text, p_form_module);
        text_length := STRLENGTH (p_text^);

        IF (((object_attributes [1].display_attribute - $fdt$display_attribute_set [fdc$protect,
               fdc$display_left_to_right, fdc$display_right_to_left])  =
               display_attribute_set) AND
              (p_form_object_definition^.name = osc$null_name)) THEN

{ This is free text on the design form. Do not create an object on the target form. }

          CYCLE /relocate_target_form/;
        IFEND;

          object_definition.key := fdc$constant_text;
          object_definition.p_constant_text := p_text;
          object_definition.constant_text_width := p_form_object_definition^.constant_text_width;
          fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
                object_attributes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

      = fdc$form_constant_text_box =
        object_definition.key := fdc$constant_text_box;
        object_definition.p_constant_box_text := fdp$ptr_text
              (p_form_object_definition^.constant_box_text, p_form_module);
        object_definition.constant_box_width := p_form_object_definition^.constant_box_width;
        object_definition.constant_box_height := p_form_object_definition^.constant_box_height;
        object_definition.constant_box_processing := p_form_object_definition^.constant_box_processing;
        fdp$create_object (target_form_identifier, x_position, y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE { Ignore objects not generated  by the user directly.  }
      CASEND;
    FOREND /relocate_target_form/;
  IFEND;
  PROCEND fdp$create_design_text;

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

  PROCEDURE [XDCL] fdp$create_constant_text
    (    design_form_identifier: fdt$form_identifier;
         target_form_identifier: fdt$form_identifier;
     VAR status: ost$status);


    VAR
      design_text_length: fdt$text_length,
      display_attribute_set: fdt$display_attribute_set,
      end_x_position: fdt$x_position,
      object_attributes: array [1 .. 1] of fdt$object_attribute,
      object_definition: fdt$object_definition,
      object_exists: boolean,
      object_index: fdt$object_index,
      object_x_position: fdt$x_position,
      object_y_position: fdt$y_position,
      p_form_image: ^fdt$form_image,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_design_form_definition: ^fdt$form_definition,
      p_design_form_status: ^fdt$form_status,
      p_target_form_definition: ^fdt$form_definition,
      p_target_form_status: ^fdt$form_status,
      p_object_text: ^fdt$text,
      p_text: ^fdt$text,
      max_x_position: fdt$x_position,
      max_y_position: fdt$y_position,
      min_x_position: fdt$x_position,
      min_y_position: fdt$y_position,
      number_objects: fdt$number_objects,
      start_x_position: fdt$x_position,
      variable_name: ost$name,
      variable_status: fdt$variable_status,
      x_increment: fdt$x_increment,
      y_increment: fdt$y_increment,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

?? 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$create_constant_text;
      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$create_constant_text;
      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_form_status (design_form_identifier, p_design_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT p_design_form_status^.design_form THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_design_form, p_design_form_status^.
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    fdp$find_form_definition (target_form_identifier, p_target_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_design_form_definition := p_design_form_status^.p_form_definition;
    p_target_form_definition := p_target_form_status^.p_form_definition;
    number_objects := p_target_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_target_form_status^.p_form_object_definitions;
    display_attribute_set := p_target_form_definition^.display_attribute * fdv$colors;

    IF p_target_form_definition^.form_area.key = fdc$defined_area THEN
      min_x_position := p_target_form_definition^.form_area.x_position;
      min_y_position := p_target_form_definition^.form_area.y_position;
      max_x_position := min_x_position + p_target_form_definition^.form_area.width - 1;
      max_y_position := min_y_position + p_target_form_definition^.form_area.height - 1;

      IF max_x_position > p_design_form_definition^.form_area.width THEN
        max_x_position := p_design_form_definition^.form_area.width;
      IFEND;

      IF max_y_position > p_design_form_definition^.form_area.height  THEN
        max_y_position := p_design_form_definition^.form_area.height;
      IFEND;

    ELSE { The design form always has a  defined  area.  }
      max_x_position := p_design_form_definition^.form_area.width;
      max_y_position := p_design_form_definition^.form_area.height;
      min_x_position := p_design_form_definition^.form_area.x_position;
      min_y_position := p_design_form_definition^.form_area.y_position;
    IFEND;

    x_increment := min_x_position - 1;
    y_increment := min_y_position - 1;

    variable_name := p_design_form_status^.design_variable_name;
    object_definition.key := fdc$constant_text;
    object_attributes [1].key := fdc$unused_object_entry;
    design_text_length := p_design_form_definition^.form_area.width;
    PUSH p_text: [design_text_length];
    p_form_image := p_design_form_status^.p_form_image;

{ Get free text entered by the terminal user. }
{ Create constant text objects for the free text. }

  /read_lines/
    FOR y_position := min_y_position TO max_y_position DO
      fdp$get_string_variable (design_form_identifier, variable_name, y_position, p_text^, variable_status,
            status);
      IF NOT status.normal THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
              'create constant text get failed', status);
        RETURN;
      IFEND;

      object_exists := FALSE;
      x_position := min_x_position;

{ Ignore spaces before free text. }

    /find_start_object/
      WHILE x_position < max_x_position + 1 DO
        IF p_text^ (x_position, 1) = ' ' THEN
          x_position := x_position + 1;
          CYCLE /find_start_object/;
        IFEND;
        object_exists := TRUE;
        start_x_position := x_position;
        x_position := x_position + 1;

      /find_end_object/
        WHILE x_position < max_x_position + 1 DO
          IF p_text^ (x_position, 1) <> ' ' THEN
            x_position := x_position + 1;
            CYCLE /find_end_object/;
          IFEND;

{ Scan is at end of word.  Try to make the object include a sentence. }
{ The object cannot be intersected by a line or a box. }

          IF ((p_form_image <> NIL) AND
               (p_form_image^ [y_position] (x_position, 1) = ' ') AND
               ((x_position + 1) < (max_x_position + 1)) AND
               (p_text^ (x_position + 1, 1) <> ' ')) THEN
            x_position := x_position + 1;
            CYCLE /find_end_object/;
          IFEND;

          end_x_position := x_position - 1;
          x_position := x_position + 1;

          object_definition.p_constant_text := ^p_text^ (start_x_position, end_x_position - start_x_position +
                1);
          object_definition.constant_text_width := end_x_position - start_x_position + 1;
          object_x_position := start_x_position - x_increment;
          object_y_position := y_position - y_increment;
          fdp$create_object (target_form_identifier, object_x_position, object_y_position, object_definition,
                object_attributes, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          object_exists := FALSE;
          CYCLE /find_start_object/;
        WHILEND /find_end_object/;
      WHILEND /find_start_object/;

{ Complete any started object. }

      IF object_exists THEN
        end_x_position := max_x_position;
        object_definition.p_constant_text := ^p_text^ (start_x_position, end_x_position - start_x_position +
              1);
        object_definition.constant_text_width := end_x_position - start_x_position + 1;
        object_x_position := start_x_position - x_increment;
        object_y_position := y_position - y_increment;
        fdp$create_object (target_form_identifier, object_x_position, object_y_position, object_definition,
              object_attributes, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    FOREND /read_lines/;
  PROCEND fdp$create_constant_text;

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

  PROCEDURE [XDCL] fdp$create_mark
    (    form_identifier: fdt$form_identifier;
         start_x_position: fdt$x_position;
         start_y_position: fdt$y_position;
         end_x_position: fdt$x_position;
         end_y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      active_objects: fdt$number_objects,
      character_position: fdt$character_position,
      cursor_x_position: fdt$x_position,
      cursor_y_position: fdt$y_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      local_status: ost$status,
      low_x_position: fdt$x_position,
      low_y_position: fdt$y_position,
      object_exists: boolean,
      object_index: fdt$object_index,
      parent_object_index: fdt$object_index,
      object_x_position: fdt$x_position,
      object_y_position: fdt$y_position,
      occurrence_exists: boolean,
      name_exists: boolean,
      occurrence: fdt$occurrence,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      screen_change: fdt$screen_change,
      text_length: fdt$text_length,
      variable_name: ost$name,
      width: fdt$width,
      y_position: fdt$y_position;

?? 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$create_mark;
      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$create_mark;
      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$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ A mark may only occur on a design form. }

    p_form_definition := p_form_status^.p_form_definition;
    IF NOT p_form_status^.design_form THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$create_mark_invalid, p_form_definition^.
            form_name, status);
      RETURN;
    IFEND;

    IF start_y_position > end_y_position THEN
      high_y_position := start_y_position;
      low_y_position := end_y_position;
    ELSE
      low_y_position := start_y_position;
      high_y_position := end_y_position;
    IFEND;

    IF start_x_position > end_x_position THEN
      high_x_position := start_x_position;
      low_x_position := end_x_position;
    ELSE
      low_x_position := start_x_position;
      high_x_position := end_x_position;
    IFEND;

{ The mark must be inside area occupied by form. }

    IF p_form_definition^.form_area.key = fdc$defined_area THEN
      IF high_x_position > p_form_definition^.form_area.width THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$mark_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;

      IF high_y_position > p_form_definition^.form_area.height THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$mark_outside_form, p_form_definition^.
              form_name, status);
        RETURN;
      IFEND;
    IFEND;

    active_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    p_form_module := p_form_status^.p_form_module;

{ If the marked area contains more than one character, the mark must }
{ completely contain any affected objects. }

    IF NOT ((low_x_position = high_x_position) AND (low_y_position = high_y_position)) THEN
      check_for_sliced_objects (p_form_status, p_form_definition, p_form_module, p_form_object_definitions,
            active_objects, low_x_position, low_y_position, high_x_position, high_y_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

{ Delete previous mark if any.  Only one mark at a time is permitted. }

    IF p_form_status^.mark_defined THEN
      fdp$delete_mark (form_identifier, local_status);
    IFEND;

    variable_name := p_form_status^.design_variable_name;
    p_form_status^.mark_start_x_position := low_x_position;
    p_form_status^.mark_end_x_position := high_x_position;
    p_form_status^.mark_start_y_position := low_y_position;
    p_form_status^.mark_end_y_position := high_y_position;
    p_form_status^.mark_defined := TRUE;

    screen_change.key := fdc$create_mark;
    screen_change.mark_object := FALSE;
    screen_change.create_mark_form_identifier := form_identifier;
    screen_change.start_x_position := low_x_position;
    screen_change.end_x_position := high_x_position;
    cursor_x_position := high_x_position + 1;
    cursor_y_position := high_y_position;

{ Mark affected lines of free text on the design form. }

    FOR y_position := low_y_position TO high_y_position DO
      occurrence := y_position;
      fdp$find_object_definition (variable_name, occurrence, p_form_status^.p_form_object_definitions,
            p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
            name_exists, occurrence_exists);

      IF NOT name_exists THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
        'create mark design variable not found', status);
        RETURN;
      IFEND;

      IF NOT occurrence_exists THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
        'create mark design occurrence not found', status);
        RETURN;
      IFEND;

      screen_change.start_y_position := y_position;
      screen_change.end_y_position := y_position;
      screen_change.create_mark_object_index := object_index;
      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

{ Mark objects by adding inverse video to their display attributes. }
{ If mark is on any part of object, mark the entire object. }

    screen_change.key := fdc$set_attribute;

  /find_objects/
    FOR object_index := 1 TO active_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];

      object_x_position := p_form_object_definition^.x_position;
      object_y_position := p_form_object_definition^.y_position;
      CASE p_form_object_definition^.key OF

      = fdc$form_constant_text =

        end_object_x_position := object_x_position + p_form_object_definition^.constant_text_width - 1;
        IF ((low_y_position <= object_y_position) AND (high_y_position >= object_y_position) AND
              (low_x_position <= object_x_position) AND (high_x_position >= end_object_x_position)) THEN
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_y_position >= object_y_position) AND (high_y_position <= object_y_position) AND
              (low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

      = fdc$form_constant_text_box =
        end_object_x_position := object_x_position + p_form_object_definition^.constant_box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.constant_box_height - 1;
        IF ((low_y_position <= object_y_position) AND (high_y_position >= end_object_y_position) AND
              (low_x_position <= object_x_position) AND (high_x_position >= end_object_x_position)) THEN
          screen_change.attribute_object_index := object_index;
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_y_position >= object_y_position) AND (high_y_position <= end_object_y_position) AND
              (low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

      = fdc$form_box =
        end_object_x_position := object_x_position + p_form_object_definition^.box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.box_height - 1;
        IF ((low_x_position <= object_x_position) AND (low_y_position <= object_y_position) AND
              (high_x_position >= end_object_x_position) AND (high_y_position >= end_object_y_position)) THEN
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        { Check for mark on horizontal  lines of box. }

        IF ((low_y_position = object_y_position) OR (high_y_position = end_object_y_position)) THEN
          IF ((low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
            screen_change.attribute_object_index := object_index;
            screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                  p_form_object_definition^.display_attribute;
            fdp$record_screen_change (screen_change, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            CYCLE /find_objects/;
          IFEND;
        IFEND;

        { Check for mark on vertical lines of box. }

        IF ((low_x_position = object_x_position) OR (high_x_position = end_object_x_position)) THEN
          IF ((low_y_position >= object_y_position) AND (high_y_position <= end_object_y_position)) THEN
            screen_change.attribute_object_index := object_index;
            screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                  p_form_object_definition^.display_attribute;
            fdp$record_screen_change (screen_change, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            CYCLE /find_objects/;
          IFEND;
        IFEND;

      = fdc$form_line =
        end_object_x_position := object_x_position + p_form_object_definition^.x_increment;
        end_object_y_position := object_y_position + p_form_object_definition^.y_increment;
        IF ((low_x_position <= object_x_position) AND (low_y_position <= object_y_position) AND
              (high_x_position >= end_object_x_position) AND (high_y_position >= end_object_y_position)) THEN
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_x_position >= object_x_position) AND (low_y_position >= object_y_position) AND
              (high_x_position <= end_object_x_position) AND (high_y_position <= end_object_y_position)) THEN
          screen_change.attribute_object_index := object_index;
          screen_change.attribute := $fdt$display_attribute_set [fdc$inverse_video] +
                p_form_object_definition^.display_attribute;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

      ELSE

{ Ignore object.

      CASEND;

    FOREND /find_objects/;
  PROCEND fdp$create_mark;

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

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

    VAR
      active_objects: fdt$number_objects,
      character_position: fdt$character_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      high_x_position: fdt$x_position,
      high_y_position: fdt$y_position,
      local_status: ost$status,
      low_x_position: fdt$x_position,
      low_y_position: fdt$y_position,
      object_index: fdt$object_index,
      object_x_position: fdt$x_position,
      object_y_position: fdt$y_position,
      name_exists: boolean,
      occurrence: fdt$occurrence,
      occurrence_exists: boolean,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      parent_object_index: fdt$object_index,
      screen_change: fdt$screen_change,
      variable_name: ost$name,
      width: fdt$width;

?? 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$delete_mark;
      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$delete_mark;
      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$check_for_active_form (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    IF NOT p_form_status^.design_form THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$delete_mark_invalid, p_form_definition^.
            form_name, status);
      RETURN;
    IFEND;

    IF NOT p_form_status^.mark_defined THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_mark_defined, p_form_definition^.
            form_name, status);
      RETURN;
    IFEND;

    p_form_status^.mark_defined := FALSE;
    screen_change.key := fdc$delete_mark;
    screen_change.delete_mark_object := FALSE;
    screen_change.delete_mark_form_identifier := form_identifier;
    variable_name := p_form_status^.design_variable_name;
    low_y_position := p_form_status^.mark_start_y_position;
    high_y_position := p_form_status^.mark_end_y_position;
    low_x_position := p_form_status^.mark_start_x_position;
    high_x_position := p_form_status^.mark_end_x_position;

{ Delete mark on free text of design form. }

    FOR occurrence := low_y_position TO high_y_position DO
      fdp$find_object_definition (variable_name, occurrence, p_form_status^.p_form_object_definitions,
            p_form_definition^.form_object_definitions.active_number, p_form_object_definition, object_index,
            name_exists, occurrence_exists);
      IF NOT name_exists THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
             'delete mark design variable not found', status);
        RETURN;
      IFEND;

      IF NOT occurrence_exists THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error,
             'delete mark design occurrence not found', status);
        RETURN;
      IFEND;

      screen_change.delete_mark_object_index := object_index;
      fdp$record_screen_change (screen_change, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

    active_objects := p_form_definition^.form_object_definitions.active_number;
    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    screen_change.key := fdc$set_attribute;

{ Delete marks on objects. }
{ Set display attributes of object to its defined state. }

  /find_objects/
    FOR object_index := 1 TO active_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];

      object_x_position := p_form_object_definition^.x_position;
      object_y_position := p_form_object_definition^.y_position;
      CASE p_form_object_definition^.key OF

      = fdc$form_constant_text =

        end_object_x_position := object_x_position + p_form_object_definition^.constant_text_width - 1;
        IF ((low_y_position <= object_y_position) AND (high_y_position >= object_y_position) AND
              (low_x_position <= object_x_position) AND (high_x_position >= end_object_x_position)) THEN
          screen_change.attribute := p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_y_position >= object_y_position) AND (high_y_position <= object_y_position) AND
              (low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
          screen_change.attribute := p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

      = fdc$form_constant_text_box =
        end_object_x_position := object_x_position + p_form_object_definition^.constant_box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.constant_box_height - 1;
        IF ((low_y_position <= object_y_position) AND (high_y_position >= end_object_y_position) AND
              (low_x_position <= object_x_position) AND (high_x_position >= end_object_x_position)) THEN
          screen_change.attribute_object_index := object_index;
          screen_change.attribute := p_form_object_definition^.display_attribute;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_y_position >= object_y_position) AND (high_y_position <= end_object_y_position) AND
              (low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
          screen_change.attribute := p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

      = fdc$form_box =
        end_object_x_position := object_x_position + p_form_object_definition^.box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.box_height - 1;
        IF ((low_x_position <= object_x_position) AND (low_y_position <= object_y_position) AND
              (high_x_position >= end_object_x_position) AND (high_y_position >= end_object_y_position)) THEN
          screen_change.attribute := p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;


        { Check for mark on horizontal  lines of box. }

        IF ((low_y_position = object_y_position) OR (high_y_position = end_object_y_position)) THEN
          IF ((low_x_position >= object_x_position) AND (high_x_position <= end_object_x_position)) THEN
            screen_change.attribute := p_form_object_definition^.display_attribute;
            screen_change.attribute_object_index := object_index;
            fdp$record_screen_change (screen_change, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            CYCLE /find_objects/;
          IFEND;
        IFEND;

        { Check for mark on vertical  lines of box. }

        IF ((low_x_position = object_x_position) OR (high_x_position = end_object_x_position)) THEN
          IF ((low_y_position >= object_y_position) AND (high_y_position <= end_object_y_position)) THEN
            screen_change.attribute_object_index := object_index;
            screen_change.attribute := p_form_object_definition^.display_attribute;
            fdp$record_screen_change (screen_change, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            CYCLE /find_objects/;
          IFEND;
        IFEND;

      = fdc$form_line =
        end_object_x_position := object_x_position + p_form_object_definition^.x_increment;
        end_object_y_position := object_y_position + p_form_object_definition^.y_increment;
        IF ((low_x_position <= object_x_position) AND (low_y_position <= object_y_position) AND
              (high_x_position >= end_object_x_position) AND (high_y_position >= end_object_y_position)) THEN
          screen_change.attribute := p_form_object_definition^.display_attribute;
          screen_change.attribute_object_index := object_index;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;

        IF ((low_x_position >= object_x_position) AND (low_y_position >= object_y_position) AND
              (high_x_position <= end_object_x_position) AND (high_y_position <= end_object_y_position)) THEN
          screen_change.attribute_object_index := object_index;
          screen_change.attribute := p_form_object_definition^.display_attribute;
          fdp$record_screen_change (screen_change, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          CYCLE /find_objects/;
        IFEND;
      ELSE
      CASEND;

    FOREND /find_objects/;

  PROCEND fdp$delete_mark;

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

  PROCEDURE [XDCL] fdp$write_form_definition
    (    form_identifier: fdt$form_identifier;
     VAR p_form_module: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      actual_sequence_length: llt$section_length,
      form_object_text_descriptor: ^llt$object_text_descriptor,
      identification: ^llt$identification,
      local_status: ost$status,
      object_text_descriptor: ^llt$object_text_descriptor,
      p_comment: ^fdt$comment,
      p_comments: ^array [1 .. * ] of fdt$comment_definition,
      p_form_status: ^fdt$form_status,
      p_to_form_definition: ^fdt$form_definition,
      p_form_definition: ^fdt$form_definition,
      p_to_form_status: ^fdt$form_status,
      remaining_sequence_length: llt$section_length,
      to_form_identifier: fdt$form_identifier;

?? 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);
      IF p_to_form_status <> NIL THEN
        p_to_form_status^.entry_used := FALSE;
      IFEND;
        EXIT fdp$write_form_definition;
      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);
      IF p_to_form_status <> NIL THEN
        p_to_form_status^.entry_used := FALSE;
      IFEND;
        EXIT fdp$write_form_definition;
      IFEND;

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

?? OLDTITLE, EJECT ??

    p_to_form_status := NIL;
    osp$establish_condition_handler (^condition_handler, TRUE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    IF p_form_definition^.form_name = osc$null_name THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_name_required, '', status);
      RETURN;
    IFEND;

    fdp$create_form_status (to_form_identifier, p_to_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT object_text_descriptor IN p_form_module;
    IF object_text_descriptor = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      p_to_form_status^.entry_used := FALSE;
      RETURN;
    IFEND;
    object_text_descriptor^.kind := llc$identification;

    NEXT identification IN p_form_module;
    IF identification = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      p_to_form_status^.entry_used := FALSE;
      RETURN;
    IFEND;

    identification^.name := p_form_definition^.form_name;
    identification^.object_text_version := llc$object_text_version;
    identification^.kind := llc$form;
    pmp$get_legible_date_time (osc$mdy_date, identification^.date_created, osc$hms_time, identification^.
          time_created, local_status);
    identification^.attributes := $llt$module_attributes [llc$nonbindable, llc$nonexecutable];
    identification^.generator_id := llc$screen_formatter;
    identification^.generator_name_vers := fdc$screen_generator_version;

    p_comments := fdp$ptr_comments (p_form_definition^.comment_definitions, p_form_module);
    IF p_comments <> NIL THEN
      p_comment := #PTR (p_comments^ [1].p_comment, p_form_module^);
      identification^.commentary := p_comment^;
    ELSE
      identification^.commentary := ' ';
    IFEND;

    NEXT form_object_text_descriptor IN p_form_module;
    IF form_object_text_descriptor = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      p_to_form_status^.entry_used := FALSE;
      RETURN;
    IFEND;

    form_object_text_descriptor^.kind := llc$form_definition;
    remaining_sequence_length := #SIZE (p_form_module^) - i#current_sequence_position (p_form_module);
    NEXT p_to_form_status^.p_form_module: [[REP remaining_sequence_length OF cell]] IN p_form_module;
    RESET p_to_form_status^.p_form_module;
    copy_form (p_form_status, p_to_form_status, status);
    IF NOT status.normal THEN
      p_to_form_status^.entry_used := FALSE;
      RETURN;
    IFEND;

    actual_sequence_length := i#current_sequence_position (p_to_form_status^.p_form_module);
    RESET p_form_module TO form_object_text_descriptor;
    NEXT form_object_text_descriptor IN p_form_module;
    form_object_text_descriptor^.sequence_length := actual_sequence_length;
    NEXT p_to_form_status^.p_form_module: [[REP actual_sequence_length OF cell]] IN p_form_module;
    p_to_form_status^.entry_used := FALSE;

  PROCEND fdp$write_form_definition;

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

  PROCEDURE [XDCL] fdp$write_record_definition
    (    form_identifier: fdt$form_identifier;
         file_identifier: amt$file_identifier;
         form_processor: fdt$form_processor;
     VAR status: ost$status);

    CONST
      line_maximum = 132;

    VAR
      additional_definitions:  fdt$additional_definitions,
      deck_name: ost$name,
      fba: amt$file_byte_address,
      fortran_form: boolean,
      line_out: string (line_maximum),
      line_length: integer,
      no_of_occurrences: fdt$occurrence,
      occurrences_string: string (5),
      occurrences_string_length: integer,
      p_added_variable_definition:^fdt$added_variable_definition,
      p_form_definition: ^fdt$form_definition,
      p_form_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_status: ^fdt$form_status,
      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_sequence: ^SEQ (*),
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. * ] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. * ] of fdt$table_variable,
      p_text: ^fdt$text,
      p_variable_record_definition: ^fdt$variable_record_definition,
      record_index: fdt$variable_index,
      record_name: ost$name,
      scratch_name: ost$name,
      table_index: fdt$table_index,
      table_name: ost$name,
      table_variable_index: fdt$variable_index,
      temp_line: string (line_maximum),
      temp_line_length: integer,
      variable_index: fdt$variable_index,
      variable_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$write_record_definition;
        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$write_record_definition;
        IFEND;

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

?? OLDTITLE ??
?? NEWTITLE := 'write_cobol_record', EJECT ??
{ PURPOSE:
{   This procedure writes the record definition for a COBOL processor.

    PROCEDURE write_cobol_record;

      CONST
        integer_specifications = ' PIC S9(18) COMP SYNC LEFT.',
        level_01 = '       01  ',
        level_03 = '03',
        level_03_column = 12,
        level_05 = '05',
        level_05_column  = 16,
        occurs_clause = ' OCCURS',
        picture_clause = ' PIC ',
        real_specifications = ' COMP-1.',
        synchronized_clause = ' SYNC LEFT';

      VAR
        cobol_level: string (2),
        starting_column: level_03_column .. level_05_column;

?? NEWTITLE := 'write_cobol_line', EJECT ??
{ PURPOSE:
{   This procedure writes one or more source code lines for the COBOL compiler.

    PROCEDURE write_cobol_line;

      CONST
        start_column = 16,
        cobol_column_maximum = 72;

      VAR
        break_column: 1 .. line_maximum,
        last_column: 1 .. line_maximum,
        new_line: string (line_maximum);

      IF line_length < cobol_column_maximum + 1 THEN
        amp$put_next (file_identifier, ^line_out, line_length, fba, status);
        IF NOT status.normal THEN
            EXIT fdp$write_record_definition;
        IFEND;
        RETURN;
      IFEND;

{ The line is longer than the 72 columns COBOL allows.  Write two lines.
{ The first line includes as many full words as possible up to and including
{ column 72.  A space indicates the end of a word.
{ The next line includes the rest of the data. A non blank character will always
{ be found before column 1.

      /find_word_break/
      FOR break_column := cobol_column_maximum DOWNTO 1 DO
        IF line_out (break_column, 1) = ' ' THEN
          EXIT /find_word_break/;
        IFEND;
      FOREND /find_word_break/;

      /remove_trailing_spaces/
      FOR last_column := break_column - 1 DOWNTO 1 DO
        IF line_out (last_column, 1) <> ' ' THEN
          EXIT /remove_trailing_spaces/;
        IFEND;
      FOREND /remove_trailing_spaces/;

      amp$put_next (file_identifier, ^line_out, last_column, fba, status);
      IF NOT status.normal THEN
        EXIT fdp$write_record_definition;
      IFEND;

      new_line (1, start_column - 1) := '';
      new_line (start_column, line_length - break_column) :=
            line_out (break_column + 1, line_length - break_column);
      amp$put_next (file_identifier, ^new_line,
            start_column + line_length - break_column - 1, fba, status);
      IF NOT status.normal THEN
        EXIT fdp$write_record_definition;
      IFEND;

    PROCEND write_cobol_line;

?? OLDTITLE ??
?? NEWTITLE := 'write_cobol_variable', EJECT ??
{ PURPOSE:
{   This procedure writes the COBOL clause for a variable.

    PROCEDURE write_cobol_variable;

      VAR
        p_added_variable_definition: ^fdt$added_variable_definition,
        usage: string (15 + 1);

?? OLDTITLE ??
?? NEWTITLE := 'get_usage_string', EJECT ??
{ PURPOSE:
{   This procedure gets the string for the USAGE clause.

     PROCEDURE get_usage_string;

     CASE p_added_variable_definition^.form_cobol_program_clause.
                    cobol_program_clause.usage OF
     = fdc$binary_usage =
       usage := ' BINARY';
     = fdc$computational_usage =
       usage := ' COMPUTATIONAL';
     = fdc$comp_usage =
       usage := ' COMP';
     = fdc$computational_1_usage =
       usage := ' COMPUTATIONAL-1';
     = fdc$comp_1_usage=
       usage := ' COMP-1';
     = fdc$computational_2_usage =
        usage := ' COMPUTATIONAL-2';
     = fdc$comp_2_usage =
       usage := ' COMP-2';
     = fdc$computational_3_usage =
        usage := ' COMPUTATIONAL-3';
     = fdc$comp_3_usage =
       usage := ' COMP-3';
     = fdc$packed_decimal_usage =
       usage := ' PACKED-DECIMAL';
     ELSE { Do not output default for fdc$display_usage.
       usage := '';
     CASEND;

     PROCEND get_usage_string;

?? OLDTITLE, EJECT ??

      variable_name := p_form_variable_definition^.name;
      fdp$convert_to_cobol_name (variable_name);
      line_out (1, starting_column - 1)  := '';
      STRINGREP (line_out, line_length, line_out (1, starting_column - 1), cobol_level, '  ',
            variable_name (1, clp$trimmed_string_size (variable_name)));
      CASE p_form_variable_definition^.program_data_type OF

          = fdc$program_integer_type =
            STRINGREP (line_out, line_length, line_out (1, line_length), integer_specifications);

          = fdc$program_real_type =
            STRINGREP (line_out, line_length, line_out (1, line_length), real_specifications);

          = fdc$program_cobol_type =
            fdp$locate_added_variable_facts (p_form_status^.p_form_module, p_form_variable_definition,
                  p_added_variable_definition);
            CASE p_added_variable_definition^.program_cobol_description.cobol_usage OF

            = fdc$cobol_usage_single =
              get_usage_string;
              STRINGREP (line_out, line_length, line_out (1, line_length),
                    usage (1, clp$trimmed_string_size (usage)), '.');

            = fdc$cobol_usage_binary =
              get_usage_string;
              STRINGREP (line_out, line_length, line_out (1, line_length),
                   usage (1, clp$trimmed_string_size (usage)), picture_clause,
                     p_added_variable_definition^.form_cobol_program_clause.cobol_program_clause.picture
                    (1, clp$trimmed_string_size (p_added_variable_definition^.form_cobol_program_clause.
                    cobol_program_clause.picture)));

{ Sychronize COMPUTATONAL item if item takes a word.

              IF p_added_variable_definition^.program_cobol_description.size = fdc$integer_length THEN
                STRINGREP (line_out, line_length, line_out (1, line_length), synchronized_clause, '.');
              ELSE
                STRINGREP (line_out, line_length, line_out (1, line_length), '.');
              IFEND;

            ELSE { Process other COBOL usages.
              get_usage_string;
              STRINGREP (line_out, line_length, line_out (1, line_length),
                   usage (1, clp$trimmed_string_size (usage)), picture_clause,
                   p_added_variable_definition^.form_cobol_program_clause.cobol_program_clause.picture
                   (1, clp$trimmed_string_size (p_added_variable_definition^.form_cobol_program_clause.
                   cobol_program_clause.picture)), '.');
           CASEND;

         ELSE {fdc$program_character_type, fdc$program_upper_case_type
           STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
           STRINGREP ( line_out, line_length, line_out (1, line_length), picture_clause,
                 'X(', temp_line (2, temp_line_length - 1), ').');

         CASEND;

         write_cobol_line;

       PROCEND write_cobol_variable;

?? OLDTITLE ??
?? NEWTITLE := 'write_fortran_table', EJECT ??

{ PURPOSE:
{   This procedure writes the COBOL source statements for a form that was
{   defined with a FORTRAN processor.
{ DESIGN:
{   FORTRAN does not have a record structure.  Every variable in a table must have an OCCURS clause.

     PROCEDURE write_fortran_table;

       FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
         p_table_variable := ^p_table_variables^ [table_variable_index];
         p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
         variable_name := p_form_variable_definition^.name;
         fdp$convert_to_cobol_name (variable_name);
         line_out (1, level_03_column - 1)  := '';
         STRINGREP (line_out, line_length, line_out (1, level_03_column - 1), level_03, '  ',
               variable_name (1, clp$trimmed_string_size (variable_name)),
               occurs_clause, no_of_occurrences);
         CASE p_form_variable_definition^.program_data_type OF

         = fdc$program_integer_type =
           STRINGREP (line_out, line_length, line_out (1, line_length), integer_specifications);

         = fdc$program_real_type =
           STRINGREP (line_out, line_length, line_out (1, line_length), real_specifications);

         ELSE {fdc$program_character_type, fdc$program_upper_case_type}
           STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
           STRINGREP (line_out, line_length, line_out (1, line_length), picture_clause, 'X(',
                 temp_line (2, temp_line_length - 1), ').');

         CASEND;

         write_cobol_line;
       FOREND;

     PROCEND write_fortran_table;

?? OLDTITLE, EJECT ??

{  Write record name as 01 level data item.

      fdp$convert_to_cobol_name (record_name);
      STRINGREP (line_out, line_length, level_01, record_name
            (1, clp$trimmed_string_size (record_name)),  '.');
      write_cobol_line;

      FOR record_index := 1 TO UPPERBOUND (p_form_status^.p_form_record_definitions^) DO
        p_variable_record_definition := ^p_record_definitions^ [record_index];
        CASE p_variable_record_definition^.key OF

{  Output definition for a single variable. The variable will be a 03 level data item.

        = fdc$record_variable =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_variable_record_definition^.variable_index];
          starting_column := level_03_column;
          cobol_level := level_03;
          write_cobol_variable;

{  Output definition for a table.

        = fdc$record_table =
          table_index := p_variable_record_definition^.table_index;
          p_form_table_definition := ^p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);
          table_name := p_form_table_definition^.name;
          fdp$convert_to_cobol_name (table_name);
          no_of_occurrences := p_form_table_definition^.stored_occurrence;
          IF fortran_form THEN

{ A FORTRAN form requires that every variable in a table has an OCCURS clause.

            write_fortran_table;

          ELSE

{ A table will be a 03 level data item with an OCCURS clause.
{ Variables in the table will be 05 level data items.

            STRINGREP (line_out, line_length, '           ', level_03, '  ',
                  table_name (1, clp$trimmed_string_size (table_name)), occurs_clause,
                  no_of_occurrences, '.');
            write_cobol_line;
            starting_column := level_05_column;
            cobol_level := level_05;
            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              write_cobol_variable;
            FOREND;
          IFEND;
        CASEND;
      FOREND;

    PROCEND write_cobol_record;

?? OLDTITLE ??
?? NEWTITLE := 'write_cybil_record', EJECT ??

    PROCEDURE write_cybil_record;

{
{  WRITE CYBIL FORMAT RECORD.
{
      #TRANSLATE (fdv$to_cybil, record_name, scratch_name);
      record_name := scratch_name;
      STRINGREP (line_out, line_length, '  TYPE');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (line_out, line_length, '    ', record_name (1, clp$trimmed_string_size (record_name)),
            ' = record');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Align record on word boundary. This makes CYBIL data mapping the same as COBOL and FORTRAN.

      STRINGREP (line_out, line_length, '      align_field: ALIGNED [0 MOD 8] string (0),');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      FOR record_index := 1 TO UPPERBOUND (p_form_status^.p_form_record_definitions^) DO
        p_variable_record_definition := ^p_record_definitions^ [record_index];
        CASE p_variable_record_definition^.key OF

{
{  OUTPUT DEFINITION FOR A SIMPLE VARIABLE.
{
        = fdc$record_variable =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_variable_record_definition^.variable_index];
          variable_name := p_form_variable_definition^.name;
          #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
          variable_name := scratch_name;
          CASE p_form_variable_definition^.program_data_type OF

          = fdc$program_integer_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': ALIGNED [0 MOD 8] integer,');

          = fdc$program_real_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': ALIGNED [0 MOD 8] real,');

          ELSE  {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

            STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': string (',
                  temp_line (2, temp_line_length - 1), '),');
          CASEND;
          amp$put_next (file_identifier, ^line_out, line_length, fba, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{  OUTPUT DEFINITION FOR A TABLE.

        = fdc$record_table =
          table_index := p_variable_record_definition^.table_index;
          p_form_table_definition := ^p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);
          no_of_occurrences := p_form_table_definition^.stored_occurrence;
          IF fortran_form THEN

{ A FORTRAN form requires that every variable in a table is an array.

            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              variable_name := p_form_variable_definition^.name;
              #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
              variable_name := scratch_name;
              CASE p_form_variable_definition^.program_data_type OF

              = fdc$program_integer_type =
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)), ': ALIGNED [0 MOD 8]');
                amp$put_next (file_identifier, ^line_out, line_length, fba, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                STRINGREP (line_out, line_length, ' array [1 ..', no_of_occurrences, '] of integer,');

              = fdc$program_real_type =
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)), ': ALIGNED [0 MOD 8]');
                amp$put_next (file_identifier, ^line_out, line_length, fba, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
                STRINGREP (line_out, line_length, ' array [1 ..', no_of_occurrences, '] of real,');

              ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

                STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)), ': array [1 ..', no_of_occurrences,
                      '] of string(', temp_line (2, temp_line_length - 1), '),');
              CASEND;
              amp$put_next (file_identifier, ^line_out, line_length, fba, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            FOREND;

          ELSE { This is not a FORTRAN form.

{ A table will be a record with one or more variables.
{ The record will occur one or more times.

            table_name := p_form_table_definition^.name;
            #TRANSLATE (fdv$to_cybil, table_name, scratch_name);
            table_name := scratch_name;
            STRINGREP (line_out, line_length, '      ', table_name (1, clp$trimmed_string_size (table_name)),
                  ': array [1 ..', no_of_occurrences, '] of record');
            amp$put_next (file_identifier, ^line_out, line_length, fba, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              variable_name := p_form_variable_definition^.name;
              #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
              variable_name := scratch_name;
              CASE p_form_variable_definition^.program_data_type OF

              = fdc$program_integer_type =
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': ALIGNED [0 MOD 8] integer,');

              = fdc$program_real_type =
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': ALIGNED [0 MOD 8] real,');

              ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

                STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': string (', temp_line (2, temp_line_length - 1), '),');
              CASEND;
              amp$put_next (file_identifier, ^line_out, line_length, fba, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            FOREND;

            STRINGREP (line_out, line_length, '      recend,');
            amp$put_next (file_identifier, ^line_out, line_length, fba, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        CASEND;
      FOREND;

      STRINGREP (line_out, line_length, '    recend;');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    PROCEND write_cybil_record;

?? OLDTITLE ??
?? NEWTITLE := 'write_fortran_record', EJECT ??

    PROCEDURE write_fortran_record;

      VAR
        equivalence_length: integer,
        equivalence_string: string (20+31+1),
        redefine_record_name: ost$name;

?? NEWTITLE := 'write_fortran_line', EJECT ??

{ PURPOSE:
{   This procedure writes one or more source code lines for the FORTRAN compiler.

    PROCEDURE write_fortran_line;

      CONST
        fortran_start_column = 7,
        fortran_maximum_column = 72;

      VAR
        break_column: 1 .. line_maximum,
        last_column: 1 .. line_maximum,
        new_line: string (line_maximum);

      IF line_length < fortran_maximum_column + 1 THEN
        amp$put_next (file_identifier, ^line_out, line_length, fba, status);
        IF NOT status.normal THEN
            EXIT fdp$write_record_definition;
        IFEND;
        RETURN;
      IFEND;

{ The line is longer than the 72 columns FORTRAN allows.  This can occur only
{ on the line that contains the "EQUIVALENCE" statement. Write two lines.
{ The first line has "EQUIVALENCE symbol_1,".  The second line has "symbol_2"
{ A comma character will always will be found before column 1.

      /find_word_break/
      FOR break_column := fortran_maximum_column DOWNTO 1 DO
        IF line_out (break_column, 1) = ',' THEN
          EXIT /find_word_break/;
        IFEND;
      FOREND /find_word_break/;

      amp$put_next (file_identifier, ^line_out, break_column, fba, status);
      IF NOT status.normal THEN
        EXIT fdp$write_record_definition;
      IFEND;

      new_line (1, fortran_start_column - 1) := '     -';
      new_line (fortran_start_column, line_length - break_column) :=
            line_out (break_column + 1, line_length - break_column);
      amp$put_next (file_identifier, ^new_line,
            fortran_start_column + line_length - break_column - 1, fba, status);
      IF NOT status.normal THEN
        EXIT fdp$write_record_definition;
      IFEND;

    PROCEND write_fortran_line;

?? OLDTITLE, EJECT ??

{
{  WRITE FORTRAN FORMAT RECORD.
{

{ Create character variable to hold entire record.
{ Programs will use this character variable to get/replace records.
{ It has the correct record length in characters.

      fdp$convert_to_fortran_name (form_processor, record_name);
      STRINGREP (temp_line, temp_line_length, p_form_definition^.program_record_length);
      STRINGREP (line_out, line_length, '      CHARACTER ', record_name (1, clp$trimmed_string_size
            (record_name)), '*', temp_line (2, temp_line_length - 1));
      write_fortran_line;


{ Create character array for equivalencing other variables.

      redefine_record_name (2, *) := record_name;
      redefine_record_name (1, 1) := 'X';
      fdp$convert_to_fortran_name (form_processor, redefine_record_name);
      STRINGREP (equivalence_string, equivalence_length, '      EQUIVALENCE (',
            redefine_record_name (1, clp$trimmed_string_size (redefine_record_name)), '(');
      STRINGREP (temp_line, temp_line_length, p_form_definition^.program_record_length);
      STRINGREP (line_out, line_length, '      CHARACTER ', redefine_record_name (1, clp$trimmed_string_size
            (redefine_record_name)), '(', temp_line (2, temp_line_length - 1), ')');
      write_fortran_line;

      STRINGREP (line_out, line_length, '      EQUIVALENCE (',
            record_name (1, clp$trimmed_string_size (record_name)), ',',
            redefine_record_name (1, clp$trimmed_string_size (redefine_record_name)), '(1))');
      write_fortran_line;

      FOR record_index := 1 TO UPPERBOUND (p_form_status^.p_form_record_definitions^) DO
        p_variable_record_definition := ^p_record_definitions^ [record_index];
        CASE p_variable_record_definition^.key OF

{  OUTPUT DEFINITION FOR A SIMPLE VARIABLE.

        = fdc$record_variable =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_variable_record_definition^.variable_index];
          variable_name := p_form_variable_definition^.name;
          fdp$convert_to_fortran_name (form_processor, variable_name);
          CASE p_form_variable_definition^.program_data_type OF

          = fdc$program_integer_type =
            STRINGREP (line_out, line_length, '      INTEGER ',
                  variable_name (1, clp$trimmed_string_size (variable_name)));

          = fdc$program_real_type =
            STRINGREP (line_out, line_length, '      REAL ', variable_name
                  (1, clp$trimmed_string_size (variable_name)));

          ELSE {fdc$program_character_type, fdc$program_upper_case_type}

{ Intermediate stringrep so can delete leading blank before integer.

            STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
            STRINGREP (line_out, line_length, '      CHARACTER ',
                  variable_name (1, clp$trimmed_string_size (variable_name)),
                  '*', temp_line (2, temp_line_length - 1));
          CASEND;

          write_fortran_line;
          STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_record_position);
          STRINGREP (line_out, line_length, equivalence_string (1, equivalence_length),
                temp_line (2, temp_line_length - 1), '),', variable_name
                (1, clp$trimmed_string_size (variable_name)), ')');
          write_fortran_line;

{  OUTPUT DEFINITION FOR A TABLE.

        = fdc$record_table =
          table_index := p_variable_record_definition^.table_index;
          p_form_table_definition := ^p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);
          STRINGREP (occurrences_string, occurrences_string_length,
                p_form_table_definition^.stored_occurrence);
          IF NOT fortran_form AND (p_form_table_definition^.table_variables.active_number > 1) THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$record_defn_not_written,
                  p_form_status^.p_form_definition^.form_name, status);
            RETURN;
          IFEND;
          FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
            p_table_variable := ^p_table_variables^ [table_variable_index];
            p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
            variable_name := p_form_variable_definition^.name;
            fdp$convert_to_fortran_name (form_processor, variable_name);
            CASE p_form_variable_definition^.program_data_type OF

            = fdc$program_integer_type =
              STRINGREP (line_out, line_length, '      INTEGER ',
                    variable_name (1, clp$trimmed_string_size (variable_name)),
                    ' (', occurrences_string (2, occurrences_string_length - 1), ')');

            = fdc$program_real_type =
              STRINGREP (line_out, line_length, '      REAL ',
                    variable_name (1, clp$trimmed_string_size (variable_name)),
                    ' (', occurrences_string (2, occurrences_string_length - 1), ')');

            ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

              STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
              STRINGREP (line_out, line_length, '      CHARACTER ',
                    variable_name (1, clp$trimmed_string_size (variable_name)), '(', occurrences_string
                    (2, occurrences_string_length - 1), ')', '*', temp_line (2, temp_line_length - 1));

            CASEND;

            write_fortran_line;
            p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                  p_form_status^.p_form_module);
            p_table_object := ^p_table_objects^ [1];
            STRINGREP (temp_line, temp_line_length, p_table_object^.program_record_position);
            STRINGREP (line_out, line_length, equivalence_string (1, equivalence_length),
                  temp_line (2, temp_line_length - 1), '),', variable_name
                  (1, clp$trimmed_string_size (variable_name)), '(1))');
            write_fortran_line;
          FOREND;
        CASEND;
      FOREND;

    PROCEND write_fortran_record;

?? OLDTITLE ??
?? NEWTITLE := 'write_pascal_record', EJECT ??

    PROCEDURE write_pascal_record;

{  Write PASCAL record definition.

      #TRANSLATE (fdv$to_cybil, record_name, scratch_name);
      record_name := scratch_name;
      STRINGREP (line_out, line_length, '  TYPE');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (line_out, line_length, '    ', record_name (1, clp$trimmed_string_size (record_name)),
            ' = record');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      FOR record_index := 1 TO UPPERBOUND (p_form_status^.p_form_record_definitions^) DO
        p_variable_record_definition := ^p_record_definitions^ [record_index];
        CASE p_variable_record_definition^.key OF

{  Generate definition for a simple variable.

        = fdc$record_variable =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_variable_record_definition^.variable_index];
          variable_name := p_form_variable_definition^.name;
          #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
          variable_name := scratch_name;

          CASE p_form_variable_definition^.program_data_type OF

          = fdc$program_integer_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': integer;');

          = fdc$program_real_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': real;');

          ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

            STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': string (',
                  temp_line (2, temp_line_length - 1), ');');
          CASEND;

          amp$put_next (file_identifier, ^line_out, line_length, fba, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{  Generate definition  for a table.

        = fdc$record_table =
          table_index := p_variable_record_definition^.table_index;
          p_form_table_definition := ^p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);
          no_of_occurrences := p_form_table_definition^.stored_occurrence;
          IF fortran_form THEN

{ A FORTRAN form requires that every variable in a table is an array.

            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              variable_name := p_form_variable_definition^.name;
              #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
              variable_name := scratch_name;

              CASE p_form_variable_definition^.program_data_type OF

              = fdc$program_integer_type =
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)),
                      ': array [1 ..', no_of_occurrences, '] of integer;');

              = fdc$program_real_type =
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)),
                      ': array [1 ..', no_of_occurrences, '] of real;');

              ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

                STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
                STRINGREP (line_out, line_length, '      ', variable_name
                      (1, clp$trimmed_string_size (variable_name)), ': array [1 ..', no_of_occurrences,
                      '] of string(', temp_line (2, temp_line_length - 1), ');');
              CASEND;

              amp$put_next (file_identifier, ^line_out, line_length, fba, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            FOREND;

          ELSE { This is not a FORTRAN form. }

{ A table will be a record with one or more variables.
{ The record will occur one or more times.

            table_name := p_form_table_definition^.name;
            #TRANSLATE (fdv$to_cybil, table_name, scratch_name);
            table_name := scratch_name;
            STRINGREP (line_out, line_length, '      ', table_name (1, clp$trimmed_string_size (table_name)),
                  ': array [1 ..', no_of_occurrences, '] of record');
            amp$put_next (file_identifier, ^line_out, line_length, fba, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              variable_name := p_form_variable_definition^.name;
              #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
              variable_name := scratch_name;

              CASE p_form_variable_definition^.program_data_type OF

              = fdc$program_integer_type =
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': integer;');

              = fdc$program_real_type =
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': real;');

              ELSE {fdc$program_character_type, fdc$program_upper_case_type}

{ Intermediate stringrep so can delete leading blank before integer.

                STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
                STRINGREP (line_out, line_length, '        ',
                      variable_name (1, clp$trimmed_string_size (variable_name)),
                      ': string (', temp_line (2, temp_line_length - 1), ');');
              CASEND;

              amp$put_next (file_identifier, ^line_out, line_length, fba, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            FOREND;

            STRINGREP (line_out, line_length, '      end;');
            amp$put_next (file_identifier, ^line_out, line_length, fba, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        CASEND;
      FOREND;

      STRINGREP (line_out, line_length, '    end;');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    PROCEND write_pascal_record;

?? OLDTITLE ??
?? NEWTITLE := 'write_scl_record', EJECT ??

    PROCEDURE write_scl_record;


{  Write SCL record.

     #TRANSLATE (fdv$to_cybil, record_name, scratch_name);
      record_name := scratch_name (1, 27)  ;
      STRINGREP (line_out, line_length, '  TYPE');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (line_out, line_length, '    fdt#', record_name (1, clp$trimmed_string_size (record_name)),
            ' = RECORD');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      FOR record_index := 1 TO UPPERBOUND (p_form_status^.p_form_record_definitions^) DO
        p_variable_record_definition := ^p_record_definitions^ [record_index];
        CASE p_variable_record_definition^.key OF

{  Output definition for a single variable.

        = fdc$record_variable =
          p_form_variable_definition := ^p_form_variable_definitions^
                [p_variable_record_definition^.variable_index];
          variable_name := p_form_variable_definition^.name;
          #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
          variable_name := scratch_name;
          CASE p_form_variable_definition^.program_data_type OF

          = fdc$program_integer_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': INTEGER');

          = fdc$program_real_type =
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': REAL');

          ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

            STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
            STRINGREP (line_out, line_length, '      ', variable_name
                  (1, clp$trimmed_string_size (variable_name)), ': STRING 0 ..',
                  temp_line (2, temp_line_length - 1));
          CASEND;
          amp$put_next (file_identifier, ^line_out, line_length, fba, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

{  Output definition for a table.

        = fdc$record_table =
          table_index := p_variable_record_definition^.table_index;
          p_form_table_definition := ^p_form_table_definitions^ [table_index];
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_status^.p_form_module);
          no_of_occurrences := p_form_table_definition^.stored_occurrence;

{ A table will be a record with one or more variables.
{ The record will occur one or more times.

          table_name := p_form_table_definition^.name;
          #TRANSLATE (fdv$to_cybil, table_name, scratch_name);
          table_name := scratch_name;
          STRINGREP (line_out, line_length, '      ', table_name (1, clp$trimmed_string_size (table_name)),
                ': ARRAY 1 ..', no_of_occurrences, ' of RECORD');
          amp$put_next (file_identifier, ^line_out, line_length, fba, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
            p_table_variable := ^p_table_variables^ [table_variable_index];
            p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
            variable_name := p_form_variable_definition^.name;
            #TRANSLATE (fdv$to_cybil, variable_name, scratch_name);
            variable_name := scratch_name;
            CASE p_form_variable_definition^.program_data_type OF

            = fdc$program_integer_type =
              STRINGREP (line_out, line_length, '        ',
                    variable_name (1, clp$trimmed_string_size (variable_name)),
                    ': INTEGER');

            = fdc$program_real_type =
              STRINGREP (line_out, line_length, '        ',
                    variable_name (1, clp$trimmed_string_size (variable_name)),
                    ': REAL');

            ELSE {fdc$program_character_type, fdc$program_upper_case_type

{ Intermediate stringrep so can delete leading blank before integer.

              STRINGREP (temp_line, temp_line_length, p_form_variable_definition^.program_variable_length);
              STRINGREP (line_out, line_length, '        ',
                    variable_name (1, clp$trimmed_string_size (variable_name)),
                    ': STRING 0 ..', temp_line (2, temp_line_length - 1));
            CASEND;
            amp$put_next (file_identifier, ^line_out, line_length, fba, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          FOREND;

          STRINGREP (line_out, line_length, '      RECEND');
          amp$put_next (file_identifier, ^line_out, line_length, fba, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        CASEND;
      FOREND;

      STRINGREP (line_out, line_length, '    RECEND');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (line_out, line_length, '  TYPEND');
      amp$put_next (file_identifier, ^line_out, line_length, fba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND write_scl_record;

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

    p_form_definition := p_form_status^.p_form_definition;

{  CHECK AND EXIT WITH AN ERROR INDICATION IF ONE OF THE FOLLOWING : FORM HAS
{  NOT BEEN OPENED, FORM IS INCOMPLETE, FORM HAS ERRORS OR IT IS A
{  'DISPLAY ONLY' FORM (NO VARIABLES) .

    IF NOT p_form_definition^.form_ended THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_not_ended,
            p_form_status^.p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF p_form_definition^.form_has_errors THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_definition_errors,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    IF (p_form_definition^.record_definitions.active_number = 0) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_has_no_variables,
            p_form_definition^.form_name, status);
      RETURN;
    IFEND;

    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;

{ Non COBOL processors cannot have variables with COBOL data type.

    CASE form_processor OF

    = fdc$ansi_fortran_processor, fdc$cdc_fortran_processor,
            fdc$cybil_processor, fdc$scl_processor, fdc$pascal_processor, fdc$unknown_processor =

      /search_for_cobol_data_type/
        FOR variable_index := 1 to p_form_definition^.form_variable_definitions.active_number DO
          IF p_form_variable_definitions^ [variable_index].program_data_type =
                fdc$program_cobol_type THEN
            osp$set_status_abnormal (fdc$format_display_identifier,
                  fde$invalid_cobol_data_type,
                   p_form_variable_definitions^ [variable_index].name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter,
                   p_form_definition^.form_name,  status);
                RETURN;
          IFEND;
        FOREND /search_for_cobol_data_type/;

     ELSE {fdc$cobol_processor

     CASEND;

    fortran_form := ((p_form_definition^.processor = fdc$ansi_fortran_processor) OR
          (p_form_definition^.processor = fdc$cdc_fortran_processor) OR
          (p_form_definition^.processor = fdc$extended_fortran_processor));
    p_record_definitions := p_form_status^.p_form_record_definitions;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;

{  Write deck header.

    IF (p_form_definition^.record_deck_name = '') THEN
      deck_name := p_form_definition^.form_name;
    ELSE
      deck_name := p_form_definition^.record_deck_name;
    IFEND;
    STRINGREP (line_out, line_length, '*DECK deck=', deck_name (1, clp$trimmed_string_size (deck_name)),
          ' expand=false');
    amp$put_next (file_identifier, ^line_out, line_length, fba, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (p_form_definition^.record_name = '') THEN
      record_name := deck_name;
    ELSE
      record_name := p_form_definition^.record_name;
    IFEND;

    CASE form_processor OF
    = fdc$cybil_processor =
      write_cybil_record;

    = fdc$cobol_processor =
      write_cobol_record;

    = fdc$ansi_fortran_processor, fdc$cdc_fortran_processor,
            fdc$extended_fortran_processor =
      write_fortran_record;

    = fdc$pascal_processor =
      write_pascal_record;

    = fdc$scl_processor =
      write_scl_record;

    ELSE

{  Invalid processor.

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

    CASEND;

  PROCEND fdp$write_record_definition;

?? TITLE := 'check_for_sliced_objects', EJECT ??

  PROCEDURE check_for_sliced_objects
    (    p_form_status: ^fdt$form_status;
         p_form_definition: ^fdt$form_definition;
         p_form_module: ^fdt$form_module;
         p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
         number_objects: fdt$number_objects;
         low_x_position: fdt$x_position;
         low_y_position: fdt$y_position;
         high_x_position: fdt$x_position;
         high_y_position: fdt$y_position;
     VAR status: ost$status);

    VAR
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      name_exists: boolean,
      form_object_key: fdt$form_object_key,
      object_index: fdt$object_index,
      object_x_position: fdt$x_position,
      object_y_position: fdt$y_position,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      points_inside_mark: 0 .. 4,
      variable_index: fdt$variable_index;

    status.normal := TRUE;

  /check_area/
    FOR object_index := 1 TO number_objects DO
      p_form_object_definition := ^p_form_object_definitions^ [object_index];
      object_x_position := p_form_object_definition^.x_position;
      object_y_position := p_form_object_definition^.y_position;

      { Check if new object is inside box formed by existing object. }

      form_object_key := p_form_object_definition^.key;

      CASE form_object_key OF

      = fdc$form_box =
        end_object_x_position := object_x_position + p_form_object_definition^.box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.box_height - 1;

      = fdc$form_line =
        end_object_x_position := object_x_position + p_form_object_definition^.x_increment;
        end_object_y_position := object_y_position + p_form_object_definition^.y_increment;

      = fdc$form_variable_text =
        IF p_form_status^.design_form THEN
          IF p_form_object_definition^.name = p_form_status^.design_variable_name THEN
            CYCLE /check_area/;
          IFEND;
        IFEND;

        end_object_x_position := object_x_position + p_form_object_definition^.text_variable_width - 1;
        end_object_y_position := object_y_position;


      = fdc$form_variable_text_box =
        end_object_x_position := object_x_position + p_form_object_definition^.variable_box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.variable_box_height - 1;

      = fdc$form_constant_text =
        end_object_x_position := p_form_object_definition^.constant_text_width + object_x_position - 1;
        end_object_y_position := object_y_position;

      = fdc$form_constant_text_box =
        end_object_x_position := object_x_position + p_form_object_definition^.constant_box_width - 1;
        end_object_y_position := object_y_position + p_form_object_definition^.constant_box_height - 1;

      ELSE
        { Do nothing for these objects. }
        CYCLE /check_area/;

      CASEND;

      { Check to see if all points of object are inside marked area. }

      points_inside_mark := 0;

      { Check upper left corner.}

      IF ((object_x_position >= low_x_position) AND (object_y_position >= low_y_position) AND
            (object_x_position <= high_x_position) AND (object_y_position <= high_y_position)) THEN
        points_inside_mark := points_inside_mark + 1;
      IFEND;

      { Check lower left corner.}

      IF ((object_x_position >= low_x_position) AND (end_object_y_position >= low_y_position) AND
            (object_x_position <= high_x_position) AND (end_object_y_position <= high_y_position)) THEN
        points_inside_mark := points_inside_mark + 1;
      IFEND;

      { Check upper right corner.}

      IF ((end_object_x_position >= low_x_position) AND (object_y_position >= low_y_position) AND
            (end_object_x_position <= high_x_position) AND (object_y_position <= high_y_position)) THEN
        points_inside_mark := points_inside_mark + 1;
      IFEND;

      { Check lower right corner.}

      IF ((end_object_x_position >= low_x_position) AND (end_object_y_position >= low_y_position) AND
            (end_object_x_position <= high_x_position) AND (end_object_y_position <= high_y_position)) THEN
        points_inside_mark := points_inside_mark + 1;
      IFEND;

      IF (points_inside_mark = 4) THEN

        { All points of object are inside marked area. }

        CYCLE /check_area/;
      IFEND;

      { If some but not all points the of object are inside of mark, then mark slices object. }

      IF (points_inside_mark > 0) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      { Does mark intersect object area? }

      IF ((object_x_position >= low_x_position) AND (object_y_position <= low_y_position) AND
            (end_object_x_position <= high_x_position) AND (end_object_y_position >= high_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF ((object_x_position <= low_x_position) AND (object_y_position >= low_y_position) AND
            (end_object_x_position >= high_x_position) AND (end_object_y_position <= high_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      IF form_object_key = fdc$form_box THEN
        IF ((object_x_position < low_x_position) AND (object_y_position < low_y_position) AND
              (end_object_x_position > high_x_position) AND (end_object_y_position > high_y_position)) THEN
          CYCLE /check_area/;
        IFEND;
      IFEND;

      { Check upper left corner.}

      IF ((object_x_position <= low_x_position) AND (object_y_position <= low_y_position) AND
            (end_object_x_position >= low_x_position) AND (end_object_y_position >= low_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      { Check lower left corner.}

      IF ((object_x_position <= low_x_position) AND (object_y_position <= high_y_position) AND
            (end_object_x_position >= low_x_position) AND (end_object_y_position >= high_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      { Check upper right corner.}

      IF ((object_x_position <= high_x_position) AND (object_y_position <= low_y_position) AND
            (end_object_x_position >= high_x_position) AND (end_object_y_position >= low_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

      { Check lower right corner.}

      IF ((object_x_position <= high_x_position) AND (object_y_position <= high_y_position) AND
            (end_object_x_position >= high_x_position) AND (end_object_y_position >= high_y_position)) THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$area_cuts_object, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_x_position), 10, FALSE,
              status);
        osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (low_y_position), 10, FALSE,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
        RETURN;
      IFEND;

    FOREND /check_area/;

  PROCEND check_for_sliced_objects;

MODEND fdm$design_form;
