?? NEWTITLE := 'NOS/VE:  BASIC ACCESS METHOD : Format Segment Condition' ??
MODULE bam$format_segment_condition;
?? RIGHT := 110 ??

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc osc$processor_defined_registers
*copyc mmd$segment_access_condition
*copyc osd$virtual_address
*copyc ame$access_validation_errors
*copyc ame$get_program_actions
*copyc ame$put_validation_errors
*copyc ame$ring_validation_errors
*copyc ost$name
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc pmt$program_name
?? POP ??
*copyc clp$get_fs_path_string
*copyc ocp$find_debug_address
*copyc osp$append_status_file
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pmp$validate_previous_save_area
*copyc tmp$find_ring_crossing_frame
*copyc bav$last_tft_entry
*copyc bav$task_file_table
*copyc bav$tft_entry_assignment
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [INLINE] append_address_to_message', EJECT ??

  PROCEDURE [INLINE] append_address_to_message
    (    address: ost$pva;
     VAR message {input, output} : ost$status);

    osp$append_status_integer (' ', address.ring, 16, FALSE, message);
    osp$append_status_integer (' ', address.seg, 16, FALSE, message);
    osp$append_status_integer (' ', address.offset, 16, FALSE, message);

  PROCEND append_address_to_message;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE resolve_p_address', EJECT ??

  PROCEDURE resolve_p_address
    (    condition_save_area: ^ost$stack_frame_save_area;
         untranslatable_pointer: ost$pva;
     VAR actual_p: ost$pva;
     VAR resolved_p: ost$pva);

    VAR
      nil_pva: [STATIC, READ, oss$job_paged_literal] ost$pva :=
            [osc$max_ring, osc$maximum_segment, -(osc$maximum_offset + 1)],
      sfsa: ^ost$stack_frame_save_area,
      runanywhere_sfsa: ^ost$stack_frame_save_area,
      x_frame: ^ost$stack_frame_save_area,
      system_error: boolean,
      p_register_i: integer,
      p_reg: ^ost$p_register,
      status: ost$status;


    status.normal := TRUE;

    sfsa := condition_save_area;
    actual_p.ring := sfsa^.minimum_save_area.p_register.pva.ring;
    actual_p.seg := sfsa^.minimum_save_area.p_register.pva.seg;
    actual_p.offset := sfsa^.minimum_save_area.p_register.pva.offset;

    p_register_i := #READ_REGISTER (osc$pr_p_reg);
    p_reg := #LOC (p_register_i);

    IF ((untranslatable_pointer <> nil_pva) AND (sfsa^.minimum_save_area.p_register.pva.ring <=
          osc$sj_ring_3) AND (untranslatable_pointer.ring > osc$sj_ring_3)) OR
          (sfsa^.minimum_save_area.p_register.pva.seg = p_reg^.pva.seg) THEN

