?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : Tasking : Debug Interface Management' ??
MODULE pmm$debug_interface_mgmt;

{  PURPOSE:
{    This module contains procedures which load the interfaces to the debug facility and
{    control access to these interfaces.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dbt$begin_debug
*copyc dbt$debug
*copyc dbt$end_debug
*copyc osd$code_base_pointer
*copyc oss$task_private
*copyc ost$caller_identifier
*copyc ost$status
?? POP ??
*copyc lop$add_debug_libraries
*copyc lop$load_entry_point
*copyc osp$system_error
*copyc pmp$find_executing_task_tcb
*copyc pmp$find_prog_options_and_libs
*copyc pmp$get_loaded_rings
*copyc pmp$set_task_state
*copyc pmp$task_debug_ring
*copyc pmp$task_state
*copyc clv$standard_files
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    pmt$debug_procedures = record
      begin_debug: dbt$begin_debug,
      debug: dbt$debug,
      end_debug: dbt$end_debug,
    recend;

  TYPE
    debug_converter = record
      case 0 .. 4 of
      = 0 =
        pointer_to_procedure: ^procedure,
      = 1 =
        code_base_pointer: ^ost$external_code_base_pointer,
      = 2 =
        begin_debug: dbt$begin_debug,
      = 3 =
        debug: dbt$debug,
      = 4 =
        end_debug: dbt$end_debug,
      casend,
    recend;

  VAR
    debug_procedures: [STATIC, oss$task_private] pmt$debug_procedures := [NIL, NIL, NIL];

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$find_begin_debug', EJECT ??

{  PURPOSE:
{    This procedure returns a pointer to the BEGIN_DEBUG procedure, provided that the caller
{    is within the call bracket of BEGIN_DEBUG.

  PROCEDURE [XDCL, #GATE] pmp$find_begin_debug
    (VAR begin_debug: dbt$begin_debug);

    VAR
      caller_id: ost$caller_identifier,
      converter: debug_converter;

    #CALLER_ID (caller_id);
    converter.begin_debug := debug_procedures.begin_debug;
    IF (pmp$task_debug_ring () <= caller_id.ring) AND (caller_id.ring <= converter.code_base_pointer^.r3) THEN
      begin_debug := debug_procedures.begin_debug;
    ELSE
      begin_debug := NIL;
    IFEND;
  PROCEND pmp$find_begin_debug;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$find_debug', EJECT ??
*copy pmh$find_debug

  PROCEDURE [XDCL, #GATE] pmp$find_debug
    (VAR debug: dbt$debug);

    VAR
      caller_id: ost$caller_identifier,
      converter: debug_converter;

    #CALLER_ID (caller_id);
    converter.debug := debug_procedures.debug;
    IF (pmp$task_debug_ring () <= caller_id.ring) AND (caller_id.ring <= converter.code_base_pointer^.r3) THEN
      debug := debug_procedures.debug;
    ELSE
      debug := NIL;
    IFEND;
  PROCEND pmp$find_debug;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$find_end_debug', EJECT ??

{  PURPOSE:
{    This procedure returns a pointer to the END_DEBUG procedure, provided that the caller
{    is within the call bracket of END_DEBUG.

  PROCEDURE [XDCL, #GATE] pmp$find_end_debug
    (VAR end_debug: dbt$end_debug);

    VAR
      caller_id: ost$caller_identifier,
      converter: debug_converter;

    #CALLER_ID (caller_id);
    converter.end_debug := debug_procedures.end_debug;
    IF (pmp$task_debug_ring () <= caller_id.ring) AND (caller_id.ring <= converter.code_base_pointer^.r3) THEN
      end_debug := debug_procedures.end_debug;
    ELSE
      end_debug := NIL;
    IFEND;
  PROCEND pmp$find_end_debug;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$load_debug_procedures', EJECT ??
*copy pmh$load_debug_procedures

  PROCEDURE [XDCL, #GATE] pmp$load_debug_procedures
    (VAR status {control} : ost$status);

    VAR
      converter: debug_converter,
      debug_global_key: ost$key_lock_value,
      debug_procedures_loaded: [STATIC, oss$task_private] boolean := FALSE,
      debug_ring: ost$valid_ring,
      highest_loaded_ring: pmt$loadable_ring,
      loaded_address: pmt$loaded_address,
      loaded_rings: pmt$loadable_rings,
      name: pmt$program_name,
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;

    status.normal := TRUE;
    pmp$get_loaded_rings (loaded_rings);

  /find_highest_loaded_ring/
    FOR highest_loaded_ring := UPPERVALUE (pmt$loadable_ring) DOWNTO LOWERVALUE (pmt$loadable_ring) DO
      IF highest_loaded_ring IN loaded_rings THEN
        EXIT /find_highest_loaded_ring/
      IFEND;
    FOREND /find_highest_loaded_ring/;

    debug_ring := pmp$task_debug_ring ();

    IF NOT debug_procedures_loaded AND (debug_ring <= highest_loaded_ring) THEN

      pmp$find_prog_options_and_libs (prog_options_and_libraries);
      IF prog_options_and_libraries^.debug_library_list <> NIL THEN
        lop$add_debug_libraries (prog_options_and_libraries^.debug_library_list^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      debug_procedures_loaded := TRUE;
      debug_global_key := 0;

      name := 'DBP$BEGIN_DEBUG';
      lop$load_entry_point (name, debug_ring, debug_global_key, pmc$procedure_address, loaded_address,
            status);
      IF NOT status.normal THEN
        debug_procedures.begin_debug := NIL;
        RETURN
      ELSE
        converter.pointer_to_procedure := loaded_address.pointer_to_procedure;
        debug_procedures.begin_debug := converter.begin_debug;
      IFEND;

      name := 'DBP$DEBUG';
      lop$load_entry_point (name, debug_ring, debug_global_key, pmc$procedure_address, loaded_address,
            status);
      IF NOT status.normal THEN
        debug_procedures.begin_debug := NIL;
        debug_procedures.debug := NIL;
        RETURN
      ELSE
        converter.pointer_to_procedure := loaded_address.pointer_to_procedure;
        debug_procedures.debug := converter.debug;
      IFEND;

      name := 'DBP$END_DEBUG';
      lop$load_entry_point (name, debug_ring, debug_global_key, pmc$procedure_address, loaded_address,
            status);
      IF NOT status.normal THEN
        debug_procedures.begin_debug := NIL;
        debug_procedures.debug := NIL;
        debug_procedures.end_debug := NIL;
        RETURN
      ELSE
        converter.pointer_to_procedure := loaded_address.pointer_to_procedure;
        debug_procedures.end_debug := converter.end_debug;
      IFEND;
    IFEND;
  PROCEND pmp$load_debug_procedures;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$debug_abort_file_specified', EJECT ??

{  PURPOSE:
{    This procedure returns the determination whether an abort file is specified
{    for the executing task.

  PROCEDURE [XDCL, #GATE] pmp$debug_abort_file_specified
    (VAR debug_abort_file_specified: boolean);

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    debug_abort_file_specified := (tcb_p^.nosve.abort_file <> clv$standard_files [clc$sf_null_file].
          path_handle_name);
  PROCEND pmp$debug_abort_file_specified;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$initial_debug_mode_on', EJECT ??
*copy pmh$initial_debug_mode_on

  PROCEDURE [XDCL, #GATE] pmp$initial_debug_mode_on
    (VAR initial_debug_mode_on: boolean;
     VAR status: ost$status);

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    initial_debug_mode_on := tcb_p^.nosve.initial_debug_mode;
  PROCEND pmp$initial_debug_mode_on;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$get_debug_abort_file', EJECT ??
*copy pmh$get_debug_abort_file

  PROCEDURE [XDCL, #GATE] pmp$get_debug_abort_file
    (VAR abort_file_specified: boolean;
     VAR abort_file: amt$local_file_name);

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    abort_file_specified := (tcb_p^.nosve.abort_file <>
          clv$standard_files [clc$sf_null_file].path_handle_name);
    abort_file := tcb_p^.nosve.abort_file;

  PROCEND pmp$get_debug_abort_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$get_debug_input_file', EJECT ??
*copy pmh$get_debug_input_file

  PROCEDURE [XDCL, #GATE] pmp$get_debug_input_file
    (VAR input_file_specified: boolean;
     VAR input_file: amt$local_file_name);

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    input_file_specified := (tcb_p^.nosve.debug_input <>
          clv$standard_files [clc$sf_null_file].path_handle_name);
    input_file := tcb_p^.nosve.debug_input;

  PROCEND pmp$get_debug_input_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$get_debug_output_file', EJECT ??
*copy pmh$get_debug_output_file

  PROCEDURE [XDCL, #GATE] pmp$get_debug_output_file
    (VAR output_file_specified: boolean;
     VAR output_file: amt$local_file_name);

    VAR
      tcb_p: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb_p);
    output_file_specified := (tcb_p^.nosve.debug_output <>
          clv$standard_files [clc$sf_null_file].path_handle_name);
    output_file := tcb_p^.nosve.debug_output;

  PROCEND pmp$get_debug_output_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$set_debug_ending', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$set_debug_ending;

    IF (pmp$task_state () < pmc$debug_ending) THEN
      pmp$set_task_state (pmc$debug_ending);
    IFEND;

  PROCEND pmp$set_debug_ending;
?? OLDTITLE ??
MODEND pmm$debug_interface_mgmt;
