?? RIGHT := 110 ??
MODULE osm$recoverable_system_error;

{ PURPOSE:
{   This module contains procedures necessary to process recoverable system
{ errors.  A recoverable system error is a system error for which the
{ integrity of the system would be improved by allowing the procedure that
{ detected the error to continue execution following the recording of the
{ error.  System debugging is facilitated by invoking the system core debugger
{ when the error is detected at or below the debug ring.
{
{ DESIGN:
{   The procedures of this module are required to have a ring bracket of
{ (2, 3, D) to allow access to the haltring and the system log while being
{ callable from all job template code.

?? TITLE := 'Global External Procedures', EJECT ??
*copyc clp$convert_integer_to_rjstring
*copyc clp$get_processing_phase
*copyc ocp$find_debug_address
*copyc osp$log_system_error
*copyc osp$system_error
*copyc osp$unpack_status_condition
*copyc pfp$log_ascii
*copyc pmp$log_ascii
*copyc syp$invoke_system_debugger
?? TITLE := 'Global External Type Declarations', EJECT ??
*copyc mtv$halt_cpu_ring_number
*copyc osd$registers
*copyc osk$keypoints
*copyc ost$caller_identifier
*copyc osv$control_codes_to_quest_mark
*copyc tmv$halt_on_hung_task

  VAR
    osv$trace_stack_frame_count: [XREF] 0 .. 0ff(16);

  TYPE
    sfsa_type = record
      fill1: 0 .. 0ffff(16),
      p: ^cell,
      a0: integer,
      a1: integer,
      fill2: 0 .. 0ffff(16),
      a2: ^sfsa_type, {previous save area pointer}
    recend;
?? TITLE := '*** OSP$LOG_UNFORMATTED_STATUS ***', EJECT ??

  PROCEDURE [XDCL, #GATE] osp$log_unformatted_status
    (    p_status: ^ost$status;
         ascii_logset: pmt$ascii_logset;
         message_origin: pmt$log_msg_origin;
         critical_message: boolean);

    VAR
      condition_code: ost$status_condition_number,
      condition_identifier: ost$status_identifier,
      local_status: ost$status,
      message_size: integer,
      message_text: string (osc$max_string_size + 12);

    IF p_status <> NIL THEN
      osp$unpack_status_condition (p_status^.condition, condition_identifier, condition_code);
      #TRANSLATE (osv$control_codes_to_quest_mark, p_status^.text.value (1, p_status^.text.size),
            local_status.text.value (1, p_status^.text.size));
      STRINGREP (message_text, message_size, condition_identifier, condition_code, ' ',
            local_status.text.value (1, p_status^.text.size));
      pfp$log_ascii (message_text (1, message_size), ascii_logset, message_origin, critical_message,
            local_status);
    IFEND;
  PROCEND osp$log_unformatted_status;
?? TITLE := '*** OSP$RECOVERABLE_SYSTEM_ERROR ***', EJECT ??
*copyc osh$recoverable_system_error

  PROCEDURE [XDCL, #GATE] osp$recoverable_system_error
    (    error_message: string ( * );
         p_status: ^ost$status);

    CONST
      critical_message = TRUE;

    VAR
      caller_id: ost$caller_identifier,
      local_status: ost$status,
      logset: pmt$ascii_logset,
      p_caller_p_register: ^ost$p_register,
      processing_phase: clt$processing_phase,
      stack: integer,
      sfsa_p: ^sfsa_type; {pointer to previous stack frame save area}

    #caller_id (caller_id);
    #keypoint (osk$entry, osk$m * caller_id.ring, osk$recoverable_system_error);
    IF caller_id.ring <= mtv$halt_cpu_ring_number THEN
      osp$system_error (error_message, p_status);
    IFEND;
    osp$log_system_error (error_message, 'RECOVERABLE SYSTEM ERROR - ');
    p_caller_p_register := #previous_save_area ();
    log_p_register (p_caller_p_register^, $pmt$ascii_logset [pmc$system_log], local_status);

    clp$get_processing_phase (processing_phase, local_status);
    IF local_status.normal AND (processing_phase > clc$job_begin_phase)
         AND (processing_phase < clc$job_end_phase) THEN
      logset := $pmt$ascii_logset [pmc$system_log, pmc$job_log];
    ELSE
      logset := $pmt$ascii_logset [pmc$system_log];
    IFEND;

    sfsa_p := #previous_save_area ();

    /display_calls/
    FOR stack :=  1 to osv$trace_stack_frame_count DO
      log_stack_pva (stack, sfsa_p^.p, logset, local_status);
      sfsa_p := sfsa_p^.a2; { Move to the next previous save area }
      IF sfsa_p = NIL THEN
        exit /display_calls/
      IFEND;
    FOREND /display_calls/;

    IF caller_id.ring <= tmv$system_debug_ring THEN
      syp$invoke_system_debugger (error_message, 0, local_status);
    IFEND;

    pmp$log_ascii ('*** RECOVERABLE SYSTEM ERROR ***', logset, pmc$msg_origin_system, local_status);

    IF local_status.normal THEN
      pmp$log_ascii (error_message, logset, pmc$msg_origin_system, local_status);
    IFEND;

    IF local_status.normal THEN
      osp$log_unformatted_status (p_status, logset, pmc$msg_origin_system, NOT critical_message);
    IFEND;

    IF NOT local_status.normal THEN
      osp$system_error (error_message, p_status);
    IFEND;

    #keypoint (osk$exit, 0, osk$recoverable_system_error);
  PROCEND osp$recoverable_system_error;
?? TITLE := '*** LOG_P_REGISTER ***', EJECT ??

  PROCEDURE log_p_register
    (    p_register: ost$p_register;
         logset: pmt$ascii_logset;
     VAR status: ost$status);

    VAR
      message: string (18);

    message := 'P = 0 000 00000000';
    clp$convert_integer_to_rjstring (p_register.pva.ring, 16, FALSE, '0', message (5), status);
    IF status.normal THEN
      clp$convert_integer_to_rjstring (p_register.pva.seg, 16, FALSE, '0', message (7, 3), status);
    IFEND;
    IF status.normal THEN
      clp$convert_integer_to_rjstring (p_register.pva.offset, 16, FALSE, '0', message (11, 8), status);
    IFEND;
    IF status.normal THEN
      pmp$log_ascii (message, logset, pmc$msg_origin_system, status);
    IFEND;
  PROCEND log_p_register;
?? TITLE := '*** LOG_STACK_PVA ***', EJECT ??

  PROCEDURE log_stack_pva
    (    stack: integer;
         pva: ^cell;
         logset: pmt$ascii_logset;
     VAR status: ost$status);

    VAR
      found: boolean,
      length: integer,
      message: string (120),
      module_name: ost$name,
      offset_in_section: ost$segment_offset,
      section_name: ost$name;

      status.normal := TRUE;
      ocp$find_debug_address (#SEGMENT(pva), #OFFSET(pva), found, module_name, section_name,
            offset_in_section, status);
      IF found AND status.normal THEN
        STRINGREP (message, length, 'SF', stack:3, ' P=', pva, ' ', section_name, ' +',
              offset_in_section:#(16));
      ELSE
        STRINGREP (message, length, 'SF', stack:3, ' P=', pva);
      IFEND;

      pmp$log_ascii (message (1, length), logset, pmc$msg_origin_system, status);
  PROCEND log_stack_pva;
?? SKIP := 2 ??
MODEND osm$recoverable_system_error;