{p_reg^.pva.seg is the runanywhere segment

      system_error := FALSE;

      WHILE NOT system_error AND (sfsa^.minimum_save_area.a2_previous_save_area <> NIL) AND
            (sfsa^.minimum_save_area.p_register.pva.ring <= osc$sj_ring_3) AND status.normal DO
        tmp$find_ring_crossing_frame (sfsa, x_frame, status);
        IF (x_frame^.minimum_save_area.a2_previous_save_area <> NIL) THEN
          sfsa := x_frame^.minimum_save_area.a2_previous_save_area;
        ELSE
          sfsa := condition_save_area;
          system_error := TRUE;
        IFEND;
      WHILEND;

      runanywhere_sfsa := sfsa;
      WHILE NOT system_error AND (sfsa^.minimum_save_area.a2_previous_save_area <> NIL) AND
            (sfsa^.minimum_save_area.p_register.pva.seg = p_reg^.pva.seg) AND status.normal DO
        pmp$validate_previous_save_area (sfsa, status);
        IF status.normal THEN
          IF (sfsa^.minimum_save_area.a2_previous_save_area^.minimum_save_area.a2_previous_save_area <> NIL)
                THEN
            sfsa := sfsa^.minimum_save_area.a2_previous_save_area;
          ELSE
            sfsa := runanywhere_sfsa;
            system_error := TRUE;
          IFEND;
        IFEND;
      WHILEND;

      resolved_p.ring := sfsa^.minimum_save_area.p_register.pva.ring;
      resolved_p.seg := sfsa^.minimum_save_area.p_register.pva.seg;
      IF system_error THEN
        resolved_p.offset := sfsa^.minimum_save_area.p_register.pva.offset;
      ELSE
        resolved_p.offset := sfsa^.minimum_save_area.p_register.pva.offset - 4;
      IFEND;
    ELSE
      resolved_p.ring := sfsa^.minimum_save_area.p_register.pva.ring;
      resolved_p.seg := sfsa^.minimum_save_area.p_register.pva.seg;
      resolved_p.offset := sfsa^.minimum_save_area.p_register.pva.offset;
    IFEND;

  PROCEND resolve_p_address;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL, #GATE] bap$format_segment_condition', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$format_segment_condition
    (    identifier: string (2);
         segment_access_condition: mmt$segment_access_condition;
         save_area: ^ost$stack_frame_save_area;
         error_pva: ost$pva;
     VAR condition_status: ost$status);

{   Purpose:
{ The purpose of this procedure is to emit a meaningful message
{ when a hardware/software violation occurs during segment access. The
{ message can be made more meaningful by finding the local name associated
{ with the segment which has encountered the violation.

    VAR
      actual_p: ost$pva,
      file_instance: ^bat$task_file_entry,
      found: boolean,
      module_name: pmt$program_name,
      offset_in_section: ost$segment_offset,
      path: fst$path,
      path_size: fst$path_size,
      resolved_p: ost$pva,
      section_name: pmt$program_name,
      status: ost$status;


    condition_status.normal := TRUE;
    bap$find_open_file_via_segment (#SEGMENT (segment_access_condition.segment), file_instance, path,
          path_size, found);
    IF found THEN
      CASE segment_access_condition.identifier OF
      = mmc$sac_read_beyond_eoi =
        osp$set_status_abnormal (identifier, ame$input_after_eoi, '', condition_status);
      = mmc$sac_read_write_beyond_msl =
        osp$set_status_abnormal (identifier, ame$position_beyond_file_limit, '', condition_status);
      = mmc$sac_pf_space_limit_exceeded, mmc$sac_tf_space_limit_exceeded =
        osp$set_status_abnormal (identifier, ame$file_space_limit_exceeded, '', condition_status);
      = mmc$sac_key_lock_violation, mmc$sac_ring_violation =
        osp$set_status_abnormal (identifier, ame$ring_validation_error, '', condition_status);
      = mmc$sac_segment_access_error =
        osp$set_status_abnormal (identifier, ame$improper_segment_access, '', condition_status);
      = mmc$sac_io_read_error =
        osp$set_status_abnormal (identifier, ame$unrecovered_read_error, '', condition_status);
      = mmc$sac_no_append_permission =
        osp$set_status_abnormal (identifier, ame$position_beyond_eoi, '', condition_status);
      = mmc$sac_file_server_terminated =
        osp$set_status_abnormal (identifier, ame$file_server_terminated, '', condition_status);
      = mmc$sac_runaway_write =
        osp$set_status_abnormal (identifier, ame$maximum_write_span_exceeded, '', condition_status);
      ELSE
        RETURN; {----->
      CASEND;

      osp$append_status_file (osc$status_parameter_delimiter, path (1, path_size), condition_status);
      CASE segment_access_condition.identifier OF
      = mmc$sac_pf_space_limit_exceeded =
        osp$append_status_parameter (osc$status_parameter_delimiter, 'Permanent', condition_status);
      = mmc$sac_tf_space_limit_exceeded =
        osp$append_status_parameter (osc$status_parameter_delimiter, 'Temporary', condition_status);
      ELSE
      CASEND;

      IF file_instance^.access_level = amc$record THEN
        resolve_p_address (save_area, error_pva, actual_p, resolved_p);
        ocp$find_debug_address (resolved_p.seg, resolved_p.offset, found, module_name, section_name,
              offset_in_section, status);
        IF status.normal AND found THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, section_name, condition_status);
        ELSE
          osp$append_status_parameter (osc$status_parameter_delimiter, 'record access - P =',
                condition_status);
          append_address_to_message (actual_p, condition_status);
          IF resolved_p <> actual_p THEN
            osp$append_status_parameter (' ', 'CALLERS P =', condition_status);
            append_address_to_message (resolved_p, condition_status);
          IFEND;
        IFEND;
        IF file_instance^.rollback_procedure <> NIL THEN
          file_instance^.rollback_procedure^ (condition_status);
        IFEND;
      ELSEIF file_instance^.access_level = amc$segment THEN
        resolve_p_address (save_area, error_pva, actual_p, resolved_p);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'segment access - PVA =',
              condition_status);
        append_address_to_message (error_pva, condition_status);
        osp$append_status_parameter (' ', 'P =', condition_status);
        append_address_to_message (actual_p, condition_status);
        IF resolved_p <> actual_p THEN
          osp$append_status_parameter (' ', 'USERS P =', condition_status);
          append_address_to_message (resolved_p, condition_status);
        IFEND;
      IFEND; {file_instance^.access_level = amc$record}
    IFEND; {found}

  PROCEND bap$format_segment_condition;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE [XDCL, #GATE] bap$find_open_file_via_segment', EJECT ??

  PROCEDURE [XDCL, #GATE] bap$find_open_file_via_segment
    (    segment_number: ost$segment;
     VAR file_instance: ^bat$task_file_entry;
     VAR path: fst$path;
     VAR path_size: fst$path_size;
     VAR entry_found: boolean);

    VAR
      ignore_status: ost$status,
      ignore_path_handle: fmt$path_handle,
      index: bat$tft_limit;

    entry_found := FALSE;
    path := ' ';
    path_size := 1;

    IF (bav$task_file_table <> NIL) AND (#SEGMENT (bav$task_file_table) <> segment_number) THEN
      FOR index := 1 TO bav$last_tft_entry DO
        IF bav$tft_entry_assignment^ (index, 1) = fmc$entry_assigned THEN
          file_instance := ^bav$task_file_table^ [index];
          IF (file_instance^.device_class = rmc$mass_storage_device) AND (file_instance^.file_pva <> NIL) AND
                (#SEGMENT (file_instance^.file_pva) = segment_number) THEN
            entry_found := TRUE;
            clp$get_fs_path_string (file_instance^.local_file_name, path, path_size, ignore_path_handle,
                  ignore_status);
            RETURN; {----->
          IFEND; {file_instance^.device_class = rmc$mass_storage_device}
        IFEND; {bav$tft_entry_assignment^ (index, 1) = fmc$entry_assigned}
      FOREND;
    IFEND;

  PROCEND bap$find_open_file_via_segment;
?? OLDTITLE ??
MODEND bam$format_segment_condition;


