?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Program Management - Debug Stack Managers 13F' ??
MODULE pmm$debug_stack_managers_13f;
?? RIGHT := 110 ??

{   PURPOSE:
{     This module handles the access requests to the task debug stacks.
{   These requests include setting, popping, pushing, and obtaining
{   of the current top of the task debug stack.
{

?? NEWTITLE := '  Global Declarations Referenced by this Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc oss$task_shared
*copyc ose$heap_full_exceptions
*copyc pme$debug_exceptions
*copyc ost$caller_identifier
*copyc pmt$os_stack_frame_word
*copyc pmt$task_debug_mode_stack
?? POP ??
*copyc clp$convert_integer_to_string
*copyc clp$put_job_output
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pmp$exit
*copyc pmp$load_debug_procedures
*copyc pmp$validate_previous_save_area
*copyc osv$task_private_heap
?? OLDTITLE ??
?? NEWTITLE := '  Global Declarations Declared by this Module', EJECT ??

  VAR
    initialize_os_stack_frame_word: [STATIC, READ, oss$job_paged_literal] pmt$os_stack_frame_word :=
          [NIL, FALSE, FALSE, FALSE, FALSE, 0];

  VAR
    pmv$task_debug_mode: [STATIC, oss$task_private] pmt$task_debug_mode_stack := [ * , NIL];

?? OLDTITLE ??
?? NEWTITLE := '  [XDCL]  PMP$PUSH_TASK_DEBUG_MODE', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$push_task_debug_mode
    (    debug_mode: pmt$debug_mode;
     VAR status: ost$status);

*copy pmh$push_task_debug_mode

    VAR
      new_stack: ^pmt$debug_mode_stack;

    status.normal := TRUE;

    IF debug_mode = pmc$debug_mode_on THEN
      pmp$load_debug_procedures (status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    IF (pmv$task_debug_mode.stack <> NIL) OR (debug_mode = pmc$debug_mode_on) THEN
      IF (pmv$task_debug_mode.stack = NIL) OR (pmv$task_debug_mode.top_of_stack =
            pmc$max_elements_in_debug_stack) THEN
        ALLOCATE new_stack IN osv$task_private_heap^;
        new_stack^.previous_stack := pmv$task_debug_mode.stack;
        pmv$task_debug_mode.stack := new_stack;
        pmv$task_debug_mode.top_of_stack := pmc$min_elements_in_debug_stack;
        pmv$task_debug_mode.stack^.element [pmv$task_debug_mode.top_of_stack] := debug_mode;

      ELSE
        pmv$task_debug_mode.top_of_stack := pmv$task_debug_mode.top_of_stack + 1;
        pmv$task_debug_mode.stack^.element [pmv$task_debug_mode.top_of_stack] := debug_mode;
      IFEND;
    IFEND;

  PROCEND pmp$push_task_debug_mode;
?? TITLE := '  [XDCL]  PMP$POP_TASK_DEBUG_MODE', EJECT ??

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

*copy pmh$pop_task_debug_mode

    VAR
      previous_stack: ^pmt$debug_mode_stack;

    status.normal := TRUE;

    IF pmv$task_debug_mode.stack <> NIL THEN
      IF pmv$task_debug_mode.top_of_stack = pmc$min_elements_in_debug_stack THEN
        previous_stack := pmv$task_debug_mode.stack^.previous_stack;
        FREE pmv$task_debug_mode.stack IN osv$task_private_heap^;
        pmv$task_debug_mode.stack := previous_stack;
        pmv$task_debug_mode.top_of_stack := pmc$max_elements_in_debug_stack;

        IF pmv$task_debug_mode.stack = NIL THEN
          clr_debug_in_callers_user_masks;
        IFEND;
      ELSE
        pmv$task_debug_mode.top_of_stack := pmv$task_debug_mode.top_of_stack - 1;
      IFEND;
    IFEND;

  PROCEND pmp$pop_task_debug_mode;
?? TITLE := '  [XDCL]  PMP$SET_TASK_DEBUG_MODE', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$set_task_debug_mode
    (    debug_mode: pmt$debug_mode;
     VAR status: ost$status);

*copy pmh$set_task_debug_mode

    status.normal := TRUE;

    IF pmv$task_debug_mode.stack = NIL THEN
      pmp$push_task_debug_mode (debug_mode, status);

    ELSEIF (debug_mode = pmc$debug_mode_off) AND (pmv$task_debug_mode.top_of_stack =
          pmc$min_elements_in_debug_stack) AND (pmv$task_debug_mode.stack^.previous_stack = NIL) THEN
      pmp$pop_task_debug_mode (status);

    ELSE
      IF debug_mode = pmc$debug_mode_on THEN
        pmp$load_debug_procedures (status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
      IFEND;

      pmv$task_debug_mode.stack^.element [pmv$task_debug_mode.top_of_stack] := debug_mode;
    IFEND;

  PROCEND pmp$set_task_debug_mode;
?? TITLE := '  [XDCL]  PMP$TASK_DEBUG_MODE_ON', EJECT ??

  FUNCTION [XDCL, #GATE] pmp$task_debug_mode_on: pmt$debug_mode;

*copy pmh$task_debug_mode_on

    IF pmv$task_debug_mode.stack = NIL THEN
      pmp$task_debug_mode_on := pmc$debug_mode_off;
    ELSE
      pmp$task_debug_mode_on := pmv$task_debug_mode.stack^.element [pmv$task_debug_mode.top_of_stack];
    IFEND;

  FUNCEND pmp$task_debug_mode_on;
?? TITLE := '    SET_DEBUG_IN_CALLERS_USER_MASKS', EJECT ??

  PROCEDURE set_debug_in_callers_user_masks;

    VAR
      psa: ^ost$stack_frame_save_area,
      save_area: ost$status;

    psa := #PREVIOUS_SAVE_AREA ();
    psa := psa^.minimum_save_area.a2_previous_save_area; {skip debug handler}
    REPEAT
      psa^.minimum_save_area.user_mask := psa^.minimum_save_area.user_mask + $ost$user_conditions [osc$debug];
      pmp$validate_previous_save_area (psa, save_area);
      psa := psa^.minimum_save_area.a2_previous_save_area;
    UNTIL (psa = NIL) OR (NOT save_area.normal);

  PROCEND set_debug_in_callers_user_masks;
?? TITLE := '    CLR_DEBUG_IN_CALLERS_USER_MASKS', EJECT ??

  PROCEDURE clr_debug_in_callers_user_masks;

    VAR
      psa: ^ost$stack_frame_save_area,
      save_area: ost$status;

    psa := #PREVIOUS_SAVE_AREA ();
    psa := psa^.minimum_save_area.a2_previous_save_area; {skip debug handler}
    REPEAT
      psa^.minimum_save_area.user_mask := psa^.minimum_save_area.user_mask - $ost$user_conditions [osc$debug];
      pmp$validate_previous_save_area (psa, save_area);
      psa := psa^.minimum_save_area.a2_previous_save_area;
    UNTIL (psa = NIL) OR (NOT save_area.normal);

  PROCEND clr_debug_in_callers_user_masks;
?? OLDTITLE ??
?? NEWTITLE := '    [XDCL]  PMP$ESTABLISH_DEBUG_OFF', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$establish_debug_cff
    (    critical_frame: ^ost$stack_frame_save_area;
     VAR status: ost$status);

*copy pmh$establish_debug_cff

    VAR
      os_stack_frame_word: ^pmt$os_stack_frame_word,
      psa: ^ost$stack_frame_save_area,
      save_area: ost$status;

    status.normal := TRUE;
    os_stack_frame_word := critical_frame^.minimum_save_area.a1_current_stack_frame;
    psa := #PREVIOUS_SAVE_AREA ();
    save_area.normal := TRUE;

    WHILE (psa <> NIL) AND (psa^.minimum_save_area.a1_current_stack_frame <>
          critical_frame^.minimum_save_area.a1_current_stack_frame) DO
      pmp$validate_previous_save_area (psa, save_area);
      IF NOT save_area.normal THEN
        osp$set_status_abnormal ('PM', pme$inconsistent_stack, '', status);
        RETURN; {----->
      IFEND;
      psa := psa^.minimum_save_area.a2_previous_save_area;
    WHILEND;

    IF psa <> NIL THEN
      IF NOT critical_frame^.minimum_save_area.frame_descriptor.on_condition_flag THEN
        critical_frame^.minimum_save_area.frame_descriptor.on_condition_flag := TRUE;
        os_stack_frame_word^ := initialize_os_stack_frame_word;
      IFEND;
      os_stack_frame_word^.debug_cff_frame := TRUE;
      critical_frame^.minimum_save_area.frame_descriptor.critical_frame_flag := TRUE;
    ELSE
      osp$set_status_abnormal ('PM', pme$stack_frame_not_found, '', status);
    IFEND;

  PROCEND pmp$establish_debug_cff;
?? TITLE := '    [XDCL]  PMP$DEBUG_CRITICAL_FRAME', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$debug_critical_frame
    (    stack_frame: ^ost$stack_frame_save_area;
     VAR critical_stack_frame: boolean);

*copy pmh$debug_critical_frame

    VAR
      os_stack_frame_word: ^pmt$os_stack_frame_word;

    os_stack_frame_word := stack_frame^.minimum_save_area.a1_current_stack_frame;
    critical_stack_frame := (stack_frame^.minimum_save_area.frame_descriptor.on_condition_flag AND
          os_stack_frame_word^.debug_cff_frame);
    os_stack_frame_word^.debug_cff_frame := FALSE;

  PROCEND pmp$debug_critical_frame;
?? OLDTITLE ??
?? TITLE := '  Debug Hardware Interfaces' ??
?? NEWTITLE := '    Global Declarations' ??
?? EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc osc$processor_defined_registers
*copyc ost$stack_frame_save_area
*copyc pmp$validate_previous_save_area
*copyc mmp$verify_access
?? POP ??

*copyc pmd$debug
*copyc ost$debug_list
*copyc pmt$debug_environment


  CONST
    pmc$minimum_debug_list_entry = 0,
    pmc$maximum_debug_list_entry = 31;


  TYPE
    pmt$range_of_next_free_index = pmc$minimum_debug_list_entry .. pmc$maximum_debug_list_entry + 1,

    pmt$debug_environment_stack = record
      environment: pmt$debug_environment,
      link: ^pmt$debug_environment_stack,
    recend,

    pmt$user_mask = set of 0 .. 63,

    pmt$debug_mask = packed record
      filler: packed array [0 .. 56] of boolean,
      mask: ost$debug_mask,
    recend,

    pmt$corresponding_index = record
      defined: boolean,
      index: pmt$debug_identifier,
      link: pmt$debug_identifier,
    recend;


  CONST
    debug_bit = 56;


  VAR
    converter: record
      case 0 .. 2 of
      = 0 =
        register: integer,
      = 1 =
        user_mask: pmt$user_mask,
      = 2 =
        debug_mask: pmt$debug_mask,
      casend,
    recend;


  VAR
    pmv$debug_list: [STATIC] ^ost$debug_list := NIL,
    pmv$debug_environment_stack: [STATIC] ^pmt$debug_environment_stack := NIL,
    pmv$debug_mask_codes: [STATIC] packed array [osc$data_read .. osc$call_instruction] of boolean :=
          [FALSE, FALSE, FALSE, FALSE, FALSE],

    next_free_index: [STATIC] pmt$range_of_next_free_index := 0,
    next_free_identifier: [STATIC] pmt$debug_identifier,
    last_identifier_used: [STATIC] pmt$debug_identifier,

    corresponding_id: [STATIC] ^array [pmt$debug_identifier] of pmt$debug_identifier,
    corresponding_index: [STATIC] ^array [pmt$debug_identifier] of pmt$corresponding_index,

    number_of_debug_codes_set: [STATIC] array [osc$data_read .. osc$call_instruction] of
          0 .. (pmc$maximum_debug_list_entry - pmc$minimum_debug_list_entry + 1) := [0, 0, 0, 0, 0];

?? TITLE := '    VERIFY_DEBUG_ADDRESSES' ??
?? EJECT ??

  PROCEDURE verify_debug_addresses
    (    debug_code: pmt$debug_codes;
         low_address: ^cell;
         high_address: ^cell;
     VAR status: ost$status);

    status.normal := TRUE;

    IF #SEGMENT (low_address) <> #SEGMENT (high_address) THEN
      osp$set_status_abnormal ('PM', pme$address_segments_not_equal, '', status);

    ELSEIF #OFFSET (low_address) > #OFFSET (high_address) THEN
      osp$set_status_abnormal ('PM', pme$low_addr_greater_than_high, '', status);

    ELSEIF debug_code = $pmt$debug_codes [] THEN
      osp$set_status_abnormal ('PM', pme$empty_debug_code, '', status);

    ELSE
      IF osc$data_read IN debug_code THEN
        IF NOT mmp$verify_access (^low_address, mmc$va_read) THEN
          osp$set_status_abnormal ('PM', pme$invalid_access, '', status);
          RETURN; {----->
        IFEND;
      IFEND;

      IF osc$data_write IN debug_code THEN
        IF NOT mmp$verify_access (^low_address, mmc$va_write) THEN
          osp$set_status_abnormal ('PM', pme$invalid_access, '', status);
          RETURN; {----->
        IFEND;
      IFEND;

      IF ($pmt$debug_codes [osc$instruction_fetch, osc$branching_instruction,
            osc$call_instruction] * debug_code) <> $pmt$debug_codes [] THEN
        IF NOT mmp$verify_access (^low_address, mmc$va_execute) THEN
          osp$set_status_abnormal ('PM', pme$invalid_access, '', status);
          RETURN; {----->
        IFEND;
      IFEND;
    IFEND;

  PROCEND verify_debug_addresses;
?? TITLE := '    INITIALIZE_DEBUG_LIST' ??
?? EJECT ??

  PROCEDURE initialize_debug_list;


    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          debug_list: ^ost$debug_list,
        = 1 =
          debug_list_register: 0 .. 0ffffffffffff(16),
        casend,
      recend,

      local_status: ost$status,
      i: pmt$debug_identifier,
      code: ost$debug_code;


    ALLOCATE corresponding_id IN osv$task_private_heap^;
    ALLOCATE corresponding_index IN osv$task_private_heap^;
    ALLOCATE pmv$debug_list IN osv$task_private_heap^;

    converter.debug_list := pmv$debug_list;
    #WRITE_REGISTER (osc$pr_debug_list_pointer, converter.debug_list_register);

    next_free_index := pmc$minimum_debug_list_entry;
    next_free_identifier := LOWERVALUE (pmt$debug_identifier);
    last_identifier_used := LOWERVALUE (pmt$debug_identifier); { could be anything}

    FOR i := LOWERVALUE (pmt$debug_identifier) TO UPPERVALUE (pmt$debug_identifier) DO
      FOR code := LOWERVALUE (ost$debug_code) TO UPPERVALUE (ost$debug_code) DO
        pmv$debug_list^ [i].debug_code [code] := FALSE;
      FOREND;
?? EJECT ??
      pmv$debug_list^ [i].debug_code [osc$end_of_list] := TRUE;
    FOREND;

    FOR i := LOWERVALUE (pmt$debug_identifier) TO UPPERVALUE (pmt$debug_identifier) - 1 DO
      corresponding_index^ [i].defined := FALSE;
      corresponding_index^ [i].link := i + 1;
    FOREND;
    corresponding_index^ [UPPERVALUE (pmt$debug_identifier)].defined := FALSE;
    corresponding_index^ [UPPERVALUE (pmt$debug_identifier)].link := LOWERVALUE (pmt$debug_identifier);


  PROCEND initialize_debug_list;
?? TITLE := '    [XDCL]  PMP$DEFINE_DEBUG_ENTRY' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$define_debug_entry
    (    debug_code: pmt$debug_codes;
         low_address: pmt$debug_low_address;
         high_address: pmt$debug_high_address;
     VAR debug_id: pmt$debug_identifier;
     VAR status: ost$status);

*copy pmh$define_debug_entry

    VAR
      local_status: ost$status,

      dc: osc$data_read .. osc$call_instruction,

      index: pmt$debug_identifier,
      temp: pmt$debug_identifier,

      stack_entry: ^pmt$debug_environment_stack;

{ initialization }
    status.normal := TRUE;
    local_status.normal := TRUE;

    converter.register := #READ_REGISTER (osc$pr_user_mask_reg);
    converter.user_mask := converter.user_mask - $pmt$user_mask [debug_bit];
    #WRITE_REGISTER (osc$pr_user_mask_reg, converter.register);

    verify_debug_addresses (debug_code, low_address, high_address, local_status);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN; {----->
    IFEND;

    IF pmv$debug_list = NIL THEN
      initialize_debug_list;

    ELSEIF next_free_index > pmc$maximum_debug_list_entry THEN
      osp$set_status_abnormal ('PM', pme$too_many_debug_list_entries, '', status);
      RETURN; {----->
    IFEND;

{ modify debug list }
    index := next_free_index;
    pmv$debug_list^ [index].seg := #SEGMENT (low_address);
    pmv$debug_list^ [index].low_bn := #OFFSET (low_address);
    pmv$debug_list^ [index].high_bn := #OFFSET (high_address);

    FOR dc := osc$data_read TO osc$call_instruction DO
      IF dc IN debug_code THEN
        pmv$debug_list^ [index].debug_code [dc] := TRUE;
        number_of_debug_codes_set [dc] := number_of_debug_codes_set [dc] + 1;
        pmv$debug_mask_codes [dc] := TRUE;
      ELSE
        pmv$debug_list^ [index].debug_code [dc] := FALSE;
      IFEND;
    FOREND;

    pmv$debug_list^ [index].debug_code [osc$end_of_list] := TRUE;
    IF index > pmc$minimum_debug_list_entry THEN
      pmv$debug_list^ [index - 1].debug_code [osc$end_of_list] := FALSE;
    IFEND;


{ modify corresponding index and identifier lists }
    debug_id := next_free_identifier;
    corresponding_id^ [index] := next_free_identifier;

    temp := corresponding_index^ [next_free_identifier].link;
    corresponding_index^ [next_free_identifier].defined := TRUE;
    corresponding_index^ [next_free_identifier].index := index;
    corresponding_index^ [next_free_identifier].link := last_identifier_used;
    last_identifier_used := next_free_identifier;

    next_free_identifier := temp;
    next_free_index := next_free_index + 1;

{ modify debug environment stack }
    converter.register := #READ_REGISTER (osc$pr_debug_mask_reg);
    converter.debug_mask.mask.codes := pmv$debug_mask_codes;
    #WRITE_REGISTER (osc$pr_debug_mask_reg, converter.register);

    IF pmv$debug_environment_stack <> NIL THEN
      stack_entry := pmv$debug_environment_stack;
      REPEAT
        IF stack_entry^.environment.debug_mask.end_of_list_seen_flag THEN
          stack_entry^.environment.debug_mask.end_of_list_seen_flag := FALSE;
          stack_entry^.environment.debug_mask.scan_in_progress := TRUE;
        IFEND;
        stack_entry := stack_entry^.link;
      UNTIL stack_entry = NIL;
    IFEND;

    set_debug_in_callers_user_masks;

  PROCEND pmp$define_debug_entry;
?? TITLE := '    [XDCL]  PMP$GET_DEBUG_ENTRY' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_debug_entry
    (    debug_id: pmt$debug_identifier;
     VAR debug_code: pmt$debug_codes;
     VAR low_address: pmt$debug_low_address;
     VAR high_address: pmt$debug_high_address;
     VAR status: ost$status);

*copy pmh$get_debug_entry

    VAR
      index: pmt$debug_identifier,
      dc: ost$debug_code,
      caller_id: ost$caller_identifier;

    #CALLER_ID (caller_id);
    status.normal := TRUE;

    IF ((((pmv$debug_list <> NIL) AND (debug_id >= LOWERVALUE (pmt$debug_identifier))) AND
          (debug_id <= UPPERVALUE (pmt$debug_identifier))) AND (corresponding_index^ [debug_id].defined)) THEN

      index := corresponding_index^ [debug_id].index;

      debug_code := $pmt$debug_codes [];
      FOR dc := osc$data_read TO osc$call_instruction DO
        IF pmv$debug_list^ [index].debug_code [dc] THEN
          debug_code := debug_code + $pmt$debug_codes [dc];
        IFEND;
      FOREND;

      low_address := #ADDRESS (caller_id.ring, pmv$debug_list^ [index].seg, pmv$debug_list^ [index].low_bn);
      high_address := #ADDRESS (caller_id.ring, pmv$debug_list^ [index].seg, pmv$debug_list^ [index].high_bn);
    ELSE
      osp$set_status_abnormal ('PM', pme$undefined_debug_id, '', status);
    IFEND;

  PROCEND pmp$get_debug_entry;
?? TITLE := '    [XDCL]  PMP$MODIFY_DEBUG_ENTRY' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$modify_debug_entry
    (    debug_id: pmt$debug_identifier;
         debug_code: pmt$debug_codes;
         low_address: pmt$debug_low_address;
         high_address: pmt$debug_high_address;
     VAR status: ost$status);

*copy pmh$modify_debug_entry

    VAR
      local_status: ost$status,

      index: pmt$debug_identifier,
      dc: ost$debug_code,

      stack_entry: ^pmt$debug_environment_stack;

    status.normal := TRUE;
    local_status.normal := TRUE;

    IF ((((pmv$debug_list <> NIL) AND (debug_id >= LOWERVALUE (pmt$debug_identifier))) AND
          (debug_id <= UPPERVALUE (pmt$debug_identifier))) AND (corresponding_index^ [debug_id].defined)) THEN

      verify_debug_addresses (debug_code, low_address, high_address, local_status);

      IF local_status.normal THEN
        index := corresponding_index^ [debug_id].index;

        pmv$debug_list^ [index].seg := #SEGMENT (low_address);
        pmv$debug_list^ [index].low_bn := #OFFSET (low_address);
        pmv$debug_list^ [index].high_bn := #OFFSET (high_address);

        FOR dc := osc$data_read TO osc$call_instruction DO
          IF dc IN debug_code THEN
            IF NOT pmv$debug_list^ [index].debug_code [dc] THEN
              pmv$debug_list^ [index].debug_code [dc] := TRUE;
              number_of_debug_codes_set [dc] := number_of_debug_codes_set [dc] + 1;
              pmv$debug_mask_codes [dc] := TRUE;
            IFEND;
          ELSE
            IF pmv$debug_list^ [index].debug_code [dc] THEN
              pmv$debug_list^ [index].debug_code [dc] := FALSE;
              number_of_debug_codes_set [dc] := number_of_debug_codes_set [dc] - 1;
              IF number_of_debug_codes_set [dc] = 0 THEN
                pmv$debug_mask_codes [dc] := FALSE;
              IFEND;
            IFEND;
          IFEND;
        FOREND;

        converter.register := #READ_REGISTER (osc$pr_debug_mask_reg);
        converter.debug_mask.mask.codes := pmv$debug_mask_codes;
        #WRITE_REGISTER (osc$pr_debug_mask_reg, converter.register);

      ELSE
        status := local_status;
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$undefined_debug_id, '', status);
    IFEND;

  PROCEND pmp$modify_debug_entry;
?? TITLE := '    [XDCL]  PMP$REMOVE_DEBUG_ENTRY' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$remove_debug_entry
    (    debug_id: pmt$debug_identifier;
     VAR status: ost$status);

*copy pmh$remove_debug_entry

    VAR
      index: pmt$debug_identifier,
      id: pmt$debug_identifier,
      last_id: pmt$debug_identifier,
      di: pmt$debug_identifier,
      dc: ost$debug_code,

      stack_entry: ^pmt$debug_environment_stack,
      debug_index: 0 .. 63;


    status.normal := TRUE;

    converter.register := #READ_REGISTER (osc$pr_user_mask_reg);
    converter.user_mask := converter.user_mask - $pmt$user_mask [debug_bit];
    #WRITE_REGISTER (osc$pr_user_mask_reg, converter.register);

    IF ((((pmv$debug_list <> NIL) AND (debug_id >= LOWERVALUE (pmt$debug_identifier))) AND
          (debug_id <= UPPERVALUE (pmt$debug_identifier))) AND (corresponding_index^ [debug_id].defined)) THEN

      index := corresponding_index^ [debug_id].index;

      FOR dc := osc$data_read TO osc$call_instruction DO
        IF pmv$debug_list^ [index].debug_code [dc] THEN
          number_of_debug_codes_set [dc] := number_of_debug_codes_set [dc] - 1;
          IF number_of_debug_codes_set [dc] = 0 THEN
            pmv$debug_mask_codes [dc] := FALSE;
          IFEND;
        IFEND;
      FOREND;

      next_free_index := next_free_index - 1;

      id := last_identifier_used;
      FOR di := index TO (next_free_index - 1) DO
        pmv$debug_list^ [di] := pmv$debug_list^ [di + 1];
        corresponding_id^ [di] := corresponding_id^ [di + 1];

        corresponding_index^ [id].index := corresponding_index^ [id].index - 1;
        last_id := id;
        id := corresponding_index^ [id].link;
      FOREND;

      FOR dc := osc$data_read TO osc$call_instruction DO
        pmv$debug_list^ [next_free_index].debug_code [dc] := FALSE;
      FOREND;

      IF next_free_index = LOWERVALUE (pmt$debug_identifier) THEN
        clr_debug_in_callers_user_masks;
      ELSE
        pmv$debug_list^ [next_free_index - 1].debug_code [osc$end_of_list] := TRUE;
      IFEND;

      IF debug_id = last_identifier_used THEN
        last_identifier_used := corresponding_index^ [debug_id].link;
      ELSE
        corresponding_index^ [last_id].link := corresponding_index^ [debug_id].link;
      IFEND;
      corresponding_index^ [debug_id].link := next_free_identifier;
      next_free_identifier := debug_id;
      corresponding_index^ [next_free_identifier].defined := FALSE;

      converter.register := #READ_REGISTER (osc$pr_debug_mask_reg);
      converter.debug_mask.mask.codes := pmv$debug_mask_codes;
      #WRITE_REGISTER (osc$pr_debug_mask_reg, converter.register);

      IF pmv$debug_environment_stack <> NIL THEN
        stack_entry := pmv$debug_environment_stack;
        debug_index := (2 * index) + 1;
        REPEAT
          IF stack_entry^.environment.debug_index >= debug_index THEN
            IF stack_entry^.environment.debug_index > 1 THEN
              stack_entry^.environment.debug_index := stack_entry^.environment.debug_index - 2;
            ELSE
              stack_entry^.environment.debug_index := 0;
              stack_entry^.environment.debug_mask.scan_in_progress := FALSE;
              stack_entry^.environment.debug_mask.end_of_list_seen_flag := FALSE;
            IFEND;
          IFEND;
          stack_entry := stack_entry^.link;
        UNTIL stack_entry = NIL;
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$undefined_debug_id, '', status);
    IFEND;

  PROCEND pmp$remove_debug_entry;
?? TITLE := '    [XDCL]  PMP$GET_DEBUG_ID' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_debug_id
    (    debug_index: 0 .. 63;
     VAR debug_id: pmt$debug_identifier;
     VAR status: ost$status);

*copy pmh$get_debug_id

    status.normal := TRUE;

    IF debug_index <= ((2 * (next_free_index - 1)) + 1) THEN
      debug_id := corresponding_id^ [debug_index DIV 2];
    ELSE
      osp$set_status_abnormal ('PM', pme$undefined_debug_index, '', status);
    IFEND;

  PROCEND pmp$get_debug_id;
?? TITLE := '    PMP$POST_DEBUG_ENVIRONMENT' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$post_debug_environment
    (    debug_environment: pmt$debug_environment);

*copy pmh$post_debug_environment

    VAR
      status: ost$status,
      stack_entry: ^pmt$debug_environment_stack;

    ALLOCATE stack_entry IN osv$task_private_heap^;

    stack_entry^.environment := debug_environment;
    stack_entry^.link := pmv$debug_environment_stack;
    pmv$debug_environment_stack := stack_entry;

  PROCEND pmp$post_debug_environment;
?? TITLE := '    PMP$GET_DEBUG_ENVIRONMENT' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_debug_environment
    (VAR debug_environment: pmt$debug_environment);

*copy pmh$get_debug_environment

    VAR
      stack_entry: ^pmt$debug_environment_stack;


    debug_environment := pmv$debug_environment_stack^.environment;
    debug_environment.debug_mask.codes := pmv$debug_mask_codes;

    stack_entry := pmv$debug_environment_stack;
    pmv$debug_environment_stack := pmv$debug_environment_stack^.link;
    FREE stack_entry IN osv$task_private_heap^;


  PROCEND pmp$get_debug_environment;
?? TITLE := '    [XDCL]  PMP$RESET_DEBUG_SCAN' ??
?? EJECT ??

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

*copy pmh$reset_debug_scan

    status.normal := TRUE;
    IF pmv$debug_environment_stack <> NIL THEN
      pmv$debug_environment_stack^.environment.debug_index := 0;
      pmv$debug_environment_stack^.environment.debug_mask.scan_in_progress := FALSE;
      pmv$debug_environment_stack^.environment.debug_mask.end_of_list_seen_flag := FALSE;
    IFEND;

  PROCEND pmp$reset_debug_scan;
?? TITLE := '  Debug Ring Handlers' ??
?? NEWTITLE := '    Global Declarations' ??
?? EJECT ??

*copyc osd$virtual_address

*copyc avp$ring_min
*copyc pmp$job_debug_ring

  VAR
    pmv$task_debug_ring: [STATIC, oss$task_private] ost$ring := 0;

*copyc pmv$job_debug_ring

?? TITLE := '    [XDCL]  PMP$SET_TASK_DEBUG_RING' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$set_task_debug_ring;

*copy pmh$set_task_debug_ring

    IF pmv$task_debug_ring = 0 THEN
      pmv$task_debug_ring := pmp$job_debug_ring ();
    IFEND;

  PROCEND pmp$set_task_debug_ring;
?? TITLE := '    [XDCL]  PMP$TASK_DEBUG_RING' ??
?? EJECT ??

  FUNCTION [XDCL, #GATE] pmp$task_debug_ring: ost$ring;

*copy pmh$task_debug_ring

    pmp$task_debug_ring := pmv$task_debug_ring;

  FUNCEND pmp$task_debug_ring;
?? TITLE := '    [XDCL]  PMP$SET_JOB_DEBUG_RING' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$set_job_debug_ring
    (    debug_ring: ost$ring;
     VAR status: ost$status);

*copy pmh$set_job_debug_ring

    VAR
      dummy_status: ost$status,
      ring: ost$string;

    status.normal := TRUE;

    IF debug_ring >= avp$ring_min () THEN
      IF debug_ring <= osc$max_ring THEN
        pmv$job_debug_ring := debug_ring;
      ELSE
        clp$convert_integer_to_string (debug_ring, 10, FALSE, ring, dummy_status);
        osp$set_status_abnormal ('PM', pme$invalid_ring_number, ring.value (1, ring.size), status);
      IFEND;
    ELSE
      clp$convert_integer_to_string (debug_ring, 10, FALSE, ring, dummy_status);
      osp$set_status_abnormal ('PM', pme$set_to_more_privileged_ring, ring.value (1, ring.size), status);
    IFEND;

  PROCEND pmp$set_job_debug_ring;
MODEND pmm$debug_stack_managers_13f;
