?? RIGHT := 110 ??
?? TITLE := 'NOS/VE System Core Debugger' ??
MODULE sym$debug;
{
{ PURPOSE:
{   This module contains the processors for all of the subcommands of the System Core Debugger utility except
{   DISPLAY_JOB_TABLES, which is located in the partner module SYM$DEBUG1.
{
{ NOTE:
{   Additions/deletions/changes to the commands and displays in this module and SYM$DEBUG1 may require an
{   update to the System Performance and Analysis Manual, Volume 2 (SPAM).
{
?? PUSH (LISTEXT := ON) ??
*copyc avv$security_options
*copyc amc$condition_code_limits
*copyc amt$file_byte_address
*copyc ame$lfn_program_actions
*copyc cle$ecc_lexical
*copyc dmt$error_condition_codes
*copyc dmt$active_volume_table_index
*copyc fme$file_management_errors
*copyc gft$file_descriptor_control
*copyc jmt$ijl_ordinal
*copyc jmt$initiated_job_list_entry
*copyc jmt$system_supplied_name
*copyc lgt$display_parameters
*copyc lot$loader_type_definitions
*copyc lot$task_services_entry_point
*copyc mmd$segment_access_condition
*copyc osc$processor_defined_registers
*copyc osc$purge_map_and_cache
*copyc osd$conditions
*copyc osd$integer_limits
*copyc osd$random_name
*copyc osd$registers
*copyc osd$virtual_address
*copyc osk$common_keypoint_definitions
*copyc osk$keypoint_class_codes
*copyc oss$job_fixed
*copyc oss$mainframe_pageable
*copyc oss$mainframe_paged_literal
*copyc ost$caller_identifier
*copyc ost$execution_control_block
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc pmd$system_log_interface
*copyc pme$logging_exceptions
*copyc pmt$processor_attributes
*copyc ptk$performance_keypoints
*copyc syt$debug_control
*copyc syt$debug_output_disposal_info
*copyc syt$debug_output_disposition
*copyc syt$user_defined_condition
*copyc syt$value_kinds
*copyc tmt$broken_task_monitor_fault
*copyc tmt$mcr_faults
*copyc tmt$rb_delay
*copyc tmt$rb_update_job_task_enviro
*copyc tmt$signal
*copyc tmt$signal_buffer
*copyc tmt$signal_buffers
?? POP ??
?? NEWTITLE := '  External procedures and variables referenced in this module', EJECT ??

*copyc clp$trimmed_string_size
*copyc dpp$change_window
*copyc dpp$get_next_line
*copyc dpp$get_number_lines_in_window
*copyc dpp$open_window
*copyc dpp$put_critical_message
*copyc dpp$put_next_line
*copyc gfp$get_fde_p
*copyc i#call_monitor
*copyc i#current_sequence_position
*copyc i#disable_traps
*copyc i#enable_traps
*copyc i#program_error
*copyc i#real_memory_address
*copyc i#restore_traps
*copyc jmp$find_jsn
*copyc lgp$add_entry_to_system_log
*copyc lgp$get_log_entry
*copyc lgp$get_log_read_information
*copyc mmp$get_segment_length_r1
*copyc mmp$open_file_by_sfid
*copyc mmp$close_device_file
*copyc mmp$free_pages
*copyc mmp$get_sdt_entry_p
*copyc mmp$get_sdtx_entry_p
*copyc ocp$find_debug_address
*copyc ocp$find_debug_entry_point
*copyc ocp$find_debug_module_item
*copyc osp$begin_text_dump
*copyc osp$clear_signature_lock
*copyc osp$end_text_dump
*copyc osp$output_debug_heading
*copyc osp$output_debug_text
*copyc osp$randomize_name
*copyc osp$set_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$simulate_disk_fault_r1
*copyc osp$test_signature_lock
*copyc pmp$get_legible_date_time
*copyc pmp$get_processor_attributes
*copyc pmp$get_os_version
*copyc pmp$find_executing_task_xcb
*copyc pmp$delay
*copyc syp$binary_to_ascii
*copyc syp$cause_condition
*copyc syp$crack_command
*copyc syp$jobfileproc
*copyc syp$process_command_line
*copyc syp$process_core_commands
*copyc syp$purge_instruction_stack
*copyc syp$establish_condition_handler
*copyc syp$test_job_recovery
*copyc dmv$active_volume_table
*copyc dmv$number_unavailable_volumes

  VAR
    gfv$fde_control_table_base: [XREF, oss$mainframe_wired] integer;

*copyc jmv$ajl_p
*copyc jmv$ijl_p
*copyc jmv$jcb
*copyc jmv$jmtr_xcb
*copyc jmv$max_ajl_ordinal_in_use

  VAR
    job_xcb_list: [XREF, oss$job_fixed] record
      head: ^ost$execution_control_block,
      lock: ost$signature_lock,
    recend;

*copyc mmv$tables_initialized
*copyc mtv$halt_cpu_ring_number
*copyc mtv$mx_ajl_entries
*copyc osv$dump_when_debug
*copyc osv$mainframe_pageable_heap
*copyc osv$mainframe_wired_heap
*copyc osv$job_fixed_heap
*copyc syv$all_jobs_selected_for_debug
*copyc syv$db_page_wait_lines_instance
*copyc syv$debug_control
*copyc syv$debug_output_disposition
*copyc syv$debugger_display_id
*copyc syv$dflt_debug_output_disposal
*copyc syv$inhibit_core_cmd_logging

  VAR
    syv$jfile_pdt: [XREF, READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor;

*copyc syv$nosve_job_template
*copyc syv$terminate_sysdebug_output
*copyc tmv$job_debug_ring
*copyc tmv$halt_on_hung_task
*copyc tmv$tables_initialized
?? OLDTITLE ??
?? NEWTITLE := '  CONST definitions for data structures used in this module', EJECT ??

  CONST
    add_to_eol = TRUE,
    dbc$max_auto_cmds = 20,
    dbc$max_auto_cmd_length = 30,
    dbc$maximum_defined_commands = 50,
    dbe$ = 900000;

?? OLDTITLE ??
?? NEWTITLE := '  TYPE definitions for data structures used in this module', EJECT ??

  TYPE
    auto_command = record
      command: string (dbc$max_auto_cmd_length),
      jobmntr_execution_only: boolean,
    recend,

    condition_names = record
      name: string (8),
      c_ord: debug_condition,
      ucr_ord: ost$user_condition,
    recend,

    condition_reg_image = packed record
      case 0 .. 1 of
      = 0 =
        ucr_a: packed array [ost$user_condition] of boolean,
        mcr_a: packed array [ost$monitor_condition] of boolean,
        ucm_a: packed array [ost$user_condition] of boolean,
      = 1 =
        ucr_i: 0 .. 0ffff(16),
        mcr_i: 0 .. 0ffff(16),
        ucm_i: 0 .. 0ffff(16),
      casend
    recend,

    debug_condition = (dc_read, dc_write, dc_rni, dc_branch, dc_call, dc_divflt, dc_aof, dc_exof, dc_exuf,
          dc_fplos, dc_fpindef, dc_alos, dc_invbdp),

    debug_list = record
      hdwr_entry: array [1 .. 32] of hdwr_section_entry,
      sfwr_entry: array [1 .. 32] of sfwr_section_entry,
      select_count: array [debug_condition] of integer,
      eol_index: 0 .. 32,
    recend,

    debug_list_pointer = record
      case 0 .. 2 of
      = 0 =
        int: integer,
      = 1 =
        fill1: 0 .. 0ffff(16),
        list_p: ^debug_list,
      = 2 =
        fill2: 0 .. 0ffff(16),
        cell_p: ^cell,
      casend
    recend,

    debug_mask = packed record
      case 0 .. 2 of
      = 0 =
        int: 0 .. 07f(16),
      = 1 =
        fill1: 0 .. 3,
        condition: packed array [dc_read .. dc_call] of boolean,
      = 2 =
        os_code: ost$debug_mask,
      casend
    recend,

    frame_descriptor = packed record
      critical_frame: boolean,
      on_condition: boolean,
      fill1,
      fill2: boolean,
      x_start: 0 .. 15,
      a_terminate: 0 .. 15,
      x_terminate: 0 .. 15,
    recend,

    gtid_converter = record
      case 0 .. 1 of
      = 0 =
        base: 0 .. 0fffff(16),
      = 1 =
        global_task_id: ost$global_task_id,
      casend,
    recend,

    hdwr_section_entry = packed record
      condition: packed array [dc_read .. dc_call] of boolean,
      eol: boolean,
      fill1: 0 .. 3,
      fill2: 0 .. 0fff(16),
      segment: 0 .. 0fff(16),
      lobyte: 0 .. 0ffffffff(16),
      fill3: 0 .. 0ffffffff(16),
      hibyte: 0 .. 0ffffffff(16),
    recend,

    debug_sfid_converter = record
      case boolean of
      = TRUE =
        int: 0 .. 0ffffffff(16),
      = FALSE =
        sfid: gft$system_file_identifier,
      casend,
    recend,

    sfwr_section_entry = record
      name: string (8),
      condition: packed array [debug_condition] of boolean,
      hscnt: 0 .. 7f(16),
      segment: 0 .. 0fff(16),
      lobyte: 0 .. 0ffffffff(16),
      fill2: 0 .. 0ffffffff(16),
      hibyte: 0 .. 0ffffffff(16),
    recend,

    stack_afield = packed record
      fill1: 0 .. 0ffff(16),
      pva: ost$pva,
    recend,

    stack_frame_areg_image = packed record
      p_reg: ost$p_register,
      reg: array [0 .. 0f(16)] of stack_afield,
    recend,

    stack_frame_control_image = packed record
      p_reg: ALIGNED ost$p_register,
      fill0: 0 .. 0f(16),
      vmid: 0 .. 0f(16),
      fill1: 0 .. 0ff(16),
      dsp: ALIGNED ^cell,
      frame_desc: frame_descriptor,
      csf: ALIGNED ^cell,
      user_condition_mask: packed array [ost$user_condition] of boolean,
      psa: ALIGNED ^cell,
      fill2: 0 .. 0ffff(16),
      bsp: ALIGNED ^cell,
      user_condition: packed array [ost$user_condition] of boolean,
      arg: ^cell,
      monitor_condition: packed array [ost$monitor_condition] of boolean,
      fill3: 0 .. 0ffffffffffff(16),
    recend,

    stack_frame_xreg_image = record
      p_reg: ost$p_register,
      reg: array [0 .. 32] of stack_xfield,
    recend,

    stack_image_pointer = record
      case 0 .. 4 of
      = 0 =
        control: ^stack_frame_control_image,
      = 1 =
        aregs: ^stack_frame_areg_image,
      = 2 =
        xregs: ^stack_frame_xreg_image,
      = 3 =
        cell_p: ^cell,
      = 4 =
        pva: ost$pva,
      casend
    recend,

    stack_xfield = record
      lhalf: 0 .. 0ffffffff(16),
      rhalf: 0 .. 0ffffffff(16),
    recend;

?? OLDTITLE ??
?? NEWTITLE := '  Global declarations declared in this module' ??
?? NEWTITLE := '    - Variables', EJECT ??

  VAR
    syv$db_displayed_console_lines: [XDCL] integer := 0,
    repress_headers_flag: boolean := FALSE,
    display_id: dpt$window_id := 0,
    est_flag: boolean := FALSE,
    last_dm_count: integer := 0,
    last_dm_pva: ^cell := NIL,
    monitor_faults: tmt$monitor_fault_buffer,
    nosve_template_ptr_array: ^array [1 .. * ] of ^cell := NIL,
    syv$debug_line_count: [XDCL] integer := 0,
    syv$debug_list: [STATIC, oss$mainframe_pageable] debug_list,
    syv$debug_output_disposal_info: [XDCL] syt$debug_output_disposal_info,
    syv$debugger_page_wait_lines: [XDCL] integer := 0,
    syv$debugger_task_timeout: boolean := FALSE,
    syv$dump_to_pf: [XDCL] boolean := FALSE,
    syv$job_template_ptr_array: [XDCL, oss$job_fixed] ^array [1 .. * ] of ^cell := NIL,
    syv$max_debug_output_lines: [XDCL] integer := 10000,
    syv$repeatable_command_p: [XDCL] ^string ( * ) := NIL;

?? OLDTITLE ??
?? NEWTITLE := '    - Conversion tables ', EJECT ??

{ The following translation table is used to translate the TYPE boolean into displayable strings.

  VAR
    boolean_translations: [READ, oss$mainframe_paged_literal] array [boolean] of string (5) := ['FALSE',
          'TRUE '];

  VAR
    cond_conv_tbl: [READ, oss$mainframe_paged_literal] array [debug_condition] of condition_names := [
{   } ['READ    ', dc_read, osc$debug],
{   } ['WRITE   ', dc_write, osc$debug],
{   } ['RNI     ', dc_rni, osc$debug],
{   } ['BRANCH  ', dc_branch, osc$debug],
{   } ['CALL    ', dc_call, osc$debug],
{   } ['DIVFLT  ', dc_divflt, osc$divide_fault],
{   } ['AROVFL  ', dc_aof, osc$arithmetic_overflow],
{   } ['EXOVFL  ', dc_exof, osc$exponent_overflow],
{   } ['EXUNFL  ', dc_exuf, osc$exponent_underflow],
{   } ['FPLOS   ', dc_fplos, osc$fp_significance_loss],
{   } ['FPINDEF ', dc_fpindef, osc$fp_indefinite],
{   } ['ARLOS   ', dc_alos, osc$arithmetic_significance],
{   } ['INVBDP  ', dc_invbdp, osc$invalid_bdp_data]],

    cond_conv_tbl2: [READ, oss$mainframe_paged_literal] array [osc$divide_fault .. osc$invalid_bdp_data] of
          condition_names := [
{   } ['divflt  ', dc_divflt, osc$divide_fault],
{   } ['debug   ', * , osc$debug],
{   } ['arovfl  ', dc_aof, osc$arithmetic_overflow],
{   } ['exovfl  ', dc_exof, osc$exponent_overflow],
{   } ['exunfl  ', dc_exuf, osc$exponent_underflow],
{   } ['fplos   ', dc_fplos, osc$fp_significance_loss],
{   } ['fpindef ', dc_fpindef, osc$fp_indefinite],
{   } ['arlos   ', dc_alos, osc$arithmetic_significance],
{   } ['invbdp  ', dc_invbdp, osc$invalid_bdp_data]];

?? OLDTITLE ??
?? NEWTITLE := '    - Commands and their parameter_descriptor_tables', EJECT ??

  VAR

{ The following list of commands are executed when the AUTO procedure is called.

    auto_cmds: array [1 .. dbc$max_auto_cmds] of auto_command := [
{   } ['DISECB', FALSE],
{   } ['DISMF', FALSE],
{   } ['DISAJL', TRUE],
{   } ['DISIJLE', TRUE],
{   } ['DISTE', TRUE],
{   } ['DISSE', FALSE],
{   } ['DISJL ALL', TRUE],
{   } ['DISM 00300000000 1000000(16)', TRUE],
{   } ['DISM 00400000000 1000000(16)', TRUE],
{   } ['DISM 00500000000 1000000(16)', FALSE],
{   } ['DISM 00600000000 1000000(16)', TRUE],
{   } ['DISTB 1 1000', FALSE],
{   } ['DISFDT', FALSE],
{   } REP dbc$max_auto_cmds - 13 of ['    ', FALSE]],

    command_table: [READ, oss$mainframe_paged_literal] array [1 .. (2 * dbc$maximum_defined_commands) + 1] of
          syt$command_table_entry := [

{ New command order and aliases:

{   } ['AUTO    ', 'AUTO                           ', FALSE, ^xqtautoproc],
{   } ['CHAB    ', 'CHANGE_BREAKPOINT              ', FALSE, ^mod_breakpoint],
{   } ['CHAM    ', 'CHANGE_MEMORY                  ', TRUE, ^cmproc],
{   } ['DISACL  ', 'DISPLAY_AUTO_COMMAND_LIST      ', TRUE, ^disdclproc],
{   } ['DISAJL  ', 'DISPLAY_ACTIVE_JOB_LIST        ', TRUE, ^disajlproc],
{   } ['DISC    ', 'DISPLAY_CALLS                  ', TRUE, ^trace_back],
{   } ['DISEST  ', 'DISPLAY_ENTIRE_SEGMENT_TABLE   ', TRUE, ^disestproc],
{   } ['DISECB  ', 'DISPLAY_EXECUTION_CONTROL_BLOCK', TRUE, ^disxcbproc],
{   } ['DISFDC  ', 'DISPLAY_FILE_DESCRIPTOR_CONTROL', TRUE, ^disfdc_proc],
{   } ['DISFDT  ', 'DISPLAY_FILE_DESCRIPTOR_TABLE  ', TRUE, ^disfdt_proc],
{   } ['DISIJLE ', 'DISPLAY_INITIATED_JOB_LIST_ENT ', TRUE, ^disijlproc],
{   } ['DISJL   ', 'DISPLAY_JOB_LOG                ', TRUE, ^disjlproc],
{   } ['DISJT   ', 'DISPLAY_JOB_TABLES             ', TRUE, ^syp$jobfileproc],
{   } ['DISM    ', 'DISPLAY_MEMORY                 ', TRUE, ^dmproc],
{   } ['DISMF   ', 'DISPLAY_MONITOR_FAULT          ', TRUE, ^dismfproc],
{   } ['DISOSA  ', 'DISPLAY_OS_ADDRESS             ', TRUE, ^disosaproc],
{   } ['DISOSS  ', 'DISPLAY_OS_SYMBOL              ', TRUE, ^disostproc],
{   } ['DISR    ', 'DISPLAY_REGISTER               ', TRUE, ^reg_display],
{   } ['DISST   ', 'DISPLAY_SEGMENT_TABLE          ', TRUE, ^disstproc],
{   } ['DISSTE  ', 'DISPLAY_SEGMENT_TABLE_EXTENDED ', TRUE, ^disstxproc],
{   } ['DISSE   ', 'DISPLAY_STACK_ENVIRONMENT      ', TRUE, ^disseproc],
{   } ['DISSF   ', 'DISPLAY_STACK_FRAME            ', TRUE, ^stack_display],
{   } ['DISSFID ', 'DISPLAY_SYSTEM_FILE_ID         ', TRUE, ^dissfid_proc],
{   } ['DISSL   ', 'DISPLAY_SYSTEM_LOG             ', TRUE, ^disslproc],
{   } ['DISTE   ', 'DISPLAY_TASK_ENVIRONMENT       ', TRUE, ^disteproc],
{   } ['DISTB   ', 'DISPLAY_TRACE_BACK             ', TRUE, ^trace_back],
{   } ['DOWV    ', 'DOWN_VOLUME                    ', FALSE, ^down_volume],
{   } ['HANT    ', 'HANG_TASK                      ', FALSE, ^hangproc],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['KILT    ', 'KILL_TASK                      ', FALSE, ^kill_task_proc],
{   } ['LISB    ', 'LIST_BREAKPOINTS               ', TRUE, ^list_breakpoints],
{   } ['-       ', 'M                              ', FALSE, ^minusproc],
{   } ['+       ', 'P                              ', FALSE, ^plusproc],
{   } ['REMB    ', 'REMOVE_BREAKPOINT              ', FALSE, ^remove_breakpoint],
{   } ['R       ', 'REPEAT                         ', FALSE, ^repeat_proc],
{   } ['SEL     ', 'SELECT                         ', FALSE, ^select_command],
{   } ['SETA    ', 'SET_AUTO_CMD_LIST              ', FALSE, ^setdclproc],
{   } ['SETB    ', 'SET_BREAKPOINT                 ', FALSE, ^set_breakpoint],
{   } ['SETMSF  ', 'SET_MASS_STORAGE_FAULT         ', FALSE, ^setmsf_proc],
{   } ['SETOD   ', 'SET_OUTPUT_DESTINATION         ', FALSE, ^setod_proc],
{   } ['SETPW   ', 'SET_PAGE_WAIT                  ', FALSE, ^setpw_proc],
{   } ['SUPCM   ', 'SUPER_CHANGE_MEMORY            ', TRUE, ^scmproc],
{   } ['TESJR   ', 'TEST_JOB_RECOVERY              ', FALSE, ^syp$test_job_recovery],
{   } ['UPV     ', 'UP_VOLUME                      ', FALSE, ^up_volume],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['HELP    ', 'HELP_FUNCTION                  ', FALSE, ^helpproc],

{ Old command order and aliases (will be deleted in the near future):

{   } ['LB      ', 'LIST_BREAKPOINTS               ', TRUE, ^list_breakpoints],
{   } ['B       ', 'SET_BREAKPOINT                 ', FALSE, ^set_breakpoint],
{   } ['RB      ', 'REMOVE_BREAKPOINT              ', FALSE, ^remove_breakpoint],
{   } ['CB      ', 'CHANGE_BREAKPOINT              ', FALSE, ^mod_breakpoint],
{   } ['DSF     ', 'DISPLAY_STACK_FRAME            ', TRUE, ^stack_display],
{   } ['TB      ', 'TRACE_BACK                     ', TRUE, ^trace_back],
{   } ['DR      ', 'DISPLAY_REGISTER               ', TRUE, ^reg_display],
{   } ['DM      ', 'DISM                           ', TRUE, ^dmproc],
{   } ['CM      ', 'CHAM                           ', TRUE, ^cmproc],
{   } ['SEL     ', 'SELECT                         ', FALSE, ^select_command],
{   } ['SCM     ', 'SUPER_CHANGE_MEMORY            ', TRUE, ^scmproc],
{   } ['DISTE   ', 'DISPLAY_TASK_ENVIRONMENT       ', TRUE, ^disteproc],
{   } ['DISOSS  ', 'DISPLAY_OS_SYMBOL              ', TRUE, ^disostproc],
{   } ['KILT    ', 'KILL_TASK                      ', FALSE, ^kill_task_proc],
{   } ['DISOSA  ', 'DISPLAY_OS_ADDRESS             ', TRUE, ^disosaproc],
{   } ['AUTO    ', 'AUTO                           ', FALSE, ^xqtautoproc],
{   } ['DISXCB  ', 'DISPLAY_XCB                    ', TRUE, ^disxcbproc],
{   } ['DISMF   ', 'DISPLAY_MONITOR_FAULT          ', TRUE, ^dismfproc],
{   } ['+       ', 'P                              ', FALSE, ^plusproc],
{   } ['-       ', 'M                              ', FALSE, ^minusproc],
{   } ['DISSL   ', 'DISPLAY_SYSTEM_LOG             ', TRUE, ^disslproc],
{   } ['DISSE   ', 'DISPLAY_STACK_ENVIRONMENT      ', TRUE, ^disseproc],
{   } ['HANG    ', 'HANG_TASK                      ', FALSE, ^hangproc],
{   } ['DISJL   ', 'DISPLAY_JOB_LOG                ', TRUE, ^disjlproc],
{   } ['DISJT   ', 'DISPLAY_JOB_TABLES             ', TRUE, ^syp$jobfileproc],
{   } ['DISIJL  ', 'DISPLAY_INITIATED_JOB_LIST     ', TRUE, ^disijlproc],
{   } ['DISST   ', 'DISPLAY_SEGMENT_TABLE          ', TRUE, ^disstproc],
{   } ['DISSTX  ', 'DISPLAY_SEGMENT_TABLE_EX       ', TRUE, ^disstxproc],
{   } ['DISEST  ', 'DISPLAY_ENTIRE_SEG_TABLE       ', TRUE, ^disestproc],
{   } ['TESTJR  ', 'TEST_JOB_RECOVERY              ', FALSE, ^syp$test_job_recovery],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['DISAJL  ', 'DISPLAY_ACTIVE_JOB_LIST        ', TRUE, ^disajlproc],
{   } ['R       ', 'REPEAT                         ', FALSE, ^repeat_proc],
{   } ['DOWN    ', 'DOWN_VOLUME                    ', FALSE, ^down_volume],
{   } ['UP      ', 'UP_VOLUME                      ', FALSE, ^up_volume],
{   } ['SETMSF  ', 'SET_MASS_STORAGE_FAULT         ', FALSE, ^setmsf_proc],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['dummy   ', 'dummy_not_used                 ', FALSE, NIL],
{   } ['HELP    ', 'HELP_FUNCTION                  ', FALSE, ^helpproc]],


    param_table: [READ, oss$mainframe_paged_literal] array [1 .. (2 * dbc$maximum_defined_commands) + 1] of
          ^array [ * ] of syt$parameter_descriptor := [

{ New commands and ^parameters:

{     'AUTO                           '} ^auto_pdt,
{     'CHANGE_BREAKPOINT              '} ^change_brkpt_pdt,
{     'CHANGE_MEMORY                  '} ^cm_pdt,
{     'DISPLAY_AUTO_COMMAND_LIST      '} ^disdcl_pdt,
{     'DISPLAY_ACTIVE_JOB_LIST        '} ^ajl_pdt,
{     'DISPLAY_CALLS                  '} ^trace_back_pdt,
{     'DISPLAY_ENTIRE_SEGMENT_TABLE   '} ^disest_pdt,
{     'DISPLAY_EXECUTION_CONTROL_BLOCK'} ^disecb_pdt,
{     'DISPLAY_FILE_DESCRIPTOR_CONTROL'} ^disfdc_pdt,
{     'DISPLAY_FILE_DESCRIPTOR_TABLE  '} ^disfdt_pdt,
{     'DISPLAY_INITIATED_JOB_LIST_ENT '} ^ijl_pdt,
{     'DISPLAY_JOB_LOG                '} ^display_log_pdt,
{     'DISPLAY_JOB_TABLES             '} ^syv$jfile_pdt,
{     'DISPLAY_MEMORY                 '} ^dm_pdt,
{     'DISPLAY_MONITOR_FAULT          '} NIL,
{     'DISPLAY_OS_ADDRESS             '} ^disosa_pdt,
{     'DISPLAY_OS_SYMBOL              '} ^disost_pdt,
{     'DISPLAY_REGISTER               '} ^display_reg_pdt,
{     'DISPLAY_SEGMENT_TABLE          '} ^sdt_pdt,
{     'DISPLAY_SEGMENT_TABLE_EXTENDED '} ^sdtx_pdt,
{     'DISPLAY_STACK_ENVIRONMENT      '} NIL,
{     'DISPLAY_STACK_FRAME            '} ^display_stk_pdt,
{     'DISPLAY_SYSTEM_FILE_ID         '} ^sfid_display_pdt,
{     'DISPLAY_SYSTEM_LOG             '} ^display_log_pdt,
{     'DISPLAY_TASK_ENVIRONMENT       '} NIL,
{     'DISPLAY_TRACE_BACK             '} ^trace_back_pdt,
{     'DOWN_VOLUME                    '} NIL,
{     'HANG_TASK                      '} NIL,
{     'INJECT_HARDWARE_FAULT_UTILITY  '} NIL,
{     'KILL_TASK                      '} ^kilt_pdt,
{     'LIST_BREAKPOINTS               '} ^display_brkpt_pdt,
{     'M                              '} NIL,
{     'P                              '} NIL,
{     'REMOVE_BREAKPOINT              '} ^remove_brkpt_pdt,
{     'REPEAT                         '} NIL,
{     'SELECT                         '} ^select_pdt,
{     'SET_AUTO_CMD_LIST              '} ^setdcl_pdt,
{     'SET_BREAKPOINT                 '} ^brkpt_pdt,
{     'SET_MASS_STORAGE_FAULT         '} ^setmsf_pdt,
{     'SET_OUTPUT_DESTINATION         '} ^setod_pdt,
{     'SUPER_CHANGE_MEMORY            '} ^cm_pdt,
{     'TEST_JOB_RECOVERY              '} NIL,
{     'UP_VOLUME                      '} NIL,
{     'SET_PAGE_WAIT                  '} ^setpw_pdt,
{     'dummy_not_used                 '} REP 7 of NIL,
{     'HELP_FUNCTION                  '} ^help_pdt,

{ Old commands and ^parameters (will be deleted in the near future):

{     'LIST_BREAKPOINTS               '} ^display_brkpt_pdt,
{     'SET_BREAKPOINT                 '} ^brkpt_pdt,
{     'REMOVE_BREAKPOINT              '} ^remove_brkpt_pdt,
{     'CHANGE_BREAKPOINT              '} ^change_brkpt_pdt,
{     'DISPLAY_STACK_FRAME            '} ^display_stk_pdt,
{     'TRACE_BACK                     '} ^trace_back_pdt,
{     'DISPLAY_REGISTER               '} ^display_reg_pdt,
{     'DISM                           '} ^dm_pdt,
{     'CHAM                           '} ^cm_pdt,
{     'SELECT                         '} ^select_pdt,
{     'SUPER_CHANGE_MEMORY            '} ^cm_pdt,
{     'DISPLAY_TASK_ENVIRONMENT       '} NIL,
{     'DISPLAY_OS_SYMBOL              '} ^disost_pdt,
{     'KILL_TASK                      '} ^kilt_pdt,
{     'DISPLAY_OS_ADDRESS             '} ^disosa_pdt,
{     'AUTO                           '} ^auto_pdt,
{     'DISPLAY_XCB                    '} NIL,
{     'DISPLAY_MONITOR_FAULT          '} NIL,
{     'P                              '} NIL,
{     'M                              '} NIL,
{     'DISPLAY_SYSTEM_LOG             '} ^display_log_pdt,
{     'DISPLAY_STACK_ENVIRONMENT      '} NIL,
{     'HANG_TASK                      '} NIL,
{     'DISPLAY_JOB_LOG                '} ^display_log_pdt,
{     'DISPLAY_JOB_TABLES             '} ^syv$jfile_pdt,
{     'DISPLAY_INITIATED_JOB_LIST     '} ^ijl_pdt,
{     'DISPLAY_SEGMENT_TABLE          '} ^sdt_pdt,
{     'DISPLAY_SEGMENT_TABLE_EX       '} ^sdtx_pdt,
{     'DISPLAY_ENTIRE_SEG_TABLE       '} NIL,
{     'TEST_JOB_RECOVERY              '} NIL,
{     'INJECT_HARDWARE_FAULT_UTILITY  '} NIL,
{     'DISPLAY_ACTIVE_JOB_LIST        '} ^ajl_pdt,
{     'REPEAT                         '} NIL,
{     'DOWN_VOLUME                    '} NIL,
{     'UP_VOLUME                      '} NIL,
{     'SET_MASS_STORAGE_FAULT         '} ^setmsf_pdt,
{     'dummy_not_used                 '} REP 12 of NIL,
{     'HELP_FUNCTION                  '} ^help_pdt];
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '  AUTOPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the AUTO command.  It is called from the AUTO command processor XQTAUTOPROC, as
{   part of DUMPJOB, or when "dump when debug" is TRUE.
{        DUMP_SEGMENTS_3_4_6: Boolean determines whether segments 3, 4, and 6 (job-mode) should be dumped.
{        DUMP_JOB_ENVIRONMENT: Boolean determines if this call results from a DUMPJOB command and puts out
{          the appropriate message to the result file.
{        STATUS: status variable
{

  PROCEDURE autoproc
    (    dump_segments_3_4_6: boolean;
         dump_job_environment: boolean;
     VAR status: ost$status);

    VAR
      i: integer,
      message: string (80),
      xcb_p: ^ost$execution_control_block;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    IF dump_job_environment THEN
      pmp$find_executing_task_xcb (xcb_p);
      message := 'DUMPJOB Dump of Job Task: ';
      message (28, * ) := xcb_p^.save9;
      syp$write_output_line (message, status);
    IFEND;

{ Disable core command logging.

    syv$inhibit_core_cmd_logging := TRUE;

    FOR i := 1 TO 20 DO
      syp$write_output_line ('  SYSTEM FAILURE ANALYSIS LISTING', status);
      IF NOT syv$nosve_job_template THEN
        syp$write_output_line ('  *** Alternate Job Template', status);
      IFEND;
    FOREND;

    i := 1;
    WHILE auto_cmds [i].command <> '   ' DO
      IF (NOT auto_cmds [i].jobmntr_execution_only) OR
            (auto_cmds [i].jobmntr_execution_only AND dump_segments_3_4_6) THEN
        sub_autoproc (i);
      IFEND;
      i := i + 1;
    WHILEND;

{ Re-enable core command logging.

    syv$inhibit_core_cmd_logging := FALSE;

  PROCEND autoproc;
?? OLDTITLE ??
?? NEWTITLE := '  CMPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the CHANGE_MEMORY command.  It changes the value of a specified location in
{ virtual memory.  The parameters for the command are as follows:
{        FBA: Required, pointer.
{          Specifies the virtual memory address (as a PVA or symbolic address) where the new value is entered
{          (this value is an 11-digit hexadecimal number addressing a specific byte of memory).
{        MV: Required, integer.
{          Specifies a number that replaces the bytes at the specified address.
{        BC: Optional, integer.
{          Specifies the number of consecutive bytes for which the new value is entered.  The default is 1.
{          The count can be a maximum of 8.
{


{ CHANGE_MEMORY, SUPER_CHANGE_MEMORY parameter descriptor table:

  VAR
    cm_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'address ', syc$pointer_value, NIL],
{   } [TRUE, 2, 'value   ', syc$integer_value, 1, 0, 0ffffffffffff(16)],
{   } [FALSE, 3, 'count   ', syc$integer_value, 1, 1, 8]];

  PROCEDURE cmproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ap: ^array [1 .. 8] of 0 .. 255,
      bc: 1 .. 8,
      i: 1 .. 8,
      mv: integer,
      pvt: array [1 .. 3] of syt$parameter_value,
      sl: integer,
      str: string (60);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (cm_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' CHANGE MEMORY ', text);
    IFEND;

    syp$verify_access (syc$writeable, #LOC (pvt [1].ptr), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    mv := pvt [2].int;
    bc := pvt [3].int;
    ap := pvt [1].ptr;
    get_segment_length (ap, sl);
    IF (#OFFSET (ap) + bc) >= sl THEN
      osp$set_status_abnormal ('DB', dbe$, 'address greater than file limit', status);
      RETURN;
    IFEND;
    FOR i := bc DOWNTO 1 DO
      ap^ [i] := mv MOD 256;
      mv := mv DIV 256;
    FOREND;
  PROCEND cmproc;
?? OLDTITLE ??
?? NEWTITLE := '  COND_ORD_TO_UCR_ORD', EJECT ??

{
{ Purpose:
{   This procedure converts a condition ordinal to a user_condition_register ordinal and returns a string
{   describing the condition ordinal.
{

  PROCEDURE cond_ord_to_ucr_ord
    (    cond_ord: debug_condition;
     VAR ucr_ord: ost$user_condition;
     VAR str: string (8));

    VAR
      i: debug_condition;

    i := dc_read;
    WHILE i <= dc_invbdp DO
      IF cond_conv_tbl [i].c_ord = cond_ord THEN
        ucr_ord := cond_conv_tbl [i].ucr_ord;
        str (1, 8) := cond_conv_tbl [i].name (1, 8);
        RETURN;
      ELSE
        i := SUCC (i);
      IFEND;
    WHILEND;
    RETURN;
  PROCEND cond_ord_to_ucr_ord;
?? OLDTITLE ??
?? NEWTITLE := '  DEBUG_TRAP_PROCESSOR', EJECT ??

{
{ Purpose:
{   This procedure processes debugger traps due to breakpoints, etc.
{

  PROCEDURE debug_trap_processor;

    VAR
      contact_user: boolean,
      mes: string (60),
      sa_p: ^stack_frame_control_image,
      status: ost$status;

    sa_p := #PREVIOUS_SAVE_AREA ();

    generate_debug_trap_message (sa_p^.psa, contact_user, mes, status);
    IF NOT contact_user THEN
      RETURN;
    IFEND;

    process_commands (sa_p^.psa, 'Trap in ', mes, FALSE, status);


  PROCEND debug_trap_processor;
?? OLDTITLE ??
?? NEWTITLE := '  DISAJLPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_ACTIVE_JOB_LIST command.  The parameters for the command are as
{   follows:
{        NUMBER: Optional, integer.
{          Specifies the AJL ordinal of the entry which is to be displayed.
{        NAME: Optional, name.
{          Specifies the system_supplied_name of the entry which is to be displayed, or the keyword ALL which
{          displays all AJL entries.
{


{ DISPLAY_ACTIVE_JOB_LIST parameter descriptor table:

  VAR
    ajl_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'number  ', syc$integer_value, -1, -1, 5000],
{   } [FALSE, 2, 'name    ', syc$name_value, * ]];

  PROCEDURE disajlproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ajlp: ^jmt$active_job_list_entry,
      i: integer,
      ijle_p: ^jmt$initiated_job_list_entry,
      len: integer,
      msg: string (128),
      pvt: array [1 .. 2] of syt$parameter_value,
      str: string (60);

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (ajl_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY ACTIVE JOB LIST ENTRY ', text);
    IFEND;

    IF (pvt [1].int = -1) AND (NOT pvt [2].defined) THEN
      ijle_p := jmv$jcb.ijle_p;
      pvt [1].int := ijle_p^.ajl_ordinal;
    IFEND;

  /ajl_loop/
    FOR i := LOWERBOUND (jmv$ajl_p^) TO jmv$max_ajl_ordinal_in_use DO
      IF (jmv$ajl_p^ [i].in_use = 0) THEN
        CYCLE /ajl_loop/;
      IFEND;
      IF ((pvt [2].name = 'ALL') OR (pvt [1].int = i)) THEN
        msg := '   ';
        str := '   ';
        syp$write_output_line (msg, status);
        ajlp := ^jmv$ajl_p^ [i];
        STRINGREP (str, len, i);
        msg := ' active job list entry ';
        msg (26, * ) := str;
        syp$write_output_line (msg, status);
      IFEND;
    FOREND /ajl_loop/;

  PROCEND disajlproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISESTPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_ENTIRE_SEGMENT_TABLE command.  This procedure displays all entries
{   in both the segment_descriptor and segment_descriptor_extended tables.  The parameter for the command is
{   as follows:
{        GTID: Optional, integer.
{          Specifies the global_task_id of the task whose segment tables are to be displayed.  Use of this
{          value will display the tables of the task with the corresponding GTID.  If this parameter is not
{          specified the debugger will display the tables of the task which is currently in the debugger.
{


{ DISPLAY_ENTIRE_SEGMENT_TABLE parameter descriptor table:

  VAR
    disest_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'gtid    ', syc$integer_value, 0, 0, 0fffff(16)]];

  PROCEDURE disestproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      gtid: gtid_converter,
      gtid_found: boolean,
      l: integer,
      msg: string (70),
      pvt: array [1 .. 1] of syt$parameter_value,
      s1: string (60),
      s2: string (60),
      segnum: integer,
      str: string (60),
      xcb_p: ^ost$execution_control_block;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (disest_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY ENTIRE SEGMENT TABLE ', text);
    IFEND;

    gtid_found := FALSE;
    IF pvt [1].defined AND (pvt [1].int <> 0) THEN
      gtid.base := pvt [1].int;
      xcb_p := job_xcb_list.head;
      WHILE (xcb_p <> NIL) AND (NOT gtid_found) DO
        IF xcb_p^.global_task_id = gtid.global_task_id THEN
          gtid_found := TRUE;
        ELSE
          xcb_p := xcb_p^.link;
        IFEND;
      WHILEND;
      IF NOT gtid_found THEN
        syp$write_output_line ('ERROR - Task with specified GTID was not found.', status);
        RETURN;
      IFEND;
    ELSE
      pmp$find_executing_task_xcb (xcb_p);
    IFEND;

    est_flag := TRUE;

    FOR segnum := 0 TO (xcb_p^.xp.segment_table_length) DO
      s1 := '        ';
      IF gtid_found THEN
        msg := ' Segment Table and Segment Table Extended entries for alternate task: ';
        syp$write_output_line (msg, status);
        msg := ' ';
        msg (4, * ) := xcb_p^.save9;
        syp$write_output_line (msg, status);
        msg := ' ';
        syp$write_output_line (msg, status);
        s2 := '     ';
        STRINGREP (s2, l, gtid.base: #(16), '(16)');
        s2 (1) := '0';
        STRINGREP (s1, l, segnum);
        s1 (l + 2, * ) := s2;
      ELSE
        STRINGREP (s1, l, segnum);
      IFEND;

      disstproc (s1, id, status);
      status.normal := TRUE;
      disstxproc (s1, id, status);
      status.normal := TRUE;
      IF syv$dump_to_pf AND (segnum <> (xcb_p^.xp.segment_table_length)) THEN
        syp$write_output_header (str, '');
      IFEND;
    FOREND;
    est_flag := FALSE;

  PROCEND disestproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISFDC_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_FILE_DESCRIPTOR_CONTROL command.  This procedure displays the file
{ descriptor control table determined by the parameter 'residence'.  The procedure checks to see if the table
{ is in real memory before attempting to display it.  The parameter for the command is:
{        RESIDENCE: Optional, name.
{          Specifies the residence of the file descriptor control table to be displayed.  The following
{          keywords can be specified (the default is JOB):
{            JOB
{            Displays the file descriptor control table of the job currently in memory.
{            SYSTEM
{            Displays the file descriptor control table of the system file descriptor table.
{

{ DISPLAY_FILE_DESCRIPTOR_CONTROL parameter descriptor table:

  VAR
    disfdc_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'residenc', syc$name_value, 'JOB']];

  PROCEDURE disfdc_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      done: boolean,
      end_of_fdc_p: ^cell,
      fdc_p: ^cell,
      i: integer,
      length: integer,
      pvt: array [1 .. 1] of syt$parameter_value,
      rma: integer,
      segment_number: ost$segment,
      str: string (60);


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syp$crack_command (disfdc_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY FILE DESCRIPTOR CONTROL', '');
    IFEND;

    IF pvt [1].name = 'JOB' THEN
      RETURN;
    IFEND;
    fdc_p := #ADDRESS (1, segment_number, gfc$fde_control_table_base);

{ Display only that portion of the FDC which is in memory.

    str := ' ';
    STRINGREP (str, length, ' FDC table: ', fdc_p:#(16), '(16)');
    i#real_memory_address (fdc_p, rma);
    IF rma < 0 THEN
      str (length + 1, *) := ' - Origin not in memory';
      syp$write_output_line (str, status);
      repress_headers_flag := FALSE;
      RETURN;
    IFEND;

    end_of_fdc_p := #ADDRESS (1, segment_number, gfc$fde_control_table_base +
         (gfc$fde_table_base - gfc$fde_control_table_base) - 1);
    done := FALSE;
    WHILE (#OFFSET (end_of_fdc_p) > #OFFSET (fdc_p)) AND (NOT done) DO
      i#real_memory_address (end_of_fdc_p, rma);
      IF rma >= 0 THEN
        done := TRUE;
      ELSE
        end_of_fdc_p := #ADDRESS (1, segment_number, #OFFSET (end_of_fdc_p) - 2048);
      IFEND;
    WHILEND;
    IF NOT done THEN
      str (length + 1, *) := ' - Entirely absent from memory';
      syp$write_output_line (str, status);
      repress_headers_flag := FALSE;
      RETURN;
    IFEND;

{ Generate the command to display memory contents of the FDC.

    repress_headers_flag := TRUE;
    str := ' ';
    syp$convert_bytes (#LOC (fdc_p), #SIZE (fdc_p), str, FALSE);
    STRINGREP (str (15, 10), length, (#OFFSET (end_of_fdc_p) - #OFFSET (fdc_p)) + 1);
    dmproc (str, display_id, status);
    IF NOT status.normal THEN
      repress_headers_flag := FALSE;
      RETURN;
    IFEND;
    repress_headers_flag := FALSE;

  PROCEND disfdc_proc;
?? OLDTITLE ??
?? NEWTITLE := '  DISFDT_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_FILE_DESCRIPTOR_TABLE command.  This procedure displays the file
{ descriptor table determined by the parameter 'residence'.  The procedure checks to see if each FDE is in
{ real memory before attempting to display it.  The parameter for the command is:
{        RESIDENCE: Optional, name.
{          Specifies the residence of the file descriptor table to be displayed.  The following
{          keywords can be specified (the default is JOB):
{            JOB
{            Displays the file descriptor table of the job currently in memory.
{            SYSTEM
{            Displays the file descriptor table of the system file descriptor table.
{

{ DISPLAY_FILE_DESCRIPTOR_TABLE parameter descriptor table:

  VAR
    disfdt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'residenc', syc$name_value, 'JOB']];

  PROCEDURE disfdt_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      end_of_fde_p: gft$file_desc_entry_p,
      fde_p: gft$file_desc_entry_p,
      fdt_p: ^gft$file_descriptor_control,
      i: integer,
      length: integer,
      pvt: array [1 .. 1] of syt$parameter_value,
      rma: integer,
      segment_length: integer,
      segment_number: ost$segment,
      str: string (60);


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syp$crack_command (disfdt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY FILE DESCRIPTOR TABLE', '');
    IFEND;

    IF pvt [1].name = 'JOB' THEN
      segment_number := osc$segnum_job_fixed_heap;
    ELSEIF pvt [1].name = 'SYSTEM' THEN
      segment_number := osc$segnum_mainframe_wired;
    ELSE
      osp$set_status_abnormal ('DB', dbe$, 'invalid residence', status);
      RETURN;
    IFEND;
    repress_headers_flag := TRUE;

    fdt_p := #ADDRESS (1, segment_number, gfc$fde_control_table_base);
    get_segment_length (fdt_p, segment_length);
  /display_fdes/
    FOR i := 0 TO UPPERBOUND (fdt_p^.in_use_bits) DO

      fde_p := #ADDRESS (1, segment_number, gfc$fde_table_base + (i * gfc$fde_size));
      IF segment_length < (gfc$fde_table_base + (i * gfc$fde_size)) THEN
        syp$write_output_line ('Computed FDE address exceeds segment length', status);
        EXIT /display_fdes/;
      IFEND;

{ Make sure the entire FDE is in memory.

      str := ' ';
      STRINGREP (str, length, ' FDE index: ', i:#(16), '(16)');
      i#real_memory_address (fde_p, rma);
      IF rma < 0 THEN
        str (length + 1, *) := ' - Not in memory';
        syp$write_output_line (str, status);
        CYCLE /display_fdes/
      IFEND;
      end_of_fde_p := #ADDRESS (1, segment_number, gfc$fde_table_base + ((i+1)* gfc$fde_size) - 1);
      i#real_memory_address (end_of_fde_p, rma);
      IF rma < 0 THEN
        str (length + 1, *) := ' - Not entirely in memory';
        syp$write_output_line (str, status);
        CYCLE /display_fdes/
      IFEND;

{ Generate the command to display memory contents of the FDE.

      str := ' ';
      syp$convert_bytes (#LOC (fde_p), #SIZE (fde_p), str, FALSE);
      STRINGREP (str (15, 10), length, gfc$fde_size);
      dmproc (str, display_id, status);
      IF NOT status.normal THEN
        repress_headers_flag := FALSE;
        RETURN;
      IFEND;
    FOREND /display_fdes/;
    repress_headers_flag := FALSE;

  PROCEND disfdt_proc;
?? OLDTITLE ??
?? NEWTITLE := '  DISIJLPROC', EJECT ??
?? NEWTITLE := '    Swap_status Translation Table', EJECT ??

{ The following translation table is used to translate the TYPE jmt$ijl_swap_status into displayable strings.

  VAR
    swap_status_translations: [READ, oss$mainframe_paged_literal] array [jmt$ijl_swap_status] of
          string (27) := [
{ jmc$iss_null                    } 'iss null                   ',
{ jmc$iss_executing               } 'iss executing              ',
{ jmc$iss_idle_tasks_initiated    } 'iss idle tasks initiated   ',
{ jmc$iss_job_idle_tasks_complete } 'iss job idle tasks complete',
{ jmc$iss_swapped_no_io           } 'iss swapped no io          ',
{ jmc$iss_flush_am_pages          } 'iss flush am pages         ',
{ jmc$iss_job_allocate_swap_file  } 'iss job allocate swap file ',
{ jmc$iss_wait_allocate_swap_file } 'iss wait allocate swap file',
{ jmc$iss_allocate_swap_file      } 'iss allocate swap file     ',
{ jmc$iss_wait_job_io_complete    } 'iss wait job io complete   ',
{ jmc$iss_job_io_complete         } 'iss job io complete        ',
{ jmc$iss_wait_allocate_sfd       } 'iss wait allocate sfd      ',
{ jmc$iss_allocate_sfd            } 'iss allocate sfd           ',
{ jmc$iss_swapped_io_cannot_init  } 'iss swapped io cannot init ',
{ jmc$iss_initiate_swapout_io     } 'iss initiate swapout io    ',
{ jmc$iss_wait_swapout_io_init    } 'iss wait swapout io init   ',
{ jmc$iss_swapout_io_initiated    } 'iss swapout io initiated   ',
{ jmc$iss_swapout_io_complete     } 'iss swapout io complete    ',
{ jmc$iss_swapped_io_complete     } 'iss swapped io complete    ',
{ jmc$iss_free_swapped_memory     } 'iss free swapped memory    ',
{ jmc$iss_swapout_complete        } 'iss swapout complete       ',
{ jmc$iss_swapin_requested        } 'iss swapin requested       ',
{ jmc$iss_swapin_resource_claimed } 'iss swapin resource claimed',
{ jmc$iss_wait_swapin_io_init     } 'iss wait swapin io init    ',
{ jmc$iss_swapin_io_initiated     } 'iss swapin io initiated    ',
{ jmc$iss_swapin_io_complete      } 'iss swapin io complete     '];

?? OLDTITLE, EJECT ??
{
{ Purpose:
{   This procedure processes the DISPLAY_INITIATED_JOB_LIST_ENT command.  The parameter for the command is as
{ follows:
{        NAME: Optional, name.
{          Specifies the system_supplied_name of the job whose initiated_job_list_entry should be displayed.
{          If this parameter is not specified, the initiated_job_list_entry of the job containing the task
{          which is in the debugger will be displayed.
{


{ DISPLAY_INITIATED_JOB_LIST_ENT parameter descriptor table:

  VAR
    ijl_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'name    ', syc$name_value, * ]];

  PROCEDURE disijlproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      i: integer,
      ij: mmt$job_page_queue_index,
      ijle_p: ^jmt$initiated_job_list_entry,
      j: integer,
      msg: string (60),
      msg2: string (130),
      pvt: array [1 .. 1] of syt$parameter_value,
      size: integer,
      str: string (60);

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (ijl_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY INITIATED JOB LIST ENTRY ', text);
    IFEND;

  /find_name/
    BEGIN

      IF (NOT pvt [1].defined) THEN
        ijle_p := jmv$jcb.ijle_p;
        EXIT /find_name/;
      IFEND;

    /a20/
      FOR i := LOWERBOUND (jmv$ijl_p.block_p^) TO jmv$ijl_p.max_block_in_use DO
        IF jmv$ijl_p.block_p^ [i].index_p <> NIL THEN

        /a10/
          FOR j := LOWERVALUE (jmt$ijl_block_index) TO UPPERVALUE (jmt$ijl_block_index) DO
            IF (jmv$ijl_p.block_p^ [i].index_p^ [j].entry_status = jmc$ies_entry_free) THEN
              CYCLE /a10/;
            IFEND;
            IF (jmv$ijl_p.block_p^ [i].index_p^ [j].system_supplied_name = pvt [1].name) THEN
              ijle_p := ^jmv$ijl_p.block_p^ [i].index_p^ [j];
              EXIT /find_name/;
            IFEND;
          FOREND /a10/;

        IFEND;
      FOREND /a20/;

      osp$set_status_abnormal ('sy', dbe$, 'name not found', status);
      RETURN;

    END /find_name/;

    msg := 'system supplied name:';
    msg (23, * ) := ijle_p^.system_supplied_name;
    syp$write_output_line (msg, status);

    msg := 'job name:';
    msg (11, * ) := ijle_p^.job_name;
    syp$write_output_line (msg, status);

    msg := 'ijl entry status:';
    CASE ijle_p^.entry_status OF
    = jmc$ies_entry_free =
      msg (20, * ) := 'entry free';
    = jmc$ies_job_terminating =
      msg (20, * ) := 'job terminating';
    = jmc$ies_job_in_memory_non_swap =
      msg (20, * ) := 'job in memory non swap';
    = jmc$ies_job_in_memory =
      msg (20, * ) := 'job in memory';
    = jmc$ies_swapin_in_progress =
      msg (20, * ) := 'swapin in progress';
    = jmc$ies_job_swapped =
      msg (20, * ) := 'job swapped';
    = jmc$ies_operator_force_out =
      msg (20, * ) := 'operator force out';
    = jmc$ies_system_force_out =
      msg (20, * ) := 'system force out';
    = jmc$ies_job_damaged =
      msg (20, * ) := 'job damaged';
    = jmc$ies_ready_task =
      msg (20, * ) := 'ready task';
    = jmc$ies_swapin_candidate =
      msg (20, * ) := 'swapin candidate';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.entry_status), #SIZE (ijle_p^.entry_status), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'ajl ordinal:';
    syp$convert_bytes (#LOC (ijle_p^.ajl_ordinal), #SIZE (ijle_p^.ajl_ordinal), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'kjl ordinal:';
    syp$convert_bytes (#LOC (ijle_p^.kjl_ordinal), #SIZE (ijle_p^.kjl_ordinal), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'ijl swap status:';
    msg (20, * ) := swap_status_translations [ijle_p^.swap_status];
    syp$write_output_line (msg, status);

    msg := 'ijl next swap status:';
    msg (24, * ) := swap_status_translations [ijle_p^.next_swap_status];
    syp$write_output_line (msg, status);

    msg := 'ijl last swap status:';
    msg (24, * ) := swap_status_translations [ijle_p^.last_swap_status];
    syp$write_output_line (msg, status);

    msg := 'inhibit swap count:';
    syp$convert_bytes (#LOC (ijle_p^.inhibit_swap_count), #SIZE (ijle_p^.inhibit_swap_count),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'active io page count:';
    syp$convert_bytes (#LOC (ijle_p^.active_io_page_count), #SIZE (ijle_p^.active_io_page_count),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'active io requests:';
    syp$convert_bytes (#LOC (ijle_p^.active_io_requests), #SIZE (ijle_p^.active_io_requests),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'swap queue link:';
    syp$write_output_line (msg, status);
    msg := '  queue id:';
    CASE ijle_p^.swap_queue_link.queue_id OF
    = jsc$isqi_null =
      msg (14, * ) := 'isqi_null';
    = jsc$isqi_swapping =
      msg (14, * ) := 'isqi_swapping';
    = jsc$isqi_swapped_io_not_init =
      msg (14, * ) := 'isqi_swapped_io_not_init';
    = jsc$isqi_swapped_io_cannot_init =
      msg (14, * ) := 'isqi_swapped_io_cannot_init';
    = jsc$isqi_swapped_io_completed =
      msg (14, * ) := 'isqi_swapped_io_completed';
    = jsc$isqi_swapped_out =
      msg (14, * ) := 'isqi_swapped_out';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.swap_queue_link.queue_id), #SIZE (ijle_p^.swap_queue_link.queue_id),
            msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);
    msg := '  backward link: ';
    syp$convert_bytes (#LOC (ijle_p^.swap_queue_link.backward_link),
          #SIZE (ijle_p^.swap_queue_link.backward_link), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  forward link:';
    syp$convert_bytes (#LOC (ijle_p^.swap_queue_link.forward_link),
          #SIZE (ijle_p^.swap_queue_link.forward_link), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job fixed asid:';
    syp$convert_bytes (#LOC (ijle_p^.job_fixed_asid), #SIZE (ijle_p^.job_fixed_asid), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'long wait aging complete:';
    msg (28, * ) := boolean_translations [ijle_p^.long_wait_aging_complete];
    syp$write_output_line (msg, status);

    msg := 'notify swapper when io complete:';
    msg (35, * ) := boolean_translations [ijle_p^.notify_swapper_when_io_complete];
    syp$write_output_line (msg, status);

    msg := 'scheduling dispatching priority:';
    syp$convert_bytes (#LOC (ijle_p^.scheduling_dispatching_priority),
          #SIZE (ijle_p^.scheduling_dispatching_priority), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'dispatching control:';
    syp$write_output_line (msg, status);
    msg := '  dispatching control index';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.dispatching_control_index),
          #SIZE (ijle_p^.dispatching_control.dispatching_control_index), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  dispatching priority:';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.dispatching_priority),
          #SIZE (ijle_p^.dispatching_control.dispatching_priority), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  user requested dispatching priority:';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.user_requested_dispatching_prio),
          #SIZE (ijle_p^.dispatching_control.user_requested_dispatching_prio), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  operator set dispatching priority:';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.operator_set_dispatching_prio),
          #SIZE (ijle_p^.dispatching_control.operator_set_dispatching_prio), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  service remaining:';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.service_remaining),
          #SIZE (ijle_p^.dispatching_control.service_remaining), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  CP service at class switch:';
    syp$convert_bytes (#LOC (ijle_p^.dispatching_control.cp_service_at_class_switch),
          #SIZE (ijle_p^.dispatching_control.cp_service_at_class_switch), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job monitor task_id:';
    syp$convert_bytes (#LOC (ijle_p^.job_monitor_taskid), #SIZE (ijle_p^.job_monitor_taskid),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job mode:';
    CASE ijle_p^.job_mode OF
    = jmc$batch =
      msg (12, * ) := 'BATCH';
    = jmc$interactive_connected =
      msg (12, * ) := 'INTERACTIVE_CONNECTED';
    = jmc$interactive_cmnd_disconnect =
      msg (12, * ) := 'INTERACTIVE_CMND_DISCONNECT';
    = jmc$interactive_line_disconnect =
      msg (12, * ) := 'INTERACTIVE_LINE_DISCONNECT';
    = jmc$interactive_sys_disconnect =
      msg (12, * ) := 'INTERACTIVE_SYS_DISCONNECT';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.job_mode), #SIZE (ijle_p^.job_mode), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'executing task count:';
    syp$convert_bytes (#LOC (ijle_p^.executing_task_count), #SIZE (ijle_p^.executing_task_count),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'multiprocessing allowed:';
    msg (27, * ) := boolean_translations [ijle_p^.multiprocessing_allowed];
    syp$write_output_line (msg, status);

    msg := 'swapin candidate queue:';
    syp$convert_bytes (#LOC (ijle_p^.swapin_candidate_queue), #SIZE (ijle_p^.swapin_candidate_queue),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'estimated ready time:';
    syp$convert_bytes (#LOC (ijle_p^.estimated_ready_time), #SIZE (ijle_p^.estimated_ready_time),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'last think time:';
    syp$convert_bytes (#LOC (ijle_p^.last_think_time), #SIZE (ijle_p^.last_think_time), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'age purge timestamp:';
    syp$convert_bytes (#LOC (ijle_p^.age_purge_timestamp), #SIZE (ijle_p^.age_purge_timestamp),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'sfd purge timestamp:';
    syp$convert_bytes (#LOC (ijle_p^.sfd_purge_timestamp), #SIZE (ijle_p^.sfd_purge_timestamp),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job scheduler data:';
    syp$write_output_line (msg, status);
    msg := '  ready_task_link:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.ready_task_link),
          #SIZE (ijle_p^.job_scheduler_data.ready_task_link), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  service accumulator:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.service_accumulator),
          #SIZE (ijle_p^.job_scheduler_data.service_accumulator), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  service accumulator since swap:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.service_accumulator_since_swap),
          #SIZE (ijle_p^.job_scheduler_data.service_accumulator_since_swap), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  guaranteed service remaining:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.guaranteed_service_remaining),
          #SIZE (ijle_p^.job_scheduler_data.guaranteed_service_remaining), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  last cptime:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.last_cptime),
          #SIZE (ijle_p^.job_scheduler_data.last_cptime), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  last page fault count:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.last_page_fault_count),
          #SIZE (ijle_p^.job_scheduler_data.last_page_fault_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  job swap counts';
    syp$write_output_line (msg, status);
    msg := '    long wait:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.job_swap_counts.long_wait),
          #SIZE (ijle_p^.job_scheduler_data.job_swap_counts.long_wait), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    job mode:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.job_swap_counts.job_mode),
          #SIZE (ijle_p^.job_scheduler_data.job_swap_counts.job_mode), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  reason:';
    CASE ijle_p^.job_scheduler_data.swapout_reason OF
    = jmc$sr_null =
      msg (12, * ) := 'null';
    = jmc$sr_job_damaged =
      msg (12, * ) := 'job damaged';
    = jmc$sr_operator_request =
      msg (12, * ) := 'operator request';
    = jmc$sr_thrashing =
      msg (12, * ) := 'thrashing';
    = jmc$sr_lower_priority =
      msg (12, * ) := 'lower_priority';
    = jmc$sr_idling_system_swapout =
      msg (12, * ) := 'idling system swapout';
    = jmc$sr_long_wait =
      msg (12, * ) := 'long wait';
    = jmc$sr_memory_reserve_request =
      msg (12, * ) := 'memory reserve';
    = jmc$sr_idle_dispatching =
      msg (12, * ) := 'idle dispatching';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.swapout_reason),
            #SIZE (ijle_p^.job_scheduler_data.swapout_reason), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);
    msg := '  priority:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.priority),
          #SIZE (ijle_p^.job_scheduler_data.priority), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  unaged swap queue priority:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.unaged_swap_queue_priority),
          #SIZE (ijle_p^.job_scheduler_data.unaged_swap_queue_priority), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  swapin q priority timestamp:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.swapin_q_priority_timestamp),
          #SIZE (ijle_p^.job_scheduler_data.swapin_q_priority_timestamp), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  job class:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.job_class),
          #SIZE (ijle_p^.job_scheduler_data.job_class), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  service class:';
    syp$convert_bytes (#LOC (ijle_p^.job_scheduler_data.service_class),
          #SIZE (ijle_p^.job_scheduler_data.service_class), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job page queue list:';
    syp$write_output_line (msg, status);
    FOR ij := mmc$pq_job_fixed TO mmc$pq_job_working_set DO
      msg := '  ';
      STRINGREP (msg (3, * ), i, ij);
      msg (3) := '[';
      msg (6) := ']';
      syp$write_output_line (msg, status);
      msg := '    link.bkw:';
      syp$convert_bytes (#LOC (ijle_p^.job_page_queue_list [ij].link.bkw),
            #SIZE (ijle_p^.job_page_queue_list [ij].link.bkw), msg, add_to_eol);
      syp$write_output_line (msg, status);
      msg := '    link.fwd:';
      syp$convert_bytes (#LOC (ijle_p^.job_page_queue_list [ij].link.fwd),
            #SIZE (ijle_p^.job_page_queue_list [ij].link.fwd), msg, add_to_eol);
      syp$write_output_line (msg, status);
      msg := '    count:';
      syp$convert_bytes (#LOC (ijle_p^.job_page_queue_list [ij].count),
            #SIZE (ijle_p^.job_page_queue_list [ij].count), msg, add_to_eol);
      syp$write_output_line (msg, status);
    FOREND;

    msg := 'swap data:';
    syp$write_output_line (msg, status);
    msg := '  swap file sfid:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swap_file_sfid), #SIZE (ijle_p^.swap_data.swap_file_sfid),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  swapping io error:';
    msg (23, * ) := boolean_translations [(ijle_p^.swap_data.swapping_io_error <> ioc$no_error)];
    syp$write_output_line (msg, status);
    msg := '  swapped job page count:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_page_count),
          #SIZE (ijle_p^.swap_data.swapped_job_page_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  swap file length in pages:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swap_file_length_in_pages),
          #SIZE (ijle_p^.swap_data.swap_file_length_in_pages), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  asid reassigned timestamp:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.asid_reassigned_timestamp),
          #SIZE (ijle_p^.swap_data.asid_reassigned_timestamp), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  timestamp:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.timestamp), #SIZE (ijle_p^.swap_data.timestamp),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  reassigned job fixed asti:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.reassigned_job_fixed_asti),
          #SIZE (ijle_p^.swap_data.reassigned_job_fixed_asti), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  swapped job entry:';
    syp$write_output_line (msg, status);
    msg := '    available modified page count:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_entry.available_modified_page_count),
          #SIZE (ijle_p^.swap_data.swapped_job_entry.available_modified_page_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    job page queue count- job fixed:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_entry.job_page_queue_count [mmc$pq_job_fixed]),
          #SIZE (ijle_p^.swap_data.swapped_job_entry.job_page_queue_count [mmc$pq_job_fixed]), msg,
          add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    job page queue count- job io error:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_entry.job_page_queue_count [mmc$pq_job_io_error]),
          #SIZE (ijle_p^.swap_data.swapped_job_entry.job_page_queue_count [mmc$pq_job_io_error]), msg,
          add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    job page queue count- job working set:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_entry.
          job_page_queue_count [mmc$pq_job_working_set]), #SIZE (ijle_p^.swap_data.swapped_job_entry.
          job_page_queue_count [mmc$pq_job_working_set]), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    swap file descriptor page count:';
    syp$convert_bytes (#LOC (ijle_p^.swap_data.swapped_job_entry.swap_file_descriptor_page_count),
          #SIZE (ijle_p^.swap_data.swapped_job_entry.swap_file_descriptor_page_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'swap io control:';
    syp$write_output_line (msg, status);
    msg := '  spd index:';
    syp$convert_bytes (#LOC (ijle_p^.swap_io_control.spd_index), #SIZE (ijle_p^.swap_io_control.spd_index),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  next queue id:';
    syp$convert_bytes (#LOC (ijle_p^.swap_io_control.next_queue_id),
          #SIZE (ijle_p^.swap_io_control.next_queue_id), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  next pfti:';
    syp$convert_bytes (#LOC (ijle_p^.swap_io_control.next_pfti), #SIZE (ijle_p^.swap_io_control.next_pfti),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  stop pfti:';
    syp$convert_bytes (#LOC (ijle_p^.swap_io_control.stop_pfti), #SIZE (ijle_p^.swap_io_control.stop_pfti),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  swap file descriptor pfti:';
    syp$convert_bytes (#LOC (ijle_p^.swap_io_control.swap_file_descriptor_pfti),
          #SIZE (ijle_p^.swap_io_control.swap_file_descriptor_pfti), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'sfd_p:';
    syp$convert_bytes (#LOC (ijle_p^.sfd_p), #SIZE (ijle_p^.sfd_p), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'system breakpoint selected:';
    msg (30, * ) := boolean_translations [ijle_p^.system_breakpoint_selected];
    syp$write_output_line (msg, status);

    msg2 := 'delayed swapin work:    ';
    syp$write_output_line (msg2, status);
    msg2 := '';
    size := 25;
    IF (jmc$dsw_job_recovery IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 15) := 'job recovery';
      size := size + 15;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_update_debug_lists IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 25) := 'update debug lists';
      size := size + 25;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_update_keypoint_masks IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 25) := 'update keypoint masks';
      size := size + 25;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_job_asid_changed IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 15) := 'asid changed';
      size := size + 15;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_job_shared_asid_changed IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 25) := 'job shared asid changed';
      size := size + 25;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_update_job_task_enviro IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 28) := 'update job task enviroment';
      size := size + 28;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_recovery_swap_io_error IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 26) := 'recovery swapin io error';
      size := size + 26;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_update_server_files IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 22) := 'update server files';
      size := size + 22;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_adjust_cpu_selections IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 24) := 'adjust cpu selections';
      size := size + 24;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_io_error_while_swapped IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 25) := 'io error while swapped';
      size := size + 25;
    IFEND;
    IF size > 100 THEN
      size := 25;
      syp$write_output_line (msg2, status);
    IFEND;
    IF (jmc$dsw_unused_10 IN ijle_p^.delayed_swapin_work) OR
          (jmc$dsw_unused_11 IN ijle_p^.delayed_swapin_work) OR
          (jmc$dsw_unused_12 IN ijle_p^.delayed_swapin_work) OR
          (jmc$dsw_unused_13 IN ijle_p^.delayed_swapin_work) OR
          (jmc$dsw_unused_14 IN ijle_p^.delayed_swapin_work) OR
          (jmc$dsw_unused_15 IN ijle_p^.delayed_swapin_work) THEN
      msg2 (size, 27) := '"unused" field(s) in use';
      size := size + 27;
    IFEND;
    IF size <> 25 THEN
      syp$write_output_line (msg2, status);
    IFEND;

    msg := 'statistics:';
    syp$write_output_line (msg, status);
    msg := '  cp time:';
    syp$write_output_line (msg, status);
    msg := '    time spent in job mode:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.cp_time.time_spent_in_job_mode),
          #SIZE (ijle_p^.statistics.cp_time.time_spent_in_job_mode), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    time spent in mtr mode:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.cp_time.time_spent_in_mtr_mode),
          #SIZE (ijle_p^.statistics.cp_time.time_spent_in_mtr_mode), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  paging statistics:';
    syp$write_output_line (msg, status);
    msg := '    page in count:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.page_in_count),
          #SIZE (ijle_p^.statistics.paging_statistics.page_in_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    pages reclaimed from queue:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.pages_reclaimed_from_queue),
          #SIZE (ijle_p^.statistics.paging_statistics.pages_reclaimed_from_queue), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    new pages assigned:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.new_pages_assigned),
          #SIZE (ijle_p^.statistics.paging_statistics.new_pages_assigned), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    pages from server:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.pages_from_server),
          #SIZE (ijle_p^.statistics.paging_statistics.pages_from_server), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    page fault count:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.page_fault_count),
          #SIZE (ijle_p^.statistics.paging_statistics.page_fault_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    working set max used:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.working_set_max_used),
          #SIZE (ijle_p^.statistics.paging_statistics.working_set_max_used), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '    incremental max ws:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.paging_statistics.incremental_max_ws),
          #SIZE (ijle_p^.statistics.paging_statistics.incremental_max_ws), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := '  perm file space:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.perm_file_space), #SIZE (ijle_p^.statistics.perm_file_space),
          msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  temp file space:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.temp_file_space), #SIZE (ijle_p^.statistics.temp_file_space),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := '  ready task count:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.ready_task_count),
          #SIZE (ijle_p^.statistics.ready_task_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  tasks not in long wait:';
    syp$convert_bytes (#LOC (ijle_p^.statistics.tasks_not_in_long_wait),
          #SIZE (ijle_p^.statistics.tasks_not_in_long_wait), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'job-fixed contiguous pages:';
    syp$convert_bytes (#LOC (ijle_p^.job_fixed_contiguous_pages), #SIZE (ijle_p^.job_fixed_contiguous_pages),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'hung task in job:';
    msg (20, * ) := boolean_translations [ijle_p^.hung_task_in_job];
    syp$write_output_line (msg, status);

    msg := 'job damaged during recovery:';
    msg (31, * ) := boolean_translations [ijle_p^.job_damaged_during_recovery];
    syp$write_output_line (msg, status);

    msg := 'maxws aio slowdown display:';
    syp$convert_bytes (#LOC (ijle_p^.maxws_aio_slowdown_display), #SIZE (ijle_p^.maxws_aio_slowdown_display),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'unable to swap idle flag:';
    msg (28, * ) := boolean_translations [ijle_p^.unable_to_swap_idle_flag];
    syp$write_output_line (msg, status);

    msg := 'queue file info:';
    syp$write_output_line (msg, status);
    msg := '  job abort disposition:';
    CASE ijle_p^.queue_file_information.job_abort_disposition OF
    = jmc$restart_on_abort =
      msg (27, * ) := 'restart on abort';
    = jmc$terminate_on_abort =
      msg (27, * ) := 'terminate on abort';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.queue_file_information.job_abort_disposition),
            #SIZE (ijle_p^.queue_file_information.job_abort_disposition), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);
    msg := '  job recovery disposition:';
    CASE ijle_p^.queue_file_information.job_recovery_disposition OF
    = jmc$continue_on_recovery =
      msg (30, * ) := 'continue on recovery';
    = jmc$restart_on_recovery =
      msg (30, * ) := 'restart on recovery';
    = jmc$terminate_on_recovery =
      msg (30, * ) := 'terminate on recovery';
    ELSE
      syp$convert_bytes (#LOC (ijle_p^.queue_file_information.job_abort_disposition),
            #SIZE (ijle_p^.queue_file_information.job_abort_disposition), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);
    msg := '  input file location:';
    syp$convert_bytes (#LOC (ijle_p^.queue_file_information.input_file_location),
          #SIZE (ijle_p^.queue_file_information.input_file_location), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'relative_priority_enabled:';
    msg (29, * ) := boolean_translations [ijle_p^.relative_priority_enabled];
    syp$write_output_line (msg, status);

    msg := 'task created after last swap:';
    msg (32, * ) := boolean_translations [ijle_p^.task_created_after_last_swap];
    syp$write_output_line (msg, status);

    msg := 'active cartridge tape writes:';
    syp$convert_bytes (#LOC (ijle_p^.active_cart_tape_write), #SIZE (ijle_p^.active_cart_tape_write),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'override job working set max:';
    syp$convert_bytes (#LOC (ijle_p^.override_job_working_set_max),
          #SIZE (ijle_p^.override_job_working_set_max), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'lost IO count:';
    syp$convert_bytes (#LOC (ijle_p^.lost_io_count), #SIZE (ijle_p^.lost_io_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

  PROCEND disijlproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISJLPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_JOB_LOG command.  The parameter for the command is as follows:
{        ENTRIES: Optional, integer or keyword ALL.
{          Specifies the number of log entries to be displayed.  The default value for this parameter is 1000.
{

  PROCEDURE disjlproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      header_string: string (60),
      log_control_desc_p: ^lgt$log_control_descriptor,
      log_control_descriptors_p: ^array [pmt$logs] of ^lgt$log_control_descriptor;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY JOB LOG ', text);
    IFEND;

    IF (syv$job_template_ptr_array = NIL) OR (UPPERBOUND (syv$job_template_ptr_array^) < 1) THEN
      osp$set_status_abnormal ('DB', dbe$, 'not available', status);
      RETURN;
    IFEND;

    syp$verify_access (syc$readable, #LOC (syv$job_template_ptr_array^ [1]), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    log_control_descriptors_p := syv$job_template_ptr_array^ [1];
    log_control_desc_p := log_control_descriptors_p^ [pmc$job_log];

    display_log (text, log_control_desc_p, status);

  PROCEND disjlproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISMFPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_MONITOR_FAULT command.  There are no parameters for this command.
{

  PROCEDURE dismfproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      btmfp: ^tmt$broken_task_monitor_fault,
      i: integer,
      mcrfp: ^tmt$mcr_faults,
      mfp: ^ost$monitor_fault,
      msg: string (40),
      sacfp: ^mmt$segment_access_condition,
      str: string (60);


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY MONITOR FAULT ', text);
    IFEND;

    FOR i := 1 TO tmc$maximum_monitor_faults DO
      syp$write_output_line ('   ', status);
      mfp := #LOC (monitor_faults.buffer [i]);
      CASE mfp^.identifier OF
      = tmc$broken_task_fault_id =
        syp$write_output_line ('broken task monitor fault', status);
        btmfp := #LOC (mfp^.contents);
        CASE btmfp^.broken_task_condition OF
        = tmc$btc_system_error =
          syp$write_output_line ('system error', status);
          msg := 'p-reg:';
          syp$convert_bytes (#LOC (btmfp^.caller_p_register), #SIZE (btmfp^.caller_p_register),
                msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'status-ptr:';
          syp$convert_bytes (#LOC (btmfp^.status_p), #SIZE (btmfp^.status_p), msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'text-p:';
          syp$convert_bytes (#LOC (btmfp^.text_p), #SIZE (btmfp^.text_p), msg, add_to_eol);
          syp$write_output_line (msg, status);
        ELSE
          CASE btmfp^.broken_task_condition OF
          = tmc$btc_mntr_fault_buffer_full =
            syp$write_output_line ('mntr fault buffer full', status);
          = tmc$btc_mf_traps_disabled =
            syp$write_output_line ('mf traps disabled', status);
          = tmc$btc_invalid_a0 =
            syp$write_output_line ('invalid a0', status);
          = tmc$btc_invalid_p =
            syp$write_output_line ('invalid p', status);
          = tmc$btc_mcr_traps_disabled =
            syp$write_output_line ('mcr traps disabled', status);
          = tmc$btc_ucr_traps_disabled =
            syp$write_output_line ('ucr traps disabled', status);
          ELSE
            msg := 'unknown btc:';
            syp$convert_bytes (#LOC (btmfp^.broken_task_condition), #SIZE (btmfp^.broken_task_condition),
                  msg, add_to_eol);
            syp$write_output_line (msg, status);
          CASEND;
          msg := 'p-reg:';
          syp$convert_bytes (#LOC (btmfp^.p), #SIZE (btmfp^.p), msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'a0:';
          syp$convert_bytes (#LOC (btmfp^.a0), #SIZE (btmfp^.a0), msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'mcr:';
          syp$convert_bytes (#LOC (btmfp^.monitor_condition_register),
                #SIZE (btmfp^.monitor_condition_register), msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'ucr:';
          syp$convert_bytes (#LOC (btmfp^.user_condition_register), #SIZE (btmfp^.user_condition_register),
                msg, add_to_eol);
          syp$write_output_line (msg, status);
          msg := 'fault-id:';
          CASE btmfp^.monitor_fault_id OF
          = tmc$broken_task_fault_id =
            msg (11, * ) := 'broken task';
          = tmc$mcr_fault =
            msg (11, * ) := 'mcr fault';
          = tmc$unknown_system_req_fault =
            msg (11, * ) := 'unknown system req';
          ELSE
            syp$convert_bytes (#LOC (btmfp^.monitor_fault_id), #SIZE (btmfp^.monitor_fault_id),
                  msg, add_to_eol);
          CASEND;
          syp$write_output_line (msg, status);
        CASEND;
      = tmc$mcr_fault =
        mcrfp := #LOC (mfp^.contents);
        syp$write_output_line ('mcr fault', status);
        msg := 'mcr:';
        syp$convert_bytes (#LOC (mcrfp^.faults), #SIZE (mcrfp^.faults), msg, add_to_eol);
        syp$write_output_line (msg, status);
        msg := 'utp:';
        syp$convert_bytes (#LOC (mcrfp^.untranslatable_pointer), #SIZE (mcrfp^.untranslatable_pointer),
              msg, add_to_eol);
        syp$write_output_line (msg, status);
      = tmc$unknown_system_req_fault =
        syp$write_output_line ('unknown system request fault', status);
      = mmc$segment_fault_processor_id =
        sacfp := #LOC (mfp^.contents);
        syp$write_output_line ('segment access fault', status);
        msg := 'type: ';
        CASE sacfp^.identifier OF
        = mmc$sac_read_beyond_eoi =
          msg (7, * ) := 'read beyond eoi';
        = mmc$sac_read_write_beyond_msl =
          msg (7, * ) := 'read/write beyond msl';
        = mmc$sac_segment_access_error =
          msg (7, * ) := 'segment access error';
        = mmc$sac_key_lock_violation =
          msg (7, * ) := 'key lock violation';
        = mmc$sac_ring_violation =
          msg (7, * ) := 'ring violation';
        = mmc$sac_io_read_error =
          msg (7, * ) := 'io read error';
        = mmc$sac_no_append_permission =
          msg (7, * ) := 'no append permission';
        = mmc$sac_tape_system_failure =
          msg (7, * ) := 'tape system failure';
        = mmc$sac_file_server_terminated =
          msg (7, * ) := 'file server terminated';
        = mmc$sac_pf_space_limit_exceeded =
          msg (7, * ) := 'pf_space_limit_exceeded';
        = mmc$sac_tf_space_limit_exceeded =
          msg (7, * ) := 'tf_space_limit_exceeded';
        = mmc$sac_runaway_write =
          msg (7, * ) := 'runaway_write';
        ELSE
          syp$convert_bytes (#LOC (sacfp^.identifier), #SIZE (sacfp^.identifier), msg, add_to_eol);
        CASEND;
        syp$write_output_line (msg, status);
        msg := 'pva: ';
        syp$convert_bytes (#LOC (sacfp^.segment), #SIZE (sacfp^.segment), msg, add_to_eol);
        syp$write_output_line (msg, status);
      ELSE
        msg := 'unknown fault:';
        syp$convert_bytes (#LOC (mfp^.identifier), #SIZE (mfp^.identifier), msg, add_to_eol);
        syp$write_output_line (msg, status);
      CASEND;

      msg := ' p-register:';
      syp$convert_bytes (#LOC (mfp^.pva), #SIZE (mfp^.pva), msg, add_to_eol);
      syp$write_output_line (msg, status);
      msg := ' a0:';
      syp$convert_bytes (#LOC (mfp^.a0), #SIZE (mfp^.a0), msg, add_to_eol);
      syp$write_output_line (msg, status);
      msg := ' a1:';
      syp$convert_bytes (#LOC (mfp^.a1), #SIZE (mfp^.a1), msg, add_to_eol);
      syp$write_output_line (msg, status);
      msg := ' a2:';
      syp$convert_bytes (#LOC (mfp^.a2), #SIZE (mfp^.a2), msg, add_to_eol);
      syp$write_output_line (msg, status);
    FOREND;

  PROCEND dismfproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISOSAPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_OS_ADDRESS command.  The resulting display is a description of the
{   address in terms of a module name, section name, and an offset within that section.  The parameter for the
{   command is as follows:
{        ADDRESS: Required, pointer.
{          Specifies the process virtual address (PVA) for the operating system information to display.  (This
{          is an 11-digit hexadecimal number addressing a specific byte of memory.)
{


{ DISPLAY_OS_ADDRESS parameter descriptor table:

  VAR
    disosa_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'address ', syc$pointer_value, NIL]];

  PROCEDURE disosaproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      found: boolean,
      len: integer,
      mn: pmt$program_name,
      msg: string (60),
      ofs: ost$segment_offset,
      pvt: array [1 .. 3] of syt$parameter_value,
      sn: pmt$program_name,
      str: string (80);


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (disosa_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY OS ADDRESS ', text);
    IFEND;

    ocp$find_debug_address (#SEGMENT (pvt [1].ptr), #OFFSET (pvt [1].ptr), found, mn, sn, ofs, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF found THEN
      STRINGREP (str, len, ' M=', mn, ' S=', sn, ' O=', ofs: #(16));
      syp$write_output_line (str (1, len), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
  PROCEND disosaproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISOSTPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_OPERATING_SYSTEM_SYMBOL command.  The resulting display is a
{   description of the symbol in terms of a module name and an address (PVA).  The parameter for the command
{   is as follows:
{        EPNAME: Required, name.
{          Specifies the name of the operating system symbol for which the virtual address is to be displayed.
{          The symbol name is a 1- to 31-character name.
{


{ DISPLAY_OS_SYMBOL parameter descriptor table:

  VAR
    disost_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'name    ', syc$name_value, 'ZZZ']];

  PROCEDURE disostproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      found: boolean,
      ii: integer,
      index: integer,
      j: integer,
      kind: string (30),
      len: integer,
      mi: ^pmt$module_item,
      mn: pmt$program_name,
      msg: string (60),
      occur: pmt$number_of_debug_items,
      ofs: ost$segment_offset,
      post: ^^array [ * ] of lot$task_services_entry_point,
      pvt: array [1 .. 1] of syt$parameter_value,
      s: ost$segment,
      str: string (80);


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (disost_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY OS SYMBOL ', text);
    IFEND;

    ocp$find_debug_entry_point (pvt [1].name, found, mn, s, ofs, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF found THEN
      STRINGREP (str, len, ' M=', mn, ' S=', s: #(16), ' O=', ofs: #(16));
      syp$write_output_line (str (1, len), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      ocp$find_debug_module_item (pvt [1].name, 1, found, mi, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF found THEN
        FOR j := 0 TO mi^.identification.greatest_section_ordinal DO
          CASE mi^.section_item [j].kind OF
          = llc$code_section =
            kind := ' Code ';
          = llc$binding_section =
            kind := ' Binding ';
          = llc$working_storage_section =
            kind := ' Working storage  ';
          = llc$common_block =
            kind := ' Common block';
          = llc$extensible_working_storage =
            kind := ' Extensible working storage';
          = llc$extensible_common_block =
            kind := ' Extensible common block ';
          = llc$lts_reserved =
            kind := ' Lts reserved';
          ELSE
            kind := ' Kind not found ';
          CASEND;

          STRINGREP (str, len, ' S=', mi^.section_item [j].name, ' A=', mi^.section_item [j].
                address: 11: #(16), ' L=', mi^.section_item [j].length: 6: #(16), kind);
          syp$write_output_line (str (1, len), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, ' cant find symbol ', status);
      IFEND;
    IFEND;

  PROCEND disostproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISPLAY_LOG' ??

{ DISPLAY_JOB_LOG, DISPLAY_SYSTEM_LOG parameter descriptor tables:

  VAR
    display_log_int_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'entries ', syc$integer_value, 1000, 1, 7fffffff(16)]],

    display_log_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'entries ', syc$name_value, 'ALL']];

{ PURPOSE:
{   This procedure is the interface used by the DISPLAY_JOB_LOG and DISPLAY_SYSTEM_LOG subcommands to display
{   the contents of the job and system logs, respectively.

  PROCEDURE display_log
    (    text: string ( * );
         log_control_descriptor_p: ^lgt$log_control_descriptor;
     VAR status: ost$status);

    VAR
      cell_p: ^cell,
      character_index: lgt$log_entry_size,
      current_length: lgt$log_entry_size,
      display_line: ^string ( * ),
      display_line_index: 1 .. lgc$maximum_log_entry_size + 1,
      display_line_length: lgt$log_entry_size,
      ending_offset: amt$file_byte_address,
      eof: boolean,
      i: ost$non_negative_integers,
      indentation_size: 0 .. 2,
      integer_variant: boolean,
      line_count: amt$file_byte_address,
      log_cycle: lgt$log_cycle,
      log_data: ^SEQ ( * ),
      log_entry: ^string ( * ),
      page_width: integer,
      pvt: array [1 .. 1] of syt$parameter_value;


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    status.normal := TRUE;

    integer_variant := FALSE;
    syp$crack_command (display_log_int_pdt, text, pvt, status);
    IF NOT status.normal THEN
      syp$crack_command (display_log_pdt, text, pvt, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      integer_variant := TRUE;
    IFEND;

    syp$verify_access (syc$readable, #LOC (log_control_descriptor_p^.log_data), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ The page_widths below are defined as the amount of data which can be printed/retained on a single line of a
{ "hardcopy" output, or the amount of data that can be displayed on a single line of console output.

    IF syv$dump_to_pf THEN
      page_width := 132;
    ELSE
      page_width := 80;
    IFEND;

    PUSH log_entry: [lgc$maximum_log_entry_size];
    PUSH display_line: [page_width];

{ Figure out which entry in the log should be the first one to be displayed.

    IF integer_variant THEN

{ Backspace through the log the specified number of entries.

      lgp$get_log_read_information (log_control_descriptor_p, pvt [1].int, log_cycle, log_data,
            ending_offset, status);
    ELSE {name_variant}

{ Set up to read from the beginning of the log.

      lgp$get_log_read_information (log_control_descriptor_p, 0, log_cycle, log_data,
            ending_offset, status);
      RESET log_data;
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Set up to start reading the log at the first log message to be displayed.

    WHILE i#current_sequence_position (log_data) <= ending_offset DO

{ Get the log entry to be displayed.

      lgp$get_log_entry (log_cycle, log_control_descriptor_p, log_data, current_length, #SEQ(log_entry^)^,
            status);
      IF NOT status.normal THEN
        IF (status.condition = lge$end_of_log) OR (status.condition = lge$log_cycles_do_not_match) THEN
          status.normal := TRUE;
        IFEND;
        RETURN;
      IFEND;

{ Display the log entry, wrapping to more than one line if necessary.

      display_line_index := 1;
      indentation_size := 0;

      WHILE display_line_index <= current_length DO
        IF (current_length - display_line_index + 1) <= (page_width - indentation_size) THEN
          display_line_length := current_length - display_line_index + 1;
        ELSE
          display_line_length := page_width - indentation_size;
        IFEND;
        display_line^ (indentation_size + 1, display_line_length) :=
              log_entry^ (display_line_index, display_line_length);

{ Trim off trailing spaces.

        character_index := display_line_length + indentation_size;
        WHILE (character_index > 0) AND (display_line^ (character_index) = ' ') DO
          character_index := character_index - 1;
        WHILEND;
        IF character_index > 0 THEN
          syp$write_output_line (display_line^ (1, character_index), status);
        IFEND;
        display_line_index := display_line_index + display_line_length;
        indentation_size := 2;
        display_line^ (1, indentation_size) := '  ';
      WHILEND;
    WHILEND;

  PROCEND display_log;
?? OLDTITLE ??
?? NEWTITLE := '  DISPLAY_XCB', EJECT ??

{
{ Purpose:
{   This procedure displays the contents of the specified execution_control_block.
{        XCBP: Pointer to the execution_control_block which is to be displayed.
{        FULL: Boolean determines the amount of information which is to be displayed.  "TRUE" displays the
{          entire XCB.
{

  PROCEDURE display_xcb
    (    xcbp: ^ost$execution_control_block;
         full: boolean);

    VAR
      i: integer,
      msg: string (78),
      preg: ost$p_register,
      status: ost$status,
      str: string (60);


    status.normal := TRUE;

    msg := 'task name & addr:';
    msg (19, * ) := xcbp^.save9;
    syp$convert_bytes (#LOC (xcbp), #SIZE (xcbp), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'global task id:';
    syp$convert_bytes (#LOC (xcbp^.global_task_id), #SIZE (xcbp^.global_task_id), msg, add_to_eol);
    syp$write_output_line (msg, status);

    IF NOT full THEN
      RETURN;
    IFEND;

    msg := 'xp.p:';
    preg := xcbp^.xp.p_register;
    syp$convert_bytes (#LOC (preg), #SIZE (preg), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'xp.x0:';
    syp$convert_bytes (#LOC (xcbp^.xp.x_registers [0]), #SIZE (xcbp^.xp.x_registers [0]), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'monitor flags:';
    syp$convert_bytes (#LOC (xcbp^.monitor_flags), #SIZE (xcbp^.monitor_flags), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'system table lock count:';
    syp$convert_bytes (#LOC (xcbp^.system_table_lock_count), #SIZE (xcbp^.system_table_lock_count),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'system flags:';
    syp$convert_bytes (#LOC (xcbp^.system_flags), #SIZE (xcbp^.system_flags), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'wait inhib, task terminating, task rethreaded: ';
    syp$write_output_line (msg, status);
    msg := '    ';
    msg (4, * ) := boolean_translations [xcbp^.wait_inhibited];
    msg (10, * ) := boolean_translations [xcbp^.task_is_terminating];
    msg (16, * ) := boolean_translations [xcbp^.task_has_been_rethreaded];
    syp$write_output_line (msg, status);

    msg := 'system give up cpu, subsystem give up cpu:';
    syp$write_output_line (msg, status);
    msg := '    ';
    msg (4, * ) := boolean_translations [xcbp^.system_give_up_cpu];
    msg (10, * ) := boolean_translations [xcbp^.subsystem_give_up_cpu];
    syp$write_output_line (msg, status);

    msg := 'parent global task id:';
    syp$convert_bytes (#LOC (xcbp^.parent_global_task_id), #SIZE (xcbp^.parent_global_task_id),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'cpu priority:';
    syp$convert_bytes (#LOC (xcbp^.dispatching_priority), #SIZE (xcbp^.dispatching_priority),
          msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'system error count:';
    syp$convert_bytes (#LOC (xcbp^.system_error_count), #SIZE (xcbp^.system_error_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'link:';
    syp$convert_bytes (#LOC (xcbp^.link), #SIZE (xcbp^.link), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'task control block:';
    syp$convert_bytes (#LOC (xcbp^.task_control_block), #SIZE (xcbp^.task_control_block), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'task id:';
    syp$convert_bytes (#LOC (xcbp^.task_id), #SIZE (xcbp^.task_id), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'sdt offset:';
    syp$convert_bytes (#LOC (xcbp^.sdt_offset), #SIZE (xcbp^.sdt_offset), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'sdtx offset:';
    syp$convert_bytes (#LOC (xcbp^.sdtx_offset), #SIZE (xcbp^.sdtx_offset), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'cp time:';
    syp$convert_bytes (#LOC (xcbp^.cp_time), #SIZE (xcbp^.cp_time), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'page wait info:';
    syp$convert_bytes (#LOC (xcbp^.page_wait_info), #SIZE (xcbp^.page_wait_info), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'proc malf count:';
    syp$convert_bytes (#LOC (xcbp^.proc_malf_count), #SIZE (xcbp^.proc_malf_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

    FOR i := 1 TO tmc$maximum_signals DO
      IF xcbp^.signals.present [i] THEN
        msg := 'signal(valid):';
      ELSE
        msg := 'signal(invalid):';
      IFEND;
      syp$convert_bytes (#LOC (xcbp^.signals.buffer [i].originator),
            #SIZE (xcbp^.signals.buffer [i].originator), msg, add_to_eol);
      syp$convert_bytes (#LOC (xcbp^.signals.buffer [i].signal), #SIZE (xcbp^.signals.buffer [i].signal),
            msg, add_to_eol);
      syp$write_output_line (msg, status);
    FOREND;

    msg := 'paging statistics:';
    syp$write_output_line (msg, status);
    msg := '  pages from disk:';
    syp$convert_bytes (#LOC (xcbp^.paging_statistics.page_in_count),
          #SIZE (xcbp^.paging_statistics.page_in_count), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  pages reclaimed:';
    syp$convert_bytes (#LOC (xcbp^.paging_statistics.pages_reclaimed_from_queue),
          #SIZE (xcbp^.paging_statistics.pages_reclaimed_from_queue), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  new pages assigned:';
    syp$convert_bytes (#LOC (xcbp^.paging_statistics.new_pages_assigned),
          #SIZE (xcbp^.paging_statistics.new_pages_assigned), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  pages from server:';
    syp$convert_bytes (#LOC (xcbp^.paging_statistics.pages_from_server),
          #SIZE (xcbp^.paging_statistics.pages_from_server), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  page fault count:';
    syp$convert_bytes (#LOC (xcbp^.paging_statistics.page_fault_count),
          #SIZE (xcbp^.paging_statistics.page_fault_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

  PROCEND display_xcb;
?? OLDTITLE ??
?? NEWTITLE := '  DISSEPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_STACK_ENVIRONMENT command.  There are no parameters for the command.
{ This procedure displays the segment number and the top-of-stack values for each ring in which a task is
{ executing.  It also displays the memory contents of the stack if the command is displaying output to a
{ permanent file and/or the printer.
{

  PROCEDURE disseproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      bn: 0 .. 0ffffffff(16),
      i: 0 .. 15,
      ignore: integer,
      msg: string (55),
      pc: ^cell,
      tos_pointer: ^cell,
      sn: 0 .. 0fff(16),
      str: string (60),
      xcbp: ^ost$execution_control_block;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY STACK ENVIRONMENT ', text);
    IFEND;

    pmp$find_executing_task_xcb (xcbp);

    FOR i := 1 TO 15 DO
      tos_pointer := #ADDRESS (xcbp^.xp.tos_registers [i].pva.ring, xcbp^.xp.tos_registers [i].pva.seg,
            xcbp^.xp.tos_registers [i].pva.offset);
      IF tos_pointer <> NIL THEN
        sn := xcbp^.xp.tos_registers [i].pva.seg;
        IF i = 1 THEN

{ Special code for ring 1.

          PUSH pc;
          bn := #OFFSET (pc);
        ELSE
          bn := xcbp^.xp.tos_registers [i].pva.offset;
        IFEND;

        msg := ' STACK INFO: RING/SEG/HIGH ';
        syp$convert_bytes (#LOC (i), #SIZE (i), msg, add_to_eol);
        syp$convert_bytes (#LOC (sn), #SIZE (sn), msg, add_to_eol);
        syp$convert_bytes (#LOC (bn), #SIZE (bn), msg, add_to_eol);
        syp$write_output_line (msg, status);

        IF syv$dump_to_pf THEN
          msg := '  ';
          pc := #ADDRESS (1, sn, 0);
          syp$convert_bytes (#LOC (pc), #SIZE (pc), msg, add_to_eol);
          STRINGREP (msg (14, 15), ignore, bn);

{ Force the memory display of the stack.

          msg (35, 1) := 'F';
          dmproc (msg, display_id, status);

          msg := '  ';
          syp$write_output_line (msg, status);
          syp$write_output_line (msg, status);
          syp$write_output_line (msg, status);
        IFEND;
      IFEND;
    FOREND;
    status.normal := TRUE;
  PROCEND disseproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISSFID_PROC', EJECT ??

{ DISPLAY_SYSTEM_FILE_ID parameter descriptor table:

  VAR
    sfid_display_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'sfid    ', syc$integer_value, 0, 1, 0ffffffff(16)]];

{
{ Purpose:
{   This procedure processes the DISPLAY_SYSTEM_FILE_ID command.  This procedure displays the file descriptor
{ entry associated with the specified SFID if it is in real memory.  The parameter for the command is:
{        SFID: Required, integer.
{          Specifies the system file identifier of the file to be displayed.
{

  PROCEDURE dissfid_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      fde_p: gft$file_desc_entry_p,
      pvt: array [1 .. 1] of syt$parameter_value,
      rma: integer,
      sfid_converter: debug_sfid_converter,
      str: string (60);

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syp$crack_command (sfid_display_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY SYSTEM FILE ID', text);
    IFEND;

    sfid_converter.int := pvt [1].int;
    gfp$get_fde_p (sfid_converter.sfid, fde_p);
    IF fde_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'SFID does not exist', status);
      RETURN;
    IFEND;

    i#real_memory_address (fde_p, rma);
    IF rma < 0 THEN
      osp$set_status_abnormal ('DB', dbe$, 'FDE_P not in real memory', status);
      RETURN;
    IFEND;

    i#real_memory_address (#ADDRESS (#RING (fde_p), #SEGMENT (fde_p), #OFFSET(fde_p) +
          #SIZE (gft$file_descriptor_entry)), rma);
    IF rma < 0 THEN
      osp$set_status_abnormal ('DB', dbe$, 'End of FDE_P not in real memory', status);
      RETURN;
    IFEND;

{ Display the FDE associated with the system_file_id.

    str := ' Corresponding File Descriptor Entry:';
    syp$write_output_line (str, status);

    str := '   job lock:';
    syp$write_output_line (str, status);
    str := '     locked:';
    IF fde_p^.job_lock.locked THEN
      str (14, *) := 'TRUE';
    ELSE
      str (14, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     count:';
    syp$convert_bytes (#LOC (fde_p^.job_lock.count), #SIZE (fde_p^.job_lock.count), str, add_to_eol);
    syp$write_output_line (str, status);
    str := '     gtid:';
    syp$convert_bytes (#LOC (fde_p^.job_lock.gtid), #SIZE (fde_p^.job_lock.gtid), str, add_to_eol);
    syp$write_output_line (str, status);
    str := '     p register:';
    syp$convert_bytes (#LOC (fde_p^.job_lock.p_register), #SIZE (fde_p^.job_lock.p_register),
          str, add_to_eol);
    syp$write_output_line (str, status);
    str := '     p register 2:';
    syp$convert_bytes (#LOC (fde_p^.job_lock.p_register_2), #SIZE (fde_p^.job_lock.p_register_2),
          str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   monitor lock:';
    syp$convert_bytes (#LOC (fde_p^.monitor_lock), #SIZE (fde_p^.monitor_lock), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   flags:';
    syp$write_output_line (str, status);
    str := '     eoi modified:';
    IF fde_p^.flags.eoi_modified THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     wire eoi page:';
    IF fde_p^.flags.wire_eoi_page THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     active_shadow_file:';
    IF fde_p^.flags.active_shadow_file THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := ' global_template:';
    IF fde_p^.flags.global_template_file THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     fde spare 4:';
    IF fde_p^.flags.fde_spare_4 THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     fde spare 5:';
    IF fde_p^.flags.fde_spare_5 THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     fde spare 6:';
    IF fde_p^.flags.fde_spare_6 THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     fde spare 7:';
    IF fde_p^.flags.fde_spare_7 THEN
      str (21, *) := 'TRUE';
    ELSE
      str (21, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);

    str := '   global file name:';
    syp$convert_bytes (#LOC (fde_p^.global_file_name), #SIZE (fde_p^.global_file_name), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   file hash thread:';
    syp$convert_bytes (#LOC (fde_p^.file_hash_thread), #SIZE (fde_p^.file_hash_thread), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   attached in write count:';
    syp$convert_bytes (#LOC (fde_p^.attached_in_write_count), #SIZE (fde_p^.attached_in_write_count), str,
          add_to_eol);
    syp$write_output_line (str, status);

    str := '   attach count:';
    syp$convert_bytes (#LOC (fde_p^.attach_count), #SIZE (fde_p^.attach_count), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   open count:';
    syp$convert_bytes (#LOC (fde_p^.open_count), #SIZE (fde_p^.open_count), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   file kind:';
    CASE fde_p^.file_kind OF
    = gfc$fk_job_permanent_file =
      str (15, *) := 'FK_JOB_PERMANENT_FILE';
    = gfc$fk_device_file =
      str (15, *) := 'FK_DEVICE_FILE';
    = gfc$fk_save_2 =
      str (15, *) := 'FK_SAVE_2';
    = gfc$fk_save_3 =
      str (15, *) := 'FK_SAVE_3';
    = gfc$fk_catalog =
      str (15, *) := 'FK_CATALOG';
    = gfc$fk_job_local_file =
      str (15, *) := 'FK_JOB_LOCAL_FILE';
    = gfc$fk_unnamed_file =
      str (15, *) := 'FK_UNNAMED_FILE';
    = gfc$fk_global_unnamed =
      str (15, *) := 'FK_GLOBAL_UNNAMED';
    = gfc$fk_monitor_only_unnamed =
      str (15, *) := 'FK_MONITOR_ONLY_UNNAMED';
    ELSE
      syp$convert_bytes (#LOC (fde_p^.file_kind), #SIZE (fde_p^.file_kind), str, add_to_eol);
    CASEND;
    syp$write_output_line (str, status);

    str := '   file hash:';
    syp$convert_bytes (#LOC (fde_p^.file_hash), #SIZE (fde_p^.file_hash), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   segment lock:';
    syp$write_output_line (str, status);
    str := '     locked for read:';
    syp$convert_bytes (#LOC (fde_p^.segment_lock.locked_for_read),
          #SIZE (fde_p^.segment_lock.locked_for_read), str, add_to_eol);
    str := '     locked for write:';
    IF fde_p^.segment_lock.locked_for_write THEN
      str (24, *) := 'TRUE';
    ELSE
      str (24, *) := 'FALSE';
    IFEND;
    syp$write_output_line (str, status);
    str := '     task queue link:';
    syp$write_output_line (str, status);
    str := '       head:';
    syp$convert_bytes (#LOC (fde_p^.segment_lock.task_queue.head),
          #SIZE (fde_p^.segment_lock.task_queue.head), str, add_to_eol);
    syp$write_output_line (str, status);
    str := '       tail:';
    syp$convert_bytes (#LOC (fde_p^.segment_lock.task_queue.tail),
          #SIZE (fde_p^.segment_lock.task_queue.tail), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   asti:';
    syp$convert_bytes (#LOC (fde_p^.asti), #SIZE (fde_p^.asti), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   eoi byte address:';
    syp$convert_bytes (#LOC (fde_p^.eoi_byte_address), #SIZE (fde_p^.eoi_byte_address), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   eoi state:';
    IF fde_p^.eoi_state = mmc$eoi_actual THEN
      str (15, *) := 'EOI_ACTUAL';
    ELSEIF fde_p^.eoi_state = mmc$eoi_rounded THEN
      str (15, *) := 'EOI_ROUNDED';
    ELSEIF fde_p^.eoi_state = mmc$eoi_uncertain THEN
      str (15, *) := 'EOI_UNCERTAIN';
    ELSE
      syp$convert_bytes (#LOC (fde_p^.eoi_state), #SIZE (fde_p^.eoi_state), str, add_to_eol);
    IFEND;
    syp$write_output_line (str, status);

    str := '   allocation unit size:';
    syp$convert_bytes (#LOC (fde_p^.allocation_unit_size), #SIZE (fde_p^.allocation_unit_size), str,
          add_to_eol);
    syp$write_output_line (str, status);

    str := '   transfer unit size:';
    syp$convert_bytes (#LOC (fde_p^.transfer_unit_size), #SIZE (fde_p^.transfer_unit_size), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   file limit:';
    syp$convert_bytes (#LOC (fde_p^.file_limit), #SIZE (fde_p^.file_limit), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   queue status:';
    IF fde_p^.queue_status = gfc$qs_global_shared THEN
      str (18, *) := 'GLOBAL_SHARED';
    ELSEIF fde_p^.queue_status = gfc$qs_job_shared THEN
      str (18, *) := 'JOB_SHARED';
    ELSEIF fde_p^.queue_status = gfc$qs_job_working_set THEN
      str (18, *) := 'JOB_WORKING_SET';
    ELSE
      syp$convert_bytes (#LOC (fde_p^.queue_status), #SIZE (fde_p^.queue_status), str, add_to_eol);
    IFEND;
    syp$write_output_line (str, status);

    str := '   preset value:';
    IF fde_p^.preset_value = pmc$initialize_to_zero THEN
      str (18, *) := 'INITIALIZE_TO_ZERO';
    ELSEIF fde_p^.preset_value = pmc$initialize_to_alt_ones THEN
      str (18, *) := 'INITIALIZE_TO_ALT_ONES';
    ELSEIF fde_p^.preset_value = pmc$initialize_to_indefinite THEN
      str (18, *) := 'INITIALIZE_TO_INDEFINITE';
    ELSEIF fde_p^.preset_value = pmc$initialize_to_infinity THEN
      str (18, *) := 'INITIALIZE_TO_INFINITY';
    ELSE
      syp$convert_bytes (#LOC (fde_p^.preset_value), #SIZE (fde_p^.preset_value), str, add_to_eol);
    IFEND;
    syp$write_output_line (str, status);

    str := '   time last modified:';
    syp$convert_bytes (#LOC (fde_p^.time_last_modified), #SIZE (fde_p^.time_last_modified), str,
          add_to_eol);
    syp$write_output_line (str, status);

    str := '   last segment number:';
    syp$convert_bytes (#LOC (fde_p^.last_segment_number), #SIZE (fde_p^.last_segment_number), str,
          add_to_eol);
    syp$write_output_line (str, status);

    str := '   global task id:';
    syp$convert_bytes (#LOC (fde_p^.global_task_id), #SIZE (fde_p^.global_task_id), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   stack for ring:';
    syp$convert_bytes (#LOC (fde_p^.stack_for_ring), #SIZE (fde_p^.stack_for_ring), str, add_to_eol);
    syp$write_output_line (str, status);

    str := '   media:';
    IF fde_p^.media = gfc$fm_transient_segment THEN
      str (11, *) := 'TRANSIENT_SEGMENT';
    ELSEIF fde_p^.media = gfc$fm_mass_storage_file THEN
      str (11, *) := 'MASS_STORAGE_FILE';
      syp$write_output_line (str, status);
      str := '     disk_file_descriptor_p:';
      syp$convert_bytes (#LOC (fde_p^.disk_file_descriptor_p), #SIZE (fde_p^.disk_file_descriptor_p), str,
            add_to_eol);
    ELSEIF fde_p^.media = gfc$fm_served_file THEN
      str (11, *) := 'SERVED_FILE';
      syp$write_output_line (str, status);
      str := '     served_file_descriptor_p:';
      syp$convert_bytes (#LOC (fde_p^.served_file_descriptor_p), #SIZE (fde_p^.served_file_descriptor_p), str,
             add_to_eol);
    ELSE
      syp$convert_bytes (#LOC (fde_p^.media), #SIZE (fde_p^.media), str, add_to_eol);
    IFEND;
    syp$write_output_line (str, status);

    status.normal := TRUE;

  PROCEND dissfid_proc;
?? OLDTITLE ??
?? NEWTITLE := '  DISSLPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_SYSTEM_LOG command.  The parameter for the command is as follows:
{        ENTRIES: Optional, integer or keyword ALL.
{          Specifies the number of log entries to be displayed.  The default value for this parameter is 1000.
{

  PROCEDURE disslproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      header_string: string (60),
      log_control_desc_p: ^lgt$log_control_descriptor,
      log_control_descriptors_p: ^array [pmt$global_logs] of lgt$log_control_descriptor;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY SYSTEM LOG ', text);
    IFEND;

    IF (syv$job_template_ptr_array = NIL) OR (UPPERBOUND (syv$job_template_ptr_array^) < 2) THEN
      osp$set_status_abnormal ('DB', dbe$, 'not available', status);
      RETURN;
    IFEND;

    syp$verify_access (syc$readable, #LOC (syv$job_template_ptr_array^ [2]), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    log_control_descriptors_p := syv$job_template_ptr_array^ [2];
    log_control_desc_p := ^log_control_descriptors_p^ [pmc$system_log];

    display_log (text, log_control_desc_p, status);

  PROCEND disslproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISSTPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_SEGMENT_TABLE command.  It displays the segment table entry for the
{   specified segment.  The parameters for the command are as follows:
{        NUMBER: Required, integer.
{          Specifies the number of the segment to display.
{        GTID: Optional, integer.
{          Specifies the global_task_id of the task whose segment table entry is to be displayed.  Use of this
{          value will display the table entry of the task with the corresponding GTID.  If this parameter is
{          not specified the debugger will display the table entry of the task which is currently in the
{          debugger.
{


{ DISPLAY_SEGMENT_TABLE parameter descriptor table:

  VAR
    sdt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number  ', syc$integer_value, 0, 0, 7fffffff(16)],
{   } [FALSE, 2, 'gtid    ', syc$integer_value, 0, 0, 0fffff(16)]];

  PROCEDURE disstproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      asid: ost$asid,
      execution_privilege: ost$execute_privilege,
      gtid: gtid_converter,
      gtid_found: boolean,
      key_lock: ost$key_lock,
      msg: string (70),
      pvt: array [1 .. 2] of syt$parameter_value,
      read_privilage: ost$read_privilege,
      ring_1: ost$ring,
      ring_2: ost$ring,
      sdte_p: ^mmt$segment_descriptor,
      segment_number: integer,
      str: string (60),
      svl: (osc$vl_invalid_entry, osc$vl_reserved, osc$vl_regular_segment, osc$vl_cache_bypass),
      write_privilege: ost$write_privilege,
      xcb_p: ^ost$execution_control_block;


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (sdt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT est_flag THEN
      IF syv$dump_to_pf THEN
        syp$write_output_header (' DISPLAY SEGMENT TABLE ENTRY ', text);
      IFEND;
    ELSE
      str := '   ';
      syp$write_output_line (str, status);
      str := ' DISPLAY SEGMENT TABLE ENTRY ';
      str (31, * ) := text;
      syp$write_output_line (str, status);
    IFEND;

    segment_number := pvt [1].int;
    IF pvt [2].defined AND (pvt [2].int <> 0) THEN
      gtid.base := pvt [2].int;
      gtid_found := FALSE;
      xcb_p := job_xcb_list.head;
      WHILE (xcb_p <> NIL) AND (NOT gtid_found) DO
        IF xcb_p^.global_task_id = gtid.global_task_id THEN
          gtid_found := TRUE;
        ELSE
          xcb_p := xcb_p^.link;
        IFEND;
      WHILEND;
      IF NOT gtid_found THEN
        syp$write_output_line ('ERROR - Task with specified GTID was not found.', status);
        RETURN;
      IFEND;
      IF NOT est_flag THEN
        msg := ' Segment Table entry for alternate task: ';
        syp$write_output_line (msg, status);
        msg := ' ';
        msg (4, * ) := xcb_p^.save9;
        syp$write_output_line (msg, status);
        msg := ' ';
        syp$write_output_line (msg, status);
      IFEND;
    ELSE
      pmp$find_executing_task_xcb (xcb_p);
    IFEND;

    IF (segment_number > (xcb_p^.xp.segment_table_length)) OR (segment_number < 0) THEN
      osp$set_status_abnormal ('sy', dbe$, 'segment number out of range', status);
      RETURN;
    IFEND;

    sdte_p := mmp$get_sdt_entry_p (xcb_p, segment_number);
    IF sdte_p^.ste.vl = osc$vl_invalid_entry THEN
      msg := ' INVALID ENTRY ';
      syp$write_output_line (msg, status);
      RETURN;
    IFEND;
    msg := 'ste.vl:';
    svl := sdte_p^.ste.vl;
    CASE svl OF
    = osc$vl_reserved =
      msg (9, * ) := 'reserved';
    = osc$vl_regular_segment =
      msg (9, * ) := 'regular segment';
    = osc$vl_cache_bypass =
      msg (9, * ) := 'cache bypass';
    ELSE
      syp$convert_bytes (#LOC (svl), #SIZE (svl), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'ste.xp:';
    CASE sdte_p^.ste.xp OF
    = osc$non_executable =
      msg (9, * ) := 'non executable';
    = osc$non_privileged =
      msg (9, * ) := 'non_privileged';
    = osc$local_privilege =
      msg (9, * ) := 'local privilege';
    = osc$global_privilege =
      msg (9, * ) := 'global privilege';
    ELSE
      execution_privilege := sdte_p^.ste.xp;
      syp$convert_bytes (#LOC (execution_privilege), #SIZE (execution_privilege), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'ste.rp:';
    CASE sdte_p^.ste.rp OF
    = osc$non_readable =
      msg (9, * ) := 'non readable';
    = osc$read_key_lock_controlled =
      msg (9, * ) := 'read key lock controlled';
    = osc$read_uncontrolled =
      msg (9, * ) := 'read uncontrolled';
    = osc$binding_segment =
      msg (9, * ) := 'binding segment';
    ELSE
      read_privilage := sdte_p^.ste.rp;
      syp$convert_bytes (#LOC (read_privilage), #SIZE (read_privilage), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'ste.wp:';
    CASE sdte_p^.ste.wp OF
    = osc$non_writable =
      msg (9, * ) := 'non writeable';
    = osc$write_key_lock_controlled =
      msg (9, * ) := 'write_key_lock_controlled';
    = osc$write_uncontrolled =
      msg (9, * ) := 'write_uncontrolled';
    = osc$wp_reserved =
      msg (9, * ) := 'wp reserved';
    ELSE
      write_privilege := sdte_p^.ste.wp;
      syp$convert_bytes (#LOC (write_privilege), #SIZE (write_privilege), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'ste.r1:';
    ring_1 := sdte_p^.ste.r1;
    syp$convert_bytes (#LOC (ring_1), #SIZE (ring_1), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'ste.r2:';
    ring_2 := sdte_p^.ste.r2;
    syp$convert_bytes (#LOC (ring_2), #SIZE (ring_2), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'ste.asid:';
    asid := sdte_p^.ste.asid;
    syp$convert_bytes (#LOC (asid), #SIZE (asid), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'ste.key_lock:';
    key_lock := sdte_p^.ste.key_lock;
    syp$convert_bytes (#LOC (key_lock), #SIZE (key_lock), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'fill1:';
    syp$convert_bytes (#LOC (sdte_p^.fill1), #SIZE (sdte_p^.fill1), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'asti:';
    syp$convert_bytes (#LOC (sdte_p^.asti), #SIZE (sdte_p^.asti), msg, add_to_eol);
    syp$write_output_line (msg, status);

  PROCEND disstproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISSTXPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_SEGMENT_TABLE_EXTENDED command.  It displays the segment table
{   (extended) entry for the specified segment.  The parameters for the command are as follows:
{        NUMBER: Required, integer.
{          Specifies the number of the segment to display.
{        GTID: Optional, integer.
{          Specifies the global_task_id of the task whose segment table extended entry is to be displayed.
{          Use of this value will display the table entry of the task with the corresponding GTID.  If this
{          parameter is not specified the debugger will display the table entry of the task which is currently
{          in the debugger.
{


{ DISPLAY_SEGMENT_TABLE_EX parameter descriptor table:

  VAR
    sdtx_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number  ', syc$integer_value, 0, 0, 7fffffff(16)],
{   } [FALSE, 2, 'gtid    ', syc$integer_value, 0, 0, 0fffff(16)]];

  PROCEDURE disstxproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      gtid: gtid_converter,
      gtid_found: boolean,
      msg: string (80),
      msg2: string (130),
      pvt: array [1 .. 2] of syt$parameter_value,
      sdte_p: ^mmt$segment_descriptor,
      sdtxe_p: ^mmt$segment_descriptor_extended,
      segnum: integer,
      size: integer,
      str: string (60),
      stream: integer,
      xcb_p: ^ost$execution_control_block;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (sdtx_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT est_flag THEN
      IF syv$dump_to_pf THEN
        syp$write_output_header (' DISPLAY SEGMENT TABLE EXTENDED ENTRY ', text);
      IFEND;
    ELSE
      str := '     ';
      syp$write_output_line (str, status);
      str := ' DISPLAY SEGMENT TABLE EXTENDED ENTRY ';
      str (40, * ) := text;
      syp$write_output_line (str, status);
    IFEND;

    segnum := pvt [1].int;
    IF pvt [2].defined AND (pvt [2].int <> 0) THEN
      gtid.base := pvt [2].int;
      gtid_found := FALSE;
      xcb_p := job_xcb_list.head;
      WHILE (xcb_p <> NIL) AND (NOT gtid_found) DO
        IF xcb_p^.global_task_id = gtid.global_task_id THEN
          gtid_found := TRUE;
        ELSE
          xcb_p := xcb_p^.link;
        IFEND;
      WHILEND;
      IF NOT gtid_found THEN
        syp$write_output_line ('ERROR - Task with specified GTID was not found.', status);
        RETURN;
      IFEND;
      IF NOT est_flag THEN
        msg := ' Segment Table Extended entry for alternate task: ';
        syp$write_output_line (msg, status);
        msg := ' ';
        msg (4, * ) := xcb_p^.save9;
        syp$write_output_line (msg, status);
        msg := ' ';
        syp$write_output_line (msg, status);
      IFEND;
    ELSE
      pmp$find_executing_task_xcb (xcb_p);
    IFEND;

    IF (segnum > (xcb_p^.xp.segment_table_length)) OR (segnum < 0) THEN
      osp$set_status_abnormal ('sy', dbe$, 'segment number out of range', status);
      RETURN;
    IFEND;

    sdte_p := mmp$get_sdt_entry_p (xcb_p, segnum);
    sdtxe_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
    IF sdte_p^.ste.vl = osc$vl_invalid_entry THEN
      msg := ' INVALID ENTRY ';
      syp$write_output_line (msg, status);
      RETURN;
    IFEND;

    msg := 'open validating ring number:';
    syp$convert_bytes (#LOC (sdtxe_p^.open_validating_ring_number),
          #SIZE (sdtxe_p^.open_validating_ring_number), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'access state:';
    CASE sdtxe_p^.access_state OF
    = mmc$sas_allow_access =
      msg (15, * ) := 'sas_allow_access';
    = mmc$sas_inhibit_access =
      msg (15, * ) := 'sas_inhibit_access';
    = mmc$sas_terminate_access =
      msg (15, * ) := 'sas_terminate_access';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.access_state), #SIZE (sdtxe_p^.access_state), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'sfid:';
    syp$convert_bytes (#LOC (sdtxe_p^.sfid), #SIZE (sdtxe_p^.sfid), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := 'inheritance:';
    CASE sdtxe_p^.inheritance OF
    = mmc$si_none =
      msg (14, * ) := 'si_none';
    = mmc$si_share_segment =
      msg (14, * ) := 'si_share_segment';
    = mmc$si_transfer_segment =
      msg (14, * ) := 'si_transfer_segment';
    = mmc$si_new_segment =
      msg (14, * ) := 'si_new_segment';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.inheritance), #SIZE (sdtxe_p^.inheritance), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'segment reservation state:';
    CASE sdtxe_p^.segment_reservation_state OF
    = mmc$srs_not_reserved =
      msg (28, * ) := ' NOT RESERVED';
    = mmc$srs_reserved =
      msg (28, * ) := ' RESERVED';
    = mmc$srs_reserved_shared_stack =
      msg (28, * ) := ' RESERVED SHARED STACK';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.segment_reservation_state),
            #SIZE (sdtxe_p^.segment_reservation_state), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg2 := 'software attribute set:';
    syp$write_output_line (msg2, status);
    msg2 := '';
    size := 21;
    IF (mmc$sa_wired IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 10) := ' wired';
      size := size + 10;
    IFEND;
    IF (mmc$sa_fixed IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 10) := 'sa_fixed';
      size := size + 10;
    IFEND;
    IF (mmc$sa_stack IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 10) := 'sa_stack';
      size := size + 10;
    IFEND;
    IF (mmc$sa_read_transfer_unit IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 20) := 'read_transfer_unit';
      size := size + 20;
    IFEND;
    IF (mmc$sa_free_behind IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 15) := 'free_behind';
      size := size + 15;
    IFEND;
    IF (mmc$sa_no_append IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 15) := 'no_append';
      size := size + 15;
    IFEND;
    IF (mmc$sa_job_shared IN sdtxe_p^.software_attribute_set) THEN
      msg2 (size, 14) := ' job_shared';
      size := size + 14;
    IFEND;
    IF size <> 21 THEN
      syp$write_output_line (msg2, status);
    IFEND;

    msg := 'access rights:';
    CASE sdtxe_p^.access_rights OF
    = mmc$sar_none =
      msg (16, * ) := 'sar_none';
    = mmc$sar_read =
      msg (16, * ) := 'sar_read';
    = mmc$sar_modify =
      msg (16, * ) := 'sar_modify';
    = mmc$sar_write_extend =
      msg (16, * ) := 'sar_write_extend';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.access_rights),
            #SIZE (sdtxe_p^.access_rights), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'segment lock:';
    CASE sdtxe_p^.segment_lock OF
    = mmc$lss_none =
      msg (15, * ) := 'lss_none';
    = mmc$lss_lock_for_read_r3  =
      msg (15, * ) := 'lss_lock_for_read_r3';
    = mmc$lss_lock_for_write_r3 =
      msg (15, * ) := 'lss_lock_for_write_r3';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.segment_lock),
            #SIZE (sdtxe_p^.segment_lock), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);

    msg := 'shadow info:';
    syp$write_output_line (msg, status);
    msg := '  shadow start page number:';
    syp$convert_bytes (#LOC (sdtxe_p^.shadow_info.shadow_start_page_number),
          #SIZE (sdtxe_p^.shadow_info.shadow_start_page_number), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := '  shadow length page count:';
    syp$convert_bytes (#LOC (sdtxe_p^.shadow_info.shadow_length_page_count),
          #SIZE (sdtxe_p^.shadow_info.shadow_length_page_count), msg, add_to_eol);
    syp$write_output_line (msg, status);

    msg := '  shadowed segment kind:';
    CASE sdtxe_p^.shadow_info.shadow_segment_kind OF
    = mmc$ssk_none =
      msg (26, * ) := 'ssk_none';
    = mmc$ssk_read_write_file =
      msg (26, * ) := 'ssk_read_write_file';
    = mmc$ssk_read_only_file =
      msg (26, * ) := 'ssk_read_only_file';
    = mmc$ssk_read_only_trans_file =
      msg (26, * ) := 'ssk_read_only_trans_file';
    = mmc$ssk_segment_number =
      msg (26, * ) := 'ssk_segment_number';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.shadow_info.shadow_segment_kind),
            #SIZE (sdtxe_p^.shadow_info.shadow_segment_kind), msg, add_to_eol);
    CASEND;
    syp$write_output_line (msg, status);
    IF sdtxe_p^.shadow_info.shadow_segment_kind = mmc$ssk_segment_number THEN
      msg := '  shadow segment number:';
      syp$convert_bytes (#LOC (sdtxe_p^.shadow_info.shadow_segment_number),
            #SIZE (sdtxe_p^.shadow_info.shadow_segment_number), msg, add_to_eol);
    ELSE
      msg := '  shadow sfid:';
      syp$convert_bytes (#LOC (sdtxe_p^.shadow_info.shadow_sfid),
            #SIZE (sdtxe_p^.shadow_info.shadow_sfid), msg, add_to_eol);
    IFEND;
    syp$write_output_line (msg, status);

    msg := 'file limits enforced:';
    CASE sdtxe_p^.file_limits_enforced OF
    = sfc$no_limit =
      msg (30, * ) := ' no_limit';
    = sfc$perm_file_space_limit =
      msg (30, * ) := ' perm_file_space_limit';
    = sfc$temp_file_space_limit =
      msg (30, * ) := ' temp_file_space_limit';
    ELSE
      syp$convert_bytes (#LOC (sdtxe_p^.file_limits_enforced),
            #SIZE (sdtxe_p^.file_limits_enforced), msg, add_to_eol);
    CASEND;

    msg := 'stream:';
    syp$write_output_line (msg, status);
    msg := '  last page fault:';
    stream := sdtxe_p^.stream.last_page_fault;
    syp$convert_bytes (#LOC (stream), #SIZE (stream), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  sequential accesses:';
    stream := sdtxe_p^.stream.sequential_accesses;
    syp$convert_bytes (#LOC (stream), #SIZE (stream), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  transfer size:';
    stream := sdtxe_p^.stream.transfer_size;
    syp$convert_bytes (#LOC (stream), #SIZE (stream), msg, add_to_eol);
    msg := '  random faults:';
    stream := sdtxe_p^.stream.transfer_size;
    syp$convert_bytes (#LOC (stream), #SIZE (stream), msg, add_to_eol);
    syp$write_output_line (msg, status);
    msg := '  streaming:';
    msg (14, * ) := boolean_translations [sdtxe_p^.stream.streaming];
    syp$write_output_line (msg, status);
    msg := '  transfer size specified:';
    msg (28, * ) := boolean_translations [sdtxe_p^.stream.transfer_size_specified];
    syp$write_output_line (msg, status);
    msg := '  preset streaming:';
    msg (21, * ) := boolean_translations [sdtxe_p^.stream.preset_streaming];
    syp$write_output_line (msg, status);

    msg := 'assign active:';
    syp$convert_bytes (#LOC (sdtxe_p^.assign_active), #SIZE (sdtxe_p^.assign_active), msg, add_to_eol);
    syp$write_output_line (msg, status);

  PROCEND disstxproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISTEPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_TASK_ENTRY command.  There are no parameters for the command.  This
{ procedure displays the execution control block (XCB) of all tasks in the job in which the system core
{ debugger is executing.
{

  PROCEDURE disteproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      str: string (60),
      xcbp: ^ost$execution_control_block;


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY TASK ENVIRONMENT ', text);
    IFEND;

    xcbp := job_xcb_list.head;
    WHILE xcbp <> NIL DO
      display_xcb (xcbp, syv$dump_to_pf);
      IF syv$dump_to_pf THEN
        str := ' ';
        syp$write_output_line (str, status);
      IFEND;
      xcbp := xcbp^.link;
    WHILEND;
    status.normal := TRUE;

  PROCEND disteproc;
?? OLDTITLE ??
?? NEWTITLE := '  DISXCBPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_EXECUTION_CONTROL_BLOCK command.  The parameter for the command is as
{ follows:
{        GTID: Optional, integer.
{          Specifies the global_task_id of the task whose execution control block is to be displayed.  Use of
{          this value will display the execution control block of the task with the corresponding GTID.  If
{          this parameter is not specified the debugger will display the execution control block of the task
{          which is currently in the debugger.
{


{ DISPLAY_EXECUTION_CONTROL_BLOCK parameter descriptor table:

  VAR
    disecb_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'gtid    ', syc$integer_value, 0, 0, 0fffff(16)]];

  PROCEDURE disxcbproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      gtid: gtid_converter,
      gtid_found: boolean,
      msg: string (70),
      pvt: array [1 .. 1] of syt$parameter_value,
      str: string (60),
      xcb_p: ^ost$execution_control_block;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (disecb_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY EXECUTION CONTROL BLOCK ', text);
    IFEND;

    IF pvt [1].defined AND (pvt [1].int <> 0) THEN
      gtid.base := pvt [1].int;
      gtid_found := FALSE;
      xcb_p := job_xcb_list.head;
      WHILE (xcb_p <> NIL) AND (NOT gtid_found) DO
        IF xcb_p^.global_task_id = gtid.global_task_id THEN
          gtid_found := TRUE;
        ELSE
          xcb_p := xcb_p^.link;
        IFEND;
      WHILEND;
      IF NOT gtid_found THEN
        syp$write_output_line ('ERROR - Task with specified GTID was not found.', status);
        RETURN;
      IFEND;
      msg := ' Execution Control Block for alternate task: ';
      syp$write_output_line (msg, status);
      msg := ' ';
      msg (4, * ) := xcb_p^.save9;
      syp$write_output_line (msg, status);
      msg := ' ';
      syp$write_output_line (msg, status);
    ELSE
      pmp$find_executing_task_xcb (xcb_p);
    IFEND;

    display_xcb (xcb_p, TRUE);
    status.normal := TRUE;

  PROCEND disxcbproc;
?? OLDTITLE ??
?? NEWTITLE := '  DMPROC' ??
?? NEWTITLE := '    Character Translation Table     ', EJECT ??

{ The following translation table is used to remove the control codes from the displayed memory.  Any
{ character which cannot be displayed as legible ASCII will be translated into a space character for
{ display (' ').

  VAR
    dm_control_codes_to_space: [READ, oss$mainframe_paged_literal] string (256) := '            ' CAT
          '                     !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTU' CAT
          'VWXYZ[\]^_`abcdefghijkl' CAT 'mnopqrstuvwxyz{|}~?' CAT
          '                                                                ' CAT
          '                                                                ';

?? OLDTITLE, EJECT ??
{
{ Purpose:
{   This procedure processes the DISPLAY_MEMORY command.  The parameters for the command are as follows:
{        FBA: Required, pointer.
{          Specifies the starting virtual memory address (as a PVA or symbolic name) of the memory block to be
{          displayed (this is an 11-digit hexadecimal number addressing a specific byte of memory).
{        BC: Optional, integer.
{          Specifies the number of bytes of virtual memory to be displayed.  The system core debugger displays
{          a default value of 8 bytes.
{        FORCE: Optional, name.
{          Specifies whether or not to force the memory to be displayed if the address is beyond the current
{          segment length.  The following keywords can be specified (the default is N):
{            F
{            Forces the display even if the address, plus the length, extends beyond the current segment
{            length.  (This option is only valid for stack segments.)
{            N
{            Does not force the display if the address, plus the length, extends beyond the current segment
{            length.
{


{ DISPLAY_MEMORY parameter descriptor table:

  VAR
    dm_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'address ', syc$pointer_value, NIL],
{   } [FALSE, 2, 'length  ', syc$integer_value, 8, 1, 07fffffff(16)],
{   } [FALSE, 3, 'option  ', syc$name_value, 'N']];

  PROCEDURE dmproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    TYPE
      position_record = record
        display_offset: boolean,
        position: 0 .. 255,
        flush: boolean,
        char_position: 0 .. 255,
      recend,

      position_array = array [1 .. 132] of position_record;


    VAR
      assign_gap: boolean,
      assign_gap_start_offset: integer,
      bytes_examined: integer,
      byte_number: integer,
      display_line: string (256),
      display_line_length: 0 .. 255,

{ The following variable describes what should happen at a particular position of the display_line.  The
{ first field is a boolean determining if the current memory offset should be put in the output line.  The
{ second field is the position within the output string where the current byte should be displayed.  The third
{ field is a boolean determining if the current output string should be flushed.  The fourth field is the
{ position within the output string where the ASCII representation of the current byte should be displayed.

      display_position: [STATIC] position_array := [
 ?? FMT (FORMAT := OFF) ??
 { 1 } [FALSE, 0, FALSE, 0],    { 2 } [FALSE, 0, FALSE, 0],    { 3 } [FALSE, 0, FALSE, 0],
 { 4 } [FALSE, 0, FALSE, 0],    { 5 } [FALSE, 0, FALSE, 0],    { 6 } [FALSE, 0, FALSE, 0],
 { 7 } [FALSE, 0, FALSE, 0],    { 8 } [TRUE, 13, FALSE, 56],   { 9 } [TRUE, 14, FALSE, 101],
 { 10} [FALSE, 0, FALSE, 0],    { 11} [FALSE, 0, FALSE, 0],    { 12} [FALSE, 0, FALSE, 0],
 { 13} [FALSE, 15, FALSE, 57],  { 14} [FALSE, 16, FALSE, 102], { 15} [FALSE, 18, FALSE, 58],
 { 16} [FALSE, 19, FALSE, 103], { 17} [FALSE, 0, FALSE, 0],    { 18} [FALSE, 20, FALSE, 59],
 { 19} [FALSE, 21, FALSE, 104], { 20} [FALSE, 23, FALSE, 60],  { 21} [FALSE, 24, FALSE, 105],
 { 22} [FALSE, 0, FALSE, 0],    { 23} [FALSE, 25, FALSE, 61],  { 24} [FALSE, 26, FALSE, 106],
 { 25} [FALSE, 28, FALSE, 62],  { 26} [FALSE, 29, FALSE, 107], { 27} [FALSE, 0, FALSE, 0],
 { 28} [FALSE, 30, FALSE, 63],  { 29} [FALSE, 31, FALSE, 108], { 30} [FALSE, 35, FALSE, 64],
 { 31} [FALSE, 36, FALSE, 109], { 32} [FALSE, 0, FALSE, 0],    { 33} [FALSE, 0, FALSE, 0],
 { 34} [FALSE, 0, FALSE, 0],    { 35} [FALSE, 37, FALSE, 65],  { 36} [FALSE, 38, FALSE, 110],
 { 37} [FALSE, 40, FALSE, 66],  { 38} [FALSE, 41, FALSE, 111], { 39} [FALSE, 0, FALSE, 0],
 { 40} [FALSE, 42, FALSE, 67],  { 41} [FALSE, 43, FALSE, 112], { 42} [FALSE, 45, FALSE, 68],
 { 43} [FALSE, 46, FALSE, 113], { 44} [FALSE, 0, FALSE, 0],    { 45} [FALSE, 47, FALSE, 69],
 { 46} [FALSE, 48, FALSE, 114], { 47} [FALSE, 50, FALSE, 70],  { 48} [FALSE, 51, FALSE, 115],
 { 49} [FALSE, 0, FALSE, 0],    { 50} [FALSE, 52, TRUE, 71],   { 51} [FALSE, 53, FALSE, 116],
 { 52} [FALSE, 8, FALSE, 0],    { 53} [FALSE, 58, FALSE, 117], { 54} [FALSE, 0, FALSE, 0],
 { 55} [FALSE, 0, FALSE, 0],    { 56} [FALSE, 0, FALSE, 0],    { 57} [FALSE, 0, FALSE, 0],
 { 58} [FALSE, 60, FALSE, 118], { 59} [FALSE, 0, FALSE, 0],    { 60} [FALSE, 63, FALSE, 119],
 { 61} [FALSE, 0, FALSE, 0],    { 62} [FALSE, 0, FALSE, 0],    { 63} [FALSE, 65, FALSE, 120],
 { 64} [FALSE, 0, FALSE, 0],    { 65} [FALSE, 68, FALSE, 121], { 66} [FALSE, 0, FALSE, 0],
 { 67} [FALSE, 0, FALSE, 0],    { 68} [FALSE, 70, FALSE, 122], { 69} [FALSE, 0, FALSE, 0],
 { 70} [FALSE, 73, FALSE, 123], { 71} [FALSE, 0, FALSE, 0],    { 72} [FALSE, 0, FALSE, 0],
 { 73} [FALSE, 75, FALSE, 124], { 74} [FALSE, 0, FALSE, 0],    { 75} [FALSE, 80, FALSE, 125],
 { 76} [FALSE, 0, FALSE, 0],    { 77} [FALSE, 0, FALSE, 0],    { 78} [FALSE, 0, FALSE, 0],
 { 79} [FALSE, 0, FALSE, 0],    { 80} [FALSE, 82, FALSE, 126], { 81} [FALSE, 0, FALSE, 0],
 { 82} [FALSE, 85, FALSE, 127], { 83} [FALSE, 0, FALSE, 0],    { 84} [FALSE, 0, FALSE, 0],
 { 85} [FALSE, 87, FALSE, 128], { 86} [FALSE, 0, FALSE, 0],    { 87} [FALSE, 90, FALSE, 129],
 { 88} [FALSE, 0, FALSE, 0],    { 89} [FALSE, 0, FALSE, 0],    { 90} [FALSE, 92, FALSE, 130],
 { 91} [FALSE, 0, FALSE, 0],    { 92} [FALSE, 95, FALSE, 131], { 93} [FALSE, 0, FALSE, 0],
 { 94} [FALSE, 0, FALSE, 0],    { 95} [FALSE, 97, TRUE, 132],  { 96} [FALSE, 0, FALSE, 0],
 { 97} [FALSE, 9, FALSE, 0],    { 98} [FALSE, 0, FALSE, 0],    { 99} [FALSE, 0, FALSE, 0],
 {100} [FALSE, 0, FALSE, 0],    {101} [FALSE, 0, FALSE, 0],    {102} [FALSE, 0, FALSE, 0],
 {103} [FALSE, 0, FALSE, 0],    {104} [FALSE, 0, FALSE, 0],    {105} [FALSE, 0, FALSE, 0],
 {106} [FALSE, 0, FALSE, 0],    {107} [FALSE, 0, FALSE, 0],    {108} [FALSE, 0, FALSE, 0],
 {109} [FALSE, 0, FALSE, 0],    {110} [FALSE, 0, FALSE, 0],    {111} [FALSE, 0, FALSE, 0],
 {112} [FALSE, 0, FALSE, 0],    {113} [FALSE, 0, FALSE, 0],    {114} [FALSE, 0, FALSE, 0],
 {115} [FALSE, 0, FALSE, 0],    {116} [FALSE, 0, FALSE, 0],    {117} [FALSE, 0, FALSE, 0],
 {118} [FALSE, 0, FALSE, 0],    {119} [FALSE, 0, FALSE, 0],    {120} [FALSE, 0, FALSE, 0],
 {121} [FALSE, 0, FALSE, 0],    {122} [FALSE, 0, FALSE, 0],    {123} [FALSE, 0, FALSE, 0],
 {124} [FALSE, 0, FALSE, 0],    {125} [FALSE, 0, FALSE, 0],    {126} [FALSE, 0, FALSE, 0],
 {127} [FALSE, 0, FALSE, 0],    {128} [FALSE, 0, FALSE, 0],    {129} [FALSE, 0, FALSE, 0],
 {130} [FALSE, 0, FALSE, 0],    {131} [FALSE, 0, FALSE, 0],    {132} [FALSE, 0, FALSE, 0]],
 ?? FMT (FORMAT := ON) ??
      duplicate_line_count: integer,
      initial_line: boolean,
      i: 0 .. 255,
      j: 0 .. 255,
      length: integer,
      memory_access_in_bytes_p: ^array [0 .. 7fffffff(16)] of record
          CASE 0 .. 1 OF
          = 0 =
            byte: 0 .. 0ff(16),
          = 1 =
            character: string (1),
          CASEND,
        recend,
      previous_display_line: string (256),
      pvt: array [1 .. 3] of syt$parameter_value,
      rma: integer,
      sdtxe_p: ^mmt$segment_descriptor_extended,
      segnum: ost$segment,
      segnum_hex: string (19),
      segment_length: integer,
      str: string (60),
      wired_or_fixed_flag: boolean,
      xcb_p: ^ost$execution_control_block;


    syp$crack_command (dm_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT repress_headers_flag THEN

{ By placing these lines within the IF statement above, the DISFDC/DISFDT commands can display paged output to
{ the console, or correctly-labeled output to a permanent dump file.

      syv$db_displayed_console_lines := 0;
      syv$debug_line_count := 0;
      IF syv$dump_to_pf THEN
        syp$write_output_header (' DISPLAY MEMORY ', text);
      IFEND;
    IFEND;

    memory_access_in_bytes_p := #LOC (pvt [1].ptr^);
    last_dm_pva := #LOC (pvt [1].ptr^);
    last_dm_count := pvt [2].int;
    byte_number := #OFFSET (memory_access_in_bytes_p);
    segnum := #SEGMENT (memory_access_in_bytes_p);

    syp$verify_access (syc$readable, #LOC (memory_access_in_bytes_p), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_segment_length (memory_access_in_bytes_p, segment_length);
    segnum_hex := 'LENGTH         (16)';
    hex_string (segment_length, segnum_hex, 15);
    syp$write_output_line (segnum_hex, status);

    pmp$find_executing_task_xcb (xcb_p);
    sdtxe_p := mmp$get_sdtx_entry_p (xcb_p, segnum);
    wired_or_fixed_flag := (mmc$sa_wired IN sdtxe_p^.software_attribute_set) OR
          (mmc$sa_fixed IN sdtxe_p^.software_attribute_set);

    IF pvt [3].name <> 'F' THEN
      IF segment_length = 0 THEN
        dpp$put_next_line (id, ' Segment length = 0 - use F option', status);
      IFEND;
      IF (byte_number + pvt [2].int) > segment_length THEN
        IF byte_number >= segment_length THEN
          osp$set_status_abnormal ('DB', dbe$, 'address greater than file limit', status);
          RETURN;
        ELSE

{ Dump up to the segment length.

          pvt [2].int := segment_length - byte_number;
        IFEND;
      IFEND;
    ELSE
      IF NOT (mmc$sa_stack IN sdtxe_p^.software_attribute_set) THEN
        osp$set_status_abnormal ('DB', dbe$, ' F only allowed for stack segments', status);
        RETURN;
      ELSE
        syp$write_output_line (' dump forced ', status);
      IFEND;
    IFEND;

    segnum_hex := 'SEGMENT = 000(16)';
    hex_string (segnum, segnum_hex, 13);
    syp$write_output_line (segnum_hex, status);

    bytes_examined := 0;
    IF syv$dump_to_pf THEN

{ Column numbers and layout for permanent file and printed output:
{00000000   aaaa bbbb cccc dddd   aaaa bbbb cccc dddd   aaaa bbbb cccc dddd   aaaa bbbb cccc dddd   x........x
{2345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901........2
{        1         2         3         4         5         6         7         8         9         0        13

      display_line := ' 00000000   0000 0000 0000 0000   0000 0000 0000 0000   ';
      display_line (57, *) := '0000 0000 0000 0000   0000 0000 0000 0000';
      display_line_length := 132;
      j := 9;
    ELSE

{ Column numbers for display_memory to console:
{  '00000000   aaaa bbbb cccc dddd   aaaa bbbb cccc dddd   xxxxxxxxxxxxxxxx';
{   12345678901234567890123456789012345678901234567890123456789012345678901
{            1         2         3         4         5         6         7

      display_line := '00000000   0000 0000 0000 0000   0000 0000 0000 0000';
      display_line_length := 80;
      j := 8;
    IFEND;
    previous_display_line := display_line;

    assign_gap := FALSE;
    duplicate_line_count := 0;
    initial_line := TRUE;

  /dump_each_byte/
    WHILE bytes_examined < pvt [2].int DO
      IF wired_or_fixed_flag THEN
        #REAL_MEMORY_ADDRESS (#LOC (memory_access_in_bytes_p^ [bytes_examined].byte), rma);
        IF rma < 0 THEN
          IF NOT assign_gap THEN
            assign_gap := TRUE;
            assign_gap_start_offset := #OFFSET (#LOC (memory_access_in_bytes_p^ [bytes_examined].byte));

            IF duplicate_line_count <> 0 THEN
              STRINGREP (previous_display_line, length, ' ', duplicate_line_count, ' duplicate line(s)');
              syp$write_output_line (previous_display_line (1, length), status);
              duplicate_line_count := 0
            IFEND;

            IF NOT display_position [j].display_offset THEN

{ Part of a display_line has information which must be flushed.  Pad the unnecessary memory string with blanks
{ before displaying the line.

              j := j + 1;
              IF display_line_length = 80 THEN
                i := 53;
              ELSE
                i := 98;
              IFEND;
              WHILE j < i DO
                display_line (j) := ' ';
                j := j + 1;
              WHILEND;
              syp$write_output_line (display_line (1, display_line_length), status);
            IFEND;
          IFEND;
          bytes_examined := bytes_examined + 1;
          CYCLE /dump_each_byte/;
        ELSE {rma >= 0}
          IF assign_gap THEN
            assign_gap := FALSE;
            STRINGREP (display_line, length, '-- WARNING -- Memory from offset',
                  assign_gap_start_offset: #(16), '(16) to',
                  #OFFSET (#LOC (memory_access_in_bytes_p^ [bytes_examined].byte)): #(16),
                  '(16) is not assigned.');
            syp$write_output_line (display_line (1, length), status);
            IF display_line_length = 132 THEN
              display_line := ' 00000000   0000 0000 0000 0000   0000 0000 0000 0000   ';
              display_line (57, *) := '0000 0000 0000 0000   0000 0000 0000 0000';
              j := 9;
            ELSE
              display_line := '00000000   0000 0000 0000 0000   0000 0000 0000 0000';
              j := 8;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

      IF display_position [j].display_offset THEN
        hex_string (#OFFSET (#LOC (memory_access_in_bytes_p^ [bytes_examined].byte)), display_line, j);
      IFEND;

{ Convert the current byte to a hex representation and put it in the correct portion of the output string.

      hex_string (memory_access_in_bytes_p^ [bytes_examined].byte, display_line, display_position [j].
            position);
      #TRANSLATE (dm_control_codes_to_space, memory_access_in_bytes_p^ [bytes_examined].character,
            display_line (display_position [j].char_position));
      IF display_position [j].flush THEN
        IF (display_line (10, (display_line_length - 9)) =
              previous_display_line (10, (display_line_length - 9))) AND (NOT initial_line) THEN
          duplicate_line_count := duplicate_line_count + 1;
        ELSE
          IF duplicate_line_count <> 0 THEN
            STRINGREP (previous_display_line, length, ' ', duplicate_line_count, ' duplicate line(s)');
            syp$write_output_line (previous_display_line (1, length), status);
            duplicate_line_count := 0
          IFEND;
          syp$write_output_line (display_line (1, display_line_length), status);
          initial_line := FALSE;
          previous_display_line := display_line;
        IFEND;
        j := display_position [j].position;
        IF syv$dump_to_pf THEN
          display_line := ' 00000000   0000 0000 0000 0000   0000 0000 0000 0000   ';
          display_line (57, *) := '0000 0000 0000 0000   0000 0000 0000 0000';
        ELSE
          display_line := '00000000   0000 0000 0000 0000   0000 0000 0000 0000';
        IFEND;
      IFEND;
      j := display_position [j].position;
      bytes_examined := bytes_examined + 1;
    WHILEND /dump_each_byte/;

    IF wired_or_fixed_flag THEN
      IF assign_gap THEN
        STRINGREP (display_line, length, '-- WARNING -- Memory from offset',
              assign_gap_start_offset: #(16), '(16) to',
              #OFFSET (#LOC (memory_access_in_bytes_p^ [bytes_examined-1].byte)): #(16),
              '(16) is not assigned.');
        syp$write_output_line (display_line (1, length), status);
        RETURN; {no need to check for unflushed lines} {<----------------}
      IFEND;
    IFEND;

    IF duplicate_line_count <> 0 THEN
      STRINGREP (previous_display_line, length, ' ', duplicate_line_count, ' duplicate line(s)');
      syp$write_output_line (previous_display_line (1, length), status);
    IFEND;

    IF NOT display_position [j].display_offset THEN

{ Part of a display_line has information which must be flushed.  Pad the unnecessary memory string with blanks
{ before displaying the line.

      j := j + 1;
      IF display_line_length = 80 THEN
        i := 53;
      ELSE
        i := 98;
      IFEND;
      WHILE j < i DO
        display_line (j) := ' ';
        j := j + 1;
      WHILEND;
      syp$write_output_line (display_line (1, display_line_length), status);
    IFEND;

  PROCEND dmproc;
?? OLDTITLE ??
?? NEWTITLE := '  DOWN_VOLUME', EJECT ??

{
{ Purpose:
{   This procedure processes the DOWN_VOLUME command.  This will prevent use of the specified volume number.
{ The parameter for the command is as follows:
{        NUMBER: Required, integer.
{          Specifies the active volume table index of the volume which is to be DOWNed.
{


{ DOWN_VOLUME, UP_VOLUME parameter descriptor table:

  VAR
    down_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number  ', syc$integer_value, 1, 1, 7fffffff(16)]];

  PROCEDURE down_volume
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      avti: dmt$active_volume_table_index,
      pvt: array [1 .. 1] of syt$parameter_value;


    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (down_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    avti := pvt [1].int;

    IF dmv$active_volume_table.table_p^ [avti].mass_storage.volume_unavailable = TRUE THEN

{ Ignore request - the volume is already down.

      RETURN;
    IFEND;

    dmv$number_unavailable_volumes := dmv$number_unavailable_volumes + 1;
    dmv$active_volume_table.table_p^ [avti].mass_storage.volume_unavailable := TRUE;
    dmv$active_volume_table.table_p^ [avti].mass_storage.previous_allocation_allowed :=
          dmv$active_volume_table.table_p^ [avti].mass_storage.allocation_allowed;
    dmv$active_volume_table.table_p^ [avti].mass_storage.allocation_allowed := FALSE;

  PROCEND down_volume;
?? OLDTITLE ??
?? NEWTITLE := '  FIND_DBL_ENTRY', EJECT ??

{
{ Purpose:
{   This procedure assists the various breakpoint commands by finding the specified breakpoint name in the
{ debug breakpoint name list and returning an index into the list.
{        NAME: The name of the debug breakpoint which is to be located.
{        DBL_ENTRY: The value of the index into the debug breakpoint list whose entry contains the name which
{          must be located.
{        FOUND: A boolean value which describes whether or not the name was found in the debug list.
{

  PROCEDURE find_dbl_entry
    (    name: ost$name;
     VAR dbl_index: integer;
     VAR found: boolean);

    VAR
      i: integer;

    i := 1;
    WHILE i <= 32 DO
      IF syv$debug_list.sfwr_entry [i].name = name THEN
        dbl_index := i;
        found := TRUE;
        RETURN;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;
    found := FALSE;
    RETURN;
  PROCEND find_dbl_entry;
?? OLDTITLE ??
?? NEWTITLE := '  FIND_STACK_FRAME', EJECT ??

{
{ Purpose:
{   This procedure assists the DISPLAY_TRACE_BACK and DISPLAY_STACK commands by returning pointers to the
{ current_stack_frame and save_areas for the specified frame number.  The parameters for the command are as
{ follows:
{        FRAME_NUMBER: An integer specifying the frame number which is to be located.
{        CSF_P: A pointer to the found current stack frame for the specified frame.
{        SA_P: A pointer to the found save area for the specified frame.
{

  PROCEDURE find_stack_frame
    (    frame_number: integer;
     VAR csf_p: ^cell;
     VAR sa_p: ^cell);

    VAR
      n: integer,
      p: ^stack_frame_control_image,
      status: ost$status;

    n := frame_number;
    find_trapped_stack_frame (p);
    WHILE (p <> NIL) AND (n > 1) DO
      n := n - 1;
      syp$verify_access (syc$writeable, #LOC (p^.psa), status);
      IF NOT status.normal THEN
        p := NIL;
      ELSE
        p := p^.psa;
      IFEND;
    WHILEND;
    IF p <> NIL THEN
      syp$verify_access (syc$writeable, #LOC (p^.csf), status);
      IF NOT status.normal THEN
        csf_p := NIL;
      ELSE
        csf_p := p^.csf;
      IFEND;
      sa_p := p;
    ELSE
      csf_p := NIL;
      sa_p := NIL;
    IFEND;
  PROCEND find_stack_frame;
?? OLDTITLE ??
?? NEWTITLE := '  FIND_TRAPPED_STACK_FRAME', EJECT ??

{
{ Purpose:
{   This procedure returns a pointer to the trapped stack frame.  The parameters for the command are as
{ follows:
{        TRAPPED_SF: A pointer which is returned and which points the the trapped stack frame.
{

  PROCEDURE find_trapped_stack_frame
    (VAR trapped_sf: ^cell);

    trapped_sf := syv$debug_control.trapped_sfsa;

  PROCEND find_trapped_stack_frame;
?? OLDTITLE ??
?? NEWTITLE := '  GENERATE_DEBUG_TRAP_MESSAGE', EJECT ??

{
{ Purpose:
{   This procedure generates a message describing why a trap to the debugger was encountered.  It uses a
{ trapped stack frame and returns values describing
{        . whether or not the message should be displayed and the debugger invoked, and
{        . the message which would be displayed if the previous clause is TRUE.
{ The parameters for the command are as follows:
{        TRAPPED_SFSA_P: A pointer to the trapped stack frame which containes the information about the trap.
{        CONTACT_USER: A boolean returned to describe whether or not the debugger should be invoked.
{        MSG: A string returned describing the reason for the trap.
{        STATUS: VAR of ost$status
{

  PROCEDURE generate_debug_trap_message
    (    trapped_sfsa_p: ^stack_frame_control_image;
     VAR contact_user: boolean;
     VAR msg: string (60);
     VAR status: ost$status);

    VAR
      bflag: boolean,
      cond_id: string (8),
      cond_regs: condition_reg_image,
      dbl_p: ^debug_list,
      i: integer,
      preg: ost$pva,
      ucr_ord: ost$user_condition;

    status.normal := TRUE;
    dbl_p := ^syv$debug_list;
    contact_user := TRUE;
    msg := 'xxxxxxxx FAULT ( mcr/ucr) AT P=0 000 00000000';

{ Extract p-address from trapped stack frame and set into the two messages which may (potentially) be issued.

    preg := trapped_sfsa_p^.p_reg.pva;
    hex_string (preg.ring, msg, 32);
    hex_string (preg.seg, msg, 36);
    hex_string (preg.offset, msg, 45);

{ Extract the image of the user-condition and monitor-condition registers from trapped stack frame and save it
{ in cond_regs.

    cond_regs.ucr_a := trapped_sfsa_p^.user_condition;
    cond_regs.mcr_a := trapped_sfsa_p^.monitor_condition;

{ Test for monitor condition fault.

    IF cond_regs.mcr_i <> 0 THEN
      IF cond_regs.mcr_a [osc$instruction_spec] = TRUE THEN
        cond_id := 'instruct';
      ELSEIF cond_regs.mcr_a [osc$address_specification] = TRUE THEN
        cond_id := 'address ';
      ELSEIF cond_regs.mcr_a [osc$access_violation] = TRUE THEN
        cond_id := 'access  ';
      ELSEIF cond_regs.mcr_a [osc$environment_spec] = TRUE THEN
        cond_id := 'environ ';
      ELSEIF cond_regs.mcr_a [osc$invalid_segment_ring_0] = TRUE THEN
        cond_id := 'inv seg ';
      ELSEIF cond_regs.mcr_a [osc$out_call_in_return] = TRUE THEN
        cond_id := 'ocl/irtn';
      IFEND;
      msg (1, 8) := cond_id (1, 8);
      RETURN;
    IFEND;

{ Test for unmaskable user condition fault (except free flag and PIT).

    cond_id := '        ';
    IF cond_regs.ucr_a [osc$privileged_instruction] = TRUE THEN
      cond_id := 'priv ins';
    ELSEIF cond_regs.ucr_a [osc$unimplemented_instruction] = TRUE THEN
      cond_id := 'unim ins';
    ELSEIF cond_regs.ucr_a [osc$inter_ring_pop] = TRUE THEN
      cond_id := 'ir pop  ';
    ELSEIF cond_regs.ucr_a [osc$critical_frame_flag] = TRUE THEN
      cond_id := 'cf flag ';
    ELSEIF cond_regs.ucr_a [osc$keypoint] = TRUE THEN
      cond_id := 'keypoint';
    IFEND;
    IF cond_id <> '        ' THEN
      msg (1, 8) := cond_id (1, 8);
      RETURN;
    IFEND;

{ Test for maskable user condition fault.

    bflag := FALSE;
    ucr_ord := osc$divide_fault;

    WHILE (bflag = FALSE) AND (ucr_ord <= osc$invalid_bdp_data) DO
      IF cond_regs.ucr_a [ucr_ord] = TRUE THEN
        bflag := TRUE;
      ELSE
        ucr_ord := SUCC (ucr_ord);
      IFEND;
    WHILEND;

{ A maskable user condition fault is set.  Test for the hardware debug condition.

    IF ucr_ord = osc$debug THEN
      msg (1, 8) := 'debug   ';
      i := #READ_REGISTER (osc$pr_debug_index);
      i := (i DIV 2) + 1;
      msg (17, 8) := dbl_p^.sfwr_entry [i].name (1, 8);
      RETURN;
    IFEND;

{ The set maskable user condition is not the hardware debug condition.  If the maskable condition has been
{ selected via a breakpoint, issue a notification message. Otherwise, return immediately to the trap handler.

    i := 1;

    WHILE i <= 32 DO
      IF (dbl_p^.sfwr_entry [i].segment = preg.seg) AND (preg.offset >= dbl_p^.sfwr_entry [i].lobyte) AND
            (preg.offset <= dbl_p^.sfwr_entry [i].hibyte) AND
            (dbl_p^.sfwr_entry [i].condition [cond_conv_tbl2 [ucr_ord].c_ord] = TRUE) THEN
        msg (1, 8) := cond_conv_tbl2 [ucr_ord].name (1, 8);
        msg (17, 8) := dbl_p^.sfwr_entry [i].name (1, 8);
        RETURN;
      ELSE
        i := i + 1;
      IFEND;
    WHILEND;
    contact_user := FALSE;
    RETURN;
  PROCEND generate_debug_trap_message;
?? OLDTITLE ??
?? NEWTITLE := '  GET_SEGMENT_LENGTH', EJECT ??

{
{ Purpose:
{   This procedure returns the segment length of the specified segment.
{        P: A pointer to the segment whose length must be returned.
{        LEN: An integer value returned which describes the segment length.
{

  PROCEDURE get_segment_length
    (    p: ^cell;
     VAR len: integer);

    VAR
      segl: ost$segment_length,
      status: ost$status;

    status.normal := TRUE;

    IF mmv$tables_initialized THEN
      mmp$get_segment_length_r1 (#segment (p), 1, segl, status);
      IF status.normal THEN
        len := segl;
      ELSE
        len := 0;
      IFEND;
    ELSE

{ Memory manager tables are not initialized, therefore assume length equal to maximum offset.
{ This assumes the debug user does not make a mistake.

      len := 7fffffff(16);
    IFEND;


  PROCEND get_segment_length;
?? OLDTITLE ??
?? NEWTITLE := '  HANGPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the HANG_TASK command.  It causes the task to hang in an infinite delay loop when
{ the system core debugger is exited.  The task is left in a state where it can be reentered at a later time.
{ There are no parameters for the command.
{

  PROCEDURE hangproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      hang_task: ^boolean,
      str: string (60);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' HANG TASK ', text);
    IFEND;

    IF (syv$job_template_ptr_array = NIL) OR (UPPERBOUND (syv$job_template_ptr_array^) < 3) THEN
      osp$set_status_abnormal ('DB', dbe$, ' not available', status);
      RETURN;
    IFEND;
    hang_task := syv$job_template_ptr_array^ [3];
    IF hang_task^ THEN
      syp$write_output_line ('hang task cleared', status);
      hang_task^ := FALSE;
    ELSE
      syp$write_output_line ('hang task set', status);
      hang_task^ := TRUE;
    IFEND;
    status.normal := TRUE;

  PROCEND hangproc;
?? OLDTITLE ??
?? NEWTITLE := '  HELPPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the HELP command.  It accesses the system core debugger HELP file at any time
{ after starting the system core debugger.  It can describe a single command or all commands, and the aliases
{ and parameters of the command(s).  The parameter for the command is as follows:
{        NAME: Optional, name.
{          Specifies the name of the command about which information must be returned.  The default value is
{          all commands (information about all commands will be displayed).
{


{ HELP parameter descriptor table:

  VAR
    help_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'name   ', syc$name_value, * ]];

  PROCEDURE helpproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      i: integer,
      j: integer,
      k: integer,
      len: integer,
      msg: string (80),
      pvt: array [1 .. 1] of syt$parameter_value,
      str: string (60);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (help_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' HELP FUNCTION ', text);
    IFEND;

    msg := '  Summary of Debug Command(s)';
    syp$write_output_line (msg, status);
    msg := '  ';
    syp$write_output_line (msg, status);
    msg := '  ALIAS       NOMINAL NAME';
    syp$write_output_line (msg, status);
    msg := '  parameter   parameter   parameter   parameter   parameter   parameter ...';
    syp$write_output_line (msg, status);
    msg := '  =========================================================================';
    syp$write_output_line (msg, status);

    IF (NOT pvt [1].defined) THEN

    /display_command/
      FOR i := LOWERBOUND (command_table) TO UPPERBOUND (command_table) DO
        IF command_table [i].short_name = 'dummy   ' THEN
          CYCLE /display_command/;
        IFEND;
        msg := '   ';
        msg (3, * ) := command_table [i].short_name;
        msg (15, * ) := command_table [i].long_name;
        syp$write_output_line (msg, status);
        IF param_table [i] <> NIL THEN
          msg := '   ';
          k := 3;
          FOR j := LOWERBOUND (param_table [i]^) TO UPPERBOUND (param_table [i]^) DO
            IF (k + #SIZE (param_table [i]^ [j].keyword)) < #SIZE (msg) THEN
              msg (k, * ) := param_table [i]^ [j].keyword;
              k := k + 12;
            IFEND;
          FOREND;
          syp$write_output_line (msg, status);
        IFEND;
      FOREND /display_command/;
    ELSE
      FOR i := LOWERBOUND (command_table) TO UPPERBOUND (command_table) DO
        IF ((pvt [1].name = command_table [i].short_name) OR (pvt [1].name = command_table [i].long_name))
              THEN
          msg := '   ';
          msg (3, * ) := command_table [i].short_name;
          msg (15, * ) := command_table [i].long_name;
          syp$write_output_line (msg, status);
          IF param_table [i] <> NIL THEN
            msg := '   ';
            k := 3;
            FOR j := LOWERBOUND (param_table [i]^) TO UPPERBOUND (param_table [i]^) DO
              IF (k + #SIZE (param_table [i]^ [j].keyword)) < #SIZE (msg) THEN
                msg (k, * ) := param_table [i]^ [j].keyword;
                k := k + 12;
              IFEND;
            FOREND;
            syp$write_output_line (msg, status);
          IFEND;
          RETURN;
        IFEND;
        IF i = UPPERBOUND (command_table) THEN
          msg := '  ';
          msg (3, * ) := ' unknown command name';
          syp$write_output_line (msg, status);
        IFEND;
      FOREND;
    IFEND;

  PROCEND helpproc;
?? OLDTITLE ??
?? NEWTITLE := '  HEX_STRING', EJECT ??

{
{ Purpose:
{   This procedure converts an integer into a hexidecimal string value and places it in a specified position
{ within a string.  The parameters for the command are as follows:
{        XI: The integer value which will be converted into a hexidecimal string value.
{        S: The string value which will be returned and represents the hexidecimal value of the inputted
{          integer.
{        XPOS: The position within the returned string at which the hexidecimal string value of the inputted
{          integer will be placed.
{

  PROCEDURE hex_string
    (    xi: integer;
     VAR s: string ( * );
         xpos: 0 .. 255);

    VAR
      ch: char,
      i: integer,
      k: integer,
      pos: 0 .. 255;

    i := xi;
    pos := xpos;
    WHILE (i <> 0) AND (pos > 0) DO
      k := i MOD 16;
      IF k <= 9 THEN
        ch := $CHAR (k + $INTEGER ('0'));
      ELSE
        ch := $CHAR (k - 10 + $INTEGER ('A'));
      IFEND;
      s (pos) := ch;
      i := i DIV 16;
      pos := pos - 1;
    WHILEND;
  PROCEND hex_string;
?? OLDTITLE ??
?? NEWTITLE := '  KILL_TASK_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the KILL_TASK command.  It allows an operator or site analyst to abort a specifed
{ task.  The parameters for the command are as follows:
{        FRAME: Optional, integer.
{          Specifies a stack frame which will be "damaged" in order to cause the task to abort.  The default
{          value allows the debugger to determine a "safe" stack frame which can be damaged.
{        RING: Optional, integer.
{          Specifies a ring number in which the first stack frame is to be "damaged".  If the frame is
{          specified, this parameter is ignored.  A task cannot be aborted at ring 1.
{        NO_CH: Optional, boolean.
{          Specifies a whether the stack chain should be "broken" to prevent the invocation of condition
{          handlers during the task termination.
{

  TYPE
    trick_ptr_variant = record
      case 0 .. 2 of
      = 0 =
        cell_p: ^cell,
      = 1 =
        intermediate_p: ^ost$stack_frame_save_area,
      = 2 =
        sfsa_p: ^ost$minimum_save_area,
      casend,
    recend,

    binding_section_record = record
      fill: 0 .. 0ffff(16),
      pva: ost$pva,
    recend,

    trick_procedure_ptr_variant = record
      case 0 .. 1 of
      = 0 =
        procedure_p: ^procedure,
      = 1 =
        binding_section_p: ^binding_section_record,
        static_link: ost$pva,
      casend,
    recend;


{ KILL_TASK parameter descriptor table:

  VAR
    kilt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'frame  ', syc$integer_value, 0, 0, 0ffffffff(16)],
{   } [FALSE, 2, 'ring   ', syc$integer_value, 0, 0, 0f(16)],
{   } [FALSE, 3, 'no_ch  ', syc$boolean_value, FALSE]];

  PROCEDURE kill_task_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

?? NEWTITLE := '    KILL_TASK_CH {condition handler} ', EJECT ??

    PROCEDURE kill_task_ch
      (    mf: ost$monitor_fault;
           ctc: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        ignore_status: ost$status,
        s: string (40);

      IF NOT mmv$tables_initialized THEN
        osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
        RETURN;
      IFEND;

      s := ' Kill_task command failure- try again';
      IF NOT syv$dump_to_pf THEN
        dpp$put_next_line (display_id, s, ignore_status);
      ELSE
        osp$output_debug_text (^s, ignore_status);
      IFEND;
      status.normal := FALSE;
      EXIT kill_task_proc;
    PROCEND kill_task_ch;
?? OLDTITLE, EJECT ??

    VAR
      index: integer,
      procedure_ptr_converter: trick_procedure_ptr_variant,
      pvt: array [1 .. 3] of syt$parameter_value,
      saved_ring_number: 0 .. 0f(16),
      sfsa_converter: trick_ptr_variant;

    syp$establish_condition_handler (^kill_task_ch);
    syp$crack_command (kilt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    sfsa_converter.cell_p := syv$debug_control.trapped_sfsa;
    procedure_ptr_converter.procedure_p := ^i#program_error;

{ Search for the correct SFSA to damage.

    IF pvt [1].defined THEN

{ Use the frame number specified in the call to this command processor.

      index := 1;
      WHILE (index <> pvt [1].int) AND (sfsa_converter.sfsa_p^.a2_previous_save_area <> NIL) DO
        index := index + 1;
        sfsa_converter.intermediate_p := sfsa_converter.sfsa_p^.a2_previous_save_area;
      WHILEND;
      IF index <> pvt [1].int THEN

{ The specified frame number was too large.  Return an error status.

        dpp$put_next_line (display_id, 'Stack not large enough for specified frame number', status);
        osp$set_status_abnormal ('DB', dbe$, 'Stack not large enough for specified frame number', status);
        RETURN;
      IFEND;
    ELSEIF pvt [2].defined THEN

{ Use the ring number specified in the call to this command processor.

      WHILE (sfsa_converter.sfsa_p^.a2_previous_save_area <> NIL) AND
            (sfsa_converter.sfsa_p^.p_register.pva.ring <> pvt [2].int) DO
        sfsa_converter.intermediate_p := sfsa_converter.sfsa_p^.a2_previous_save_area;
      WHILEND;
      IF sfsa_converter.sfsa_p^.p_register.pva.ring <> pvt [2].int THEN

{ The specified ring number did not have a stack associated with it.  Return an error status.

        dpp$put_next_line (display_id, 'Stack does not exist for specified ring number', status);
        osp$set_status_abnormal ('DB', dbe$, 'Stack does not exist for specified ring number', status);
        RETURN;
      IFEND;
    ELSE

{ Search for the first "safe" frame, i.e. any frame above ring three (3).

      WHILE (sfsa_converter.sfsa_p^.a2_previous_save_area <> NIL) AND
            (sfsa_converter.sfsa_p^.p_register.pva.ring < 3) DO
        sfsa_converter.intermediate_p := sfsa_converter.sfsa_p^.a2_previous_save_area;
      WHILEND;
      IF sfsa_converter.sfsa_p^.p_register.pva.ring < 3 THEN

{ There is no stack frame at or above Ring THREE (3) which can be damaged.  Return an error status.

        dpp$put_next_line (display_id, 'No stack frame >= ring 3 was found; unable to kill task', status);
        osp$set_status_abnormal ('DB', dbe$, 'No stack frame >= ring 3 was found; unable to kill task',
              status);
        RETURN;
      IFEND;
    IFEND;

    IF sfsa_converter.sfsa_p^.p_register.pva.ring = 1 THEN

{ We are not allowed to kill a task running at Ring ONE (1).  Return an error status.

      dpp$put_next_line (display_id, 'Stack frame = ring 1 found/specified; unable to kill task', status);
      osp$set_status_abnormal ('DB', dbe$, 'Stack frame = ring 1 found/specified; unable to kill task',
            status);
      RETURN;
    IFEND;

{ If execution reaches this point, a stack frame has been found which can be damaged.  Do so, but remember to
{ retain the correct ring number of the P_Register.

    saved_ring_number := sfsa_converter.sfsa_p^.p_register.pva.ring;
    sfsa_converter.sfsa_p^.p_register.pva := procedure_ptr_converter.binding_section_p^.pva;
    sfsa_converter.sfsa_p^.p_register.pva.ring := saved_ring_number;

{ If desired, cut off all condition handlers from the task which will die.

    IF pvt [3].defined AND pvt [3].bool THEN
      sfsa_converter.sfsa_p^.a2_previous_save_area := NIL;
    IFEND;

  PROCEND kill_task_proc;
?? OLDTITLE ??
?? NEWTITLE := '  LIST_BREAKPOINTS', EJECT ??

{
{ Purpose:
{   This procedure processes the LIST_BREAKPOINTS command.  It lists the currently active breakpoints by name
{ with their associated conditions, the segment number, and the first and last byte in which the breakpoint is
{ active.  The parameter for the command is as follows:
{        PARAMETER: Optional, name.
{          Specifies a breakpoint name.  The conditions for this breakpoint are displayed.  The default system
{          core debugger display is all active breakpoint names and their conditions.
{


{ LIST_BREAKPOINTS parameter descriptor table:

  VAR
    display_brkpt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'name    ', syc$name_value, * ]];

  PROCEDURE list_breakpoints
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      dbl_index: integer,
      dbl_p: ^debug_list,
      i: integer,
      line: string (18),
      name_found: boolean,
      no_brkpts_set: boolean,
      pvt: array [1 .. 1] of syt$parameter_value,
      str: string (60);

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    no_brkpts_set := TRUE;
    syp$crack_command (display_brkpt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' LIST BREAKPOINTS ', text);
    IFEND;

    dbl_p := ^syv$debug_list;
    CASE pvt [1].defined OF

    = TRUE =

      find_dbl_entry (pvt [1].name, dbl_index, name_found);
      IF name_found = FALSE THEN
        osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_name', status);
      ELSE
        print_brkpt (dbl_p, dbl_index, status);
      IFEND;
      RETURN;

    = FALSE =

      line (1, 18) := 'NO BREAKPOINTS SET';
      FOR i := 1 TO 32 DO
        IF dbl_p^.sfwr_entry [i].name <> '        ' THEN
          no_brkpts_set := FALSE;
          print_brkpt (dbl_p, i, status);
          IF NOT status.normal THEN
            RETURN
          IFEND;
        IFEND;
      FOREND;
      IF no_brkpts_set = TRUE THEN
        syp$write_output_line (line, status);
      IFEND;
      RETURN;
    CASEND;
  PROCEND list_breakpoints;
?? OLDTITLE ??
?? NEWTITLE := 'log_system_core_text', EJECT ??

{ PURPOSE:
{   This procedure is called during debug command processing to log text to the system log.

  PROCEDURE log_system_core_text
    (    text: string (*));

    VAR
      ignore_status: ost$status,
      log_time: ost$time,
      trim_size: integer;

    IF NOT syv$inhibit_core_cmd_logging THEN
      FOR trim_size := STRLENGTH (text) DOWNTO 1 DO
        IF text (trim_size) <> ' ' THEN
          lgp$add_entry_to_system_log (pmc$msg_origin_system, text (1, trim_size), log_time, ignore_status);
          RETURN;
        IFEND;
      FOREND;
    IFEND;

  PROCEND log_system_core_text;
?? OLDTITLE ??
?? NEWTITLE := '  MINUSPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the MINUS ('-') command.  It decrements the most recent DM subcommand starting
{ address by the most recent value of the length parameter.  This allows a user to page backward through
{ virtual memory.  There are no parameters for this command.
{

  PROCEDURE minusproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      i: integer,
      pc: ^cell,
      s: string (40),
      str: string (60);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' MINUS ', text);
    IFEND;

    IF last_dm_pva = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'no prior DM command', status);
      RETURN;
    IFEND;

    s := '   ';
    i := #OFFSET (last_dm_pva) - last_dm_count;
    IF i < 0 THEN
      osp$set_status_abnormal ('DB', dbe$, 'address went negative', status);
      RETURN;
    IFEND;
    pc := #ADDRESS (#RING (last_dm_pva), #SEGMENT (last_dm_pva), i);
    syp$convert_bytes (#LOC (pc), 6, s (1, 12), FALSE);
    STRINGREP (s (15, 10), i, last_dm_count);
    dmproc (s, display_id, status);
    IF status.normal THEN
      str := 'DISM ';
      str (6, * ) := s;
      save_repeatable_command (str);
    IFEND;

  PROCEND minusproc;
?? OLDTITLE ??
?? NEWTITLE := '  MOD_BREAKPOINT', EJECT ??

{
{ Purpose:
{   This procedure processes the CHANGE_BREAKPOINT command.  It changes the virtual memory address range of a
{ previously established breakpoint. The parameters for the command are as follows:
{        NAME: Required, name.
{          Specifies the user-supplied name for the breakpoint.  Breakpoint names are a maximum of eight
{          characters in length.
{        BASE: Required, pointer.
{          Specifies the virtual memory address (PVA) of the breakpoint.  This is an 11-digit hexadecimal
{          number addressing a specific byte of memory.
{        OFFSET: Optional, integer.
{          Specifies the number of bytes from the address at which the breakpoint becomes effective.  The
{          specified address plus the offset yields the first byte address of the virtual memory address range
{          for the breakpoint.  The default is 0.
{        LENGTH: Optional, integer.
{          Specifies the number of bytes for which the breakpoint is valid.  The specified address plus the
{          offset plus the length - 1 yields the last byte address of the virtual memory address range.  The
{          default is 1.
{


{ CHANGE_BREAKPOINT parameter descriptor table:

  VAR
    change_brkpt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 4] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'name    ', syc$name_value, * ],
{   } [TRUE, 2, 'address ', syc$pointer_value, NIL],
{   } [FALSE, 3, 'offset  ', syc$integer_value, 0, 0, 7fffffff(16)],
{   } [FALSE, 4, 'length  ', syc$integer_value, 1, 1, 7fffffff(16)]];

  PROCEDURE mod_breakpoint
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      dbl_index: integer,
      dbl_p: ^debug_list,
      hibyte: integer,
      lobyte: integer,
      name_found: boolean,
      pvt: array [1 .. 4] of syt$parameter_value,
      segnum: 0 .. 4095,
      str: string (60);

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (change_brkpt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' CHANGE BREAKPOINT ', text);
    IFEND;


{ Search the debug list for the command-specified breakpoint name.  Return if the name is not found.

    dbl_p := ^syv$debug_list;
    find_dbl_entry (pvt [1].name, dbl_index, name_found);
    IF name_found = FALSE THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_name', status);
      RETURN;
    IFEND;

{ Calculate address range and test validity.  Return if invalid.

    lobyte := #OFFSET (pvt [2].ptr);
    lobyte := lobyte + pvt [3].int;
    hibyte := (lobyte + pvt [4].int) - 1;
    IF ((lobyte < 0) OR (lobyte > 7fffffff(16))) OR ((hibyte < 0) OR (hibyte > 7fffffff(16))) OR
          (lobyte > hibyte) THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_addrs_range', status);
      RETURN;
    IFEND;

{ Change the address bracket of the breakpoint.

    segnum := #SEGMENT (pvt [2].ptr);
    dbl_p^.sfwr_entry [dbl_index].segment := segnum;
    dbl_p^.sfwr_entry [dbl_index].lobyte := lobyte;
    dbl_p^.sfwr_entry [dbl_index].hibyte := hibyte;

    dbl_p^.hdwr_entry [dbl_index].segment := segnum;
    dbl_p^.hdwr_entry [dbl_index].lobyte := lobyte;
    dbl_p^.hdwr_entry [dbl_index].hibyte := hibyte;

    update_debug_masks;

  PROCEND mod_breakpoint;
?? OLDTITLE ??
?? NEWTITLE := '  PLUSPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the PLUS ('+') command.  It increments the most recent DM subcommand starting
{ address by the most recent value of the length parameter.  This allows a user to page forward through
{ virtual memory.  There are no parameters for this command.
{

  PROCEDURE plusproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      i: integer,
      pc: ^cell,
      s: string (40),
      str: string (60);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' PLUS ', text);
    IFEND;

    IF last_dm_pva = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'no prior DM command', status);
      RETURN;
    IFEND;

    s := '   ';
    pc := #ADDRESS (#RING (last_dm_pva), #SEGMENT (last_dm_pva), #OFFSET (last_dm_pva) + last_dm_count);
    syp$convert_bytes (#LOC (pc), 6, s (1, 12), FALSE);
    STRINGREP (s (15, 10), i, last_dm_count);
    dmproc (s, display_id, status);
    IF status.normal THEN
      str := 'DISM ';
      str (6, * ) := s;
      save_repeatable_command (str);
    IFEND;

  PROCEND plusproc;
?? OLDTITLE ??
?? NEWTITLE := '  PRINT_BRKPT', EJECT ??

{
{ Purpose:
{   This procedure prints the specified breakpoint and the all of the information associated with it.
{        DBL_P: A pointer to the debug breakpoint name list which will be accessed for the specified
{          breakpoint entry.
{        DBL_I: The value of the index into the debug breakpoint list whose entry contains the name which
{          must be located.
{        STATUS: VAR of ost$status
{

  PROCEDURE print_brkpt
    (    dbl_p: ^debug_list;
         dbl_i: integer;
     VAR status: ost$status);

    VAR
      blank: string (4),
      j: debug_condition,
      line: string (46),
      str_i: integer,
      ucr_ord: ost$user_condition;

    status.normal := TRUE;
    ;
    blank := '    ';

    line (1, 46) := 'ID=xxxxxxxx  SEG=000  FB=00000000  LB=00000000';
    line (4, 8) := dbl_p^.sfwr_entry [dbl_i].name (1, 8);
    hex_string (dbl_p^.sfwr_entry [dbl_i].segment, line, 20);
    hex_string (dbl_p^.sfwr_entry [dbl_i].lobyte, line, 33);
    hex_string (dbl_p^.sfwr_entry [dbl_i].hibyte, line, 46);
    syp$write_output_line (line (1, 46), status);

    line (1, 46) := '                                              ';
    str_i := 2;
    FOR j := dc_read TO dc_invbdp DO
      IF dbl_p^.sfwr_entry [dbl_i].condition [j] = TRUE THEN
        cond_ord_to_ucr_ord (j, ucr_ord, line (str_i, 8));
        IF (str_i + 17) > 46 THEN
          syp$write_output_line (line, status);
          str_i := 2;
          line (1, 46) := '                                              ';
        ELSE
          str_i := str_i + 10;
        IFEND;
      IFEND;
    FOREND;
    IF str_i > 2 THEN
      syp$write_output_line (line, status);
    IFEND;
    RETURN;
  PROCEND print_brkpt;
?? OLDTITLE ??
?? NEWTITLE := '  PROCESS_COMMANDS', EJECT ??

{
{ Purpose:
{   This procedure is the main procedure which sets up/cleans up the debug environment for the task(s) which
{ enter/exit the system core debugger.  Additionally, it contains the main REPEAT loop which keeps the task in
{ the debugger until it can continue to execute or it is 'HANGed" or "KILLed".  Only one task can be debugged
{ at a time; additional tasks will queue up waiting for the debugger lock.  The parameters for the procedure
{ are as follows:
{        SFSA_P: A pointer to the stack frame save area in which a trap occured which required the invocation
{          of the system core debugger.
{        STR: An eight-character string describing the reason for the invocation of the system core debugger;
{          i.e. a trap or a command.
{        OPTIONAL_MES: A string value which is displayed only if it is non-blank.
{        DUMP_JOB_ENVIRONMENT: A boolean value which describes whether this procedure is the result of a
{          DUMPJOB command.
{        STATUS: VAR of ost$status.
{

  PROCEDURE process_commands
    (    sfsa_p: ^cell;
         str: string (8);
         optional_mes: string ( * );
         dump_job_environment: boolean;
     VAR status: ost$status);

    VAR
      continue: boolean,
      delay: tmt$rb_delay,
      display_status: ost$status,
      entry_timestamp: integer,
      hr_save: 0 .. 255,
      i: integer,
      ignore_status: ost$status,
      local_debug_output_disposition: syt$debug_output_disposition,
      lock: [STATIC] ost$signature_lock,
      lock_status: ost$status,
      mes2: string (60),
      mf: tmt$monitor_fault_buffer,
      number_of_window_lines: dpt$number_of_window_lines,
      oldte: 0 .. 3,
      open_lock: [STATIC] ost$signature_lock,
      pb: ^boolean,
      sls: ost$signature_lock_status,
      system_log_p: ^cell,
      syv$run_all_timestamp: [XDCL, oss$job_fixed] integer,
      update_debug_rb: tmt$rb_update_job_task_enviro,
      xcb_p: ^ost$execution_control_block;

    IF syv$nosve_job_template THEN

{ Update to allow job recovery

      syv$job_template_ptr_array := nosve_template_ptr_array;
    IFEND;
    IF syv$dflt_debug_output_disposal.disposal = syc$dod_null THEN
      local_debug_output_disposition := syv$debug_output_disposition;
    ELSE
      local_debug_output_disposition := syv$dflt_debug_output_disposal.disposal;
    IFEND;
    mes2 := 'Queued     mmmmmmmm jjjjjjj, ttttttttttttttttttttttttttttttt';
    mes2 (12, 8) := str;
    mes2 (21, 7) := jmv$jcb.jobname;
    pmp$find_executing_task_xcb (xcb_p);
    mes2 (30, 31) := xcb_p^.save9; {taskname}
    osp$set_signature_lock (open_lock, osc$wait, ignore_status);
    IF NOT syv$debug_control.debug_active THEN
      syv$debug_control.trap_proc := ^debug_trap_processor;
      syv$debug_control.trapped_sfsa := sfsa_p;
      syv$debug_control.debug_list_p := ^syv$debug_list;
      syv$debug_control.high_ring_for_debug := 3;

      FOR i := 1 TO 32 DO
        syv$debug_list.sfwr_entry [i].name := '        ';
      FOREND;
      dpp$open_window (dpc$wc_invisible, dpc$wk_interactive, 'SYSTEM CORE DEBUGGER', display_id, status);
      syv$debug_control.debug_active := TRUE;
    IFEND;
    osp$clear_signature_lock (open_lock, ignore_status);
    osp$test_signature_lock (lock, sls);
    IF sls = osc$sls_locked_by_current_task THEN
      dpp$put_next_line (display_id, ' Recursive call to sysdebug - ignored.', status);
      osp$set_status_abnormal ('DB', dbe$, 'recursive call to SYSDEBUG', status);
      RETURN;
    IFEND;
    osp$set_signature_lock (lock, osc$nowait, ignore_status);
    IF NOT ignore_status.normal THEN
      dpp$put_next_line (display_id, mes2, status);
      entry_timestamp := #FREE_RUNNING_CLOCK (0);
      REPEAT
        pmp$delay (2000, status);
        IF syv$run_all_timestamp >= entry_timestamp THEN
          mes2 (1, 8) := 'Dequeued';
          dpp$put_next_line (display_id, mes2, status);
          RETURN;
        ELSE
          lock_status.normal := TRUE;
          osp$set_signature_lock (lock, osc$nowait, lock_status);
        IFEND;
      UNTIL lock_status.normal;
    IFEND;

    dpp$change_window (display_id, dpc$wc_pre_empt, dpc$wk_interactive, status);
    IF syv$debugger_page_wait_lines <> 0 THEN
      syv$db_page_wait_lines_instance := syv$debugger_page_wait_lines;
    ELSE

{ Have to calculate the number of displayable lines.

      dpp$get_number_lines_in_window (display_id, number_of_window_lines, status);
      syv$db_page_wait_lines_instance := number_of_window_lines;
      IF status.normal THEN
        syv$debugger_display_id := display_id;
      IFEND;
    IFEND;

    syv$dump_to_pf := (local_debug_output_disposition <> syc$dod_null);
    syv$debug_output_disposal_info.output_destination := local_debug_output_disposition;
    mes2 (1, 10) := 'Processing';
    syv$debug_control.trapped_sfsa := sfsa_p;

{ NOTE:
{ Save, clear and restore monitor faults (see also DISMFPROC).  This must be done on entry and exit of system
{ debugger.  Also, MONITOR_FAULTS is a (mainframe scope) static variable (for dismfproc).  This is (sort of) a
{ kludge.

    monitor_faults := xcb_p^.monitor_faults;
    FOR i := LOWERBOUND (xcb_p^.monitor_faults.present) TO UPPERBOUND (xcb_p^.monitor_faults.present) DO
      xcb_p^.monitor_faults.reserved [i] := FALSE;
      xcb_p^.monitor_faults.present [i] := FALSE;
    FOREND;

    hr_save := mtv$halt_cpu_ring_number;
    mtv$halt_cpu_ring_number := 0;
    REPEAT
      est_flag := FALSE;
      repress_headers_flag := FALSE;
      syv$debugger_task_timeout := FALSE;

{ If this is not a device_management task then we can log debugger commands to the system log.

      system_log_p := #ADDRESS (1, osc$segnum_system_dayfile, 0);
      syp$verify_access (syc$readable, ^system_log_p, status);
      IF NOT status.normal THEN
        syv$inhibit_core_cmd_logging := TRUE;
      ELSE
        syv$inhibit_core_cmd_logging := FALSE;
      IFEND;
      status.normal := TRUE;

      syv$db_displayed_console_lines := 0;
      i#enable_traps (oldte);
      process_debug_task (sfsa_p, str, optional_mes, dump_job_environment, mes2, status);
      IF (NOT status.normal) AND syv$debugger_task_timeout THEN
        dpp$put_next_line (display_id, 'Debugger command timeout condition encountered; command aborted',
              display_status);
        osp$end_text_dump;
        syv$dump_to_pf := FALSE;
        syv$debug_output_disposal_info.output_destination := syc$dod_null;
      IFEND;
      syv$db_displayed_console_lines := 0;
      i#restore_traps (oldte);
    UNTIL status.normal;

    IF syv$dump_to_pf THEN
      osp$end_text_dump;
      syv$dump_to_pf := FALSE;
      syv$debug_output_disposal_info.output_destination := syc$dod_null;
    IFEND;

{ Get ready to restore monitor faults.

    mf := monitor_faults;

    IF mtv$halt_cpu_ring_number = 0 THEN

{ Restore only if not changed during debug.

      mtv$halt_cpu_ring_number := hr_save;
    IFEND;
    last_dm_pva := NIL;
    dpp$change_window (display_id, dpc$wc_invisible, dpc$wk_interactive, status);
    osp$clear_signature_lock (lock, ignore_status);

    IF (syv$job_template_ptr_array <> NIL) AND (UPPERBOUND (syv$job_template_ptr_array^) >= 3) THEN
      pb := syv$job_template_ptr_array^ [3];
      IF pb^ THEN
{!      syp$write_output_line ('DEBUGGER EXIT - TASK LEFT HUNG !!', status);
        i#enable_traps (oldte);
        WHILE pb^ DO
          delay.reqcode := syc$rc_delay;
          delay.expected_wait_time := 100000000 * 1000;
          delay.requested_wait_time := delay.expected_wait_time + #FREE_RUNNING_CLOCK (0);
          i#call_monitor (#LOC (delay), #SIZE (delay));
        WHILEND;
{!      syp$write_output_line ('DEBUGGER EXIT - HUNG TASK CLEARED !!', status);
        i#restore_traps (oldte);
      IFEND;
    IFEND;

{ Restore monitor faults.

    xcb_p^.monitor_faults := mf;

  PROCEND process_commands;
?? OLDTITLE ??
?? NEWTITLE := '  PROCESS_DEBUG_TASK', EJECT ??

{
{ Purpose:
{   This procedure is the procedure which allows interactive processing of commands for the task(s) which
{ enter the system core debugger.  Additionally, it allows the non-interactive processing of DUMPJOB commands
{ and "dump_when_debug" dumps.  The parameters for the procedure are as follows:
{        SFSA_P: A pointer to the stack frame save area in which a trap occured which required the invocation
{          of the system core debugger.
{        STR: An eight-character string describing the reason for the invocation of the system core debugger;
{          i.e. a trap or a command.
{        OPTIONAL_MES: A string value which is displayed only if it is non-blank.
{        DUMP_JOB_ENVIRONMENT: A boolean value which describes whether this procedure is the result of a
{          DUMPJOB command.
{        MES2: A string describing the environment which is in effect for the debugger during execution of the
{          procedure.
{        STATUS: VAR of ost$status.
{

  PROCEDURE process_debug_task
    (    sfsa_p: ^cell;
         str: string (8);
         optional_mes: string ( * );
         dump_job_environment: boolean;
         mes2: string (60);
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      length: integer,
      log_string: string (256),
      message: string (60),
      xcb_p: ^ost$execution_control_block;

?? NEWTITLE := '    PROCESS_DEBUG_TASK - CH', EJECT ??

    PROCEDURE ch
      (    mf: ost$monitor_fault;
           ctc: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        ignore_status: ost$status,
        line_limit: string (40),
        s: string (40);

      s := ' Debugger failure - try again';
      line_limit := ' Line limit exceeded - try again';
      syv$inhibit_core_cmd_logging := FALSE;

      IF syv$terminate_sysdebug_output THEN

{ Messages have already been displayed.

        syv$terminate_sysdebug_output := FALSE;
        status.normal := FALSE;
        EXIT process_debug_task;
      IFEND;

      IF NOT syv$dump_to_pf THEN
        IF syv$debug_line_count > syv$max_debug_output_lines THEN
          dpp$put_next_line (display_id, line_limit, ignore_status);
        ELSE
          dpp$put_next_line (display_id, s, ignore_status);
        IFEND;
      ELSE
        IF syv$debug_line_count > syv$max_debug_output_lines THEN
          osp$output_debug_text (^line_limit, ignore_status);
        ELSEIF (syv$db_page_wait_lines_instance <> 0) AND (syv$db_displayed_console_lines >=
              syv$db_page_wait_lines_instance) THEN

{ Messages have already been displayed.

          syv$db_displayed_console_lines := 0;
        ELSE
          osp$output_debug_text (^s, ignore_status);
        IFEND;
      IFEND;
      status.normal := FALSE;
      EXIT process_debug_task;
    PROCEND ch;
?? OLDTITLE, EJECT ??

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    status.normal := TRUE;
    syp$establish_condition_handler (^ch);
    pmp$find_executing_task_xcb (xcb_p);

  /debug_task/
    BEGIN
      STRINGREP (log_string, length, 'Begin System Core Debugger session on task GTID = [',
            xcb_p^.global_task_id.index:#(16), ' -', xcb_p^.global_task_id.seqno:#(16),
            ' ](16), task name = ', xcb_p^.save9);
      log_system_core_text (log_string (1, length));
      IF dump_job_environment OR ((NOT syv$nosve_job_template) AND
            (tmv$job_debug_ring > tmv$system_debug_ring)) THEN
        dpp$put_next_line (display_id, ' DUMPJOB task dump in progress', status);
        IF (syv$debug_output_disposal_info.output_destination= syc$dod_save_and_print) OR
              (syv$debug_output_disposal_info.output_destination= syc$dod_null) THEN
          setod_proc ('retain_and_printer '' DUMPJOB Task Dump ''', display_id, status);
        ELSEIF syv$debug_output_disposal_info.output_destination= syc$dod_save_on_pf THEN
          setod_proc ('retain '' DUMPJOB Task Dump ''', display_id, status);
        ELSEIF syv$debug_output_disposal_info.output_destination= syc$dod_write_for_print THEN
          setod_proc ('printer '' DUMPJOB Task Dump ''', display_id, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        autoproc ({dump segments 3,4,6 =} (xcb_p^.save9 = '$JOBMNTR                       '),
              dump_job_environment, status);
        dpp$put_next_line (display_id, ' DUMPJOB task dump complete', status);
      ELSE

        IF NOT osv$dump_when_debug THEN
          dpp$put_next_line (display_id, mes2, status);
          IF optional_mes <> '  ' THEN
            dpp$put_next_line (display_id, optional_mes, status);
          IFEND;
          IF (syv$debug_output_disposal_info.output_destination = syc$dod_save_and_print) THEN
            setod_proc ('retain_and_printer '' Interactive Dump Session ''', display_id, status);
          ELSEIF syv$debug_output_disposal_info.output_destination = syc$dod_save_on_pf THEN
            setod_proc ('retain '' Interactive Dump Session ''', display_id, status);
          ELSEIF syv$debug_output_disposal_info.output_destination = syc$dod_write_for_print THEN
            setod_proc ('printer '' Interactive Dump Session ''', display_id, status);
          IFEND;
          syp$process_core_commands (display_id, 'RUN ', ^command_table, status);
        ELSE
          dpp$put_next_line (display_id, 'Starting automatic debug dump', status);
          status.normal := TRUE;
          IF (syv$debug_output_disposal_info.output_destination = syc$dod_save_and_print) OR
                (syv$debug_output_disposal_info.output_destination = syc$dod_null) THEN
            setod_proc ('retain_and_printer '' Automatic Task Dump ''', display_id, status);
          ELSEIF syv$debug_output_disposal_info.output_destination = syc$dod_save_on_pf THEN
            setod_proc ('retain '' Automatic Task Dump ''', display_id, status);
          ELSEIF syv$debug_output_disposal_info.output_destination = syc$dod_write_for_print THEN
            setod_proc ('printer ''Automatic Task Dump ''', display_id, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          autoproc ({dump segments 3,4,6 =} TRUE, {dump_job_environment =} FALSE, status);
          IF status.normal THEN
            dpp$put_next_line (display_id, 'Automatic dump complete', status);
          ELSE
            dpp$put_next_line (display_id, 'Automatic dump failed as follows', ignore_status);
            dpp$put_next_line (display_id, status.text.value (1, status.text.size), ignore_status);
          IFEND;
        IFEND;
      IFEND;
    END /debug_task/;

    status.normal := TRUE;
  PROCEND process_debug_task;
?? OLDTITLE ??
?? NEWTITLE := '  PROPAGATE_DEBUG_MASK_BIT', EJECT ??

{
{ Purpose:
{   This procedure propagates a set or cleared debug mask bit in the user condition register field of the
{ previous save area to this procedure to the end of the stack for this task.  The parameter is as follows:
{        BIT_VALUE: A boolean describing whether the debug mask bit should be set or cleared.
{

  PROCEDURE propagate_debug_mask_bit
    (    bit_value: boolean);

    VAR
      dblist: debug_list_pointer,
      sa_p: ^stack_frame_control_image,
      status: ost$status;

    sa_p := #PREVIOUS_SAVE_AREA ();
    IF bit_value THEN
      dblist.list_p := ^syv$debug_list;
      #WRITE_REGISTER (osc$pr_debug_list_pointer, dblist.int);
    IFEND;
    REPEAT
      sa_p^.user_condition_mask [osc$debug] := bit_value;
      syp$verify_access (syc$writeable, #LOC (sa_p^.psa), status);
      IF NOT status.normal THEN
        sa_p := NIL
      ELSE
        sa_p := sa_p^.psa;
      IFEND;
    UNTIL sa_p = NIL;
  PROCEND propagate_debug_mask_bit;
?? OLDTITLE ??
?? NEWTITLE := '  REG_DISPLAY', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_REGISTER command.  It displays the contents of a specified register
{ of an interrupted task. The parameters for the command are as follows:
{        RTYPE: Required, name.
{          Specifies the type of register to be displayed.  Values can be
{          . 'P' for a program address register
{          . 'A' for an address register
{          . 'X' for an operand register
{        ID: Optional, integer.
{          Specifies the hexadecimal or decimal number of the register to be displayed.  This parameter is
{          valid for the A and X keywords.  The registers are numbered from 0 through 15 (decimal) or from 0
{          through F hexadecimal.  The default is 0.
{        VTYPE: Optional, name.
{          Specifies how the data of the register contents is to be interpreted.  One of the following
{          keywords can be specified:
{            . ASCII or ASC - ASCII data.
{            . DEC          - Decimal number.
{            . HEX          - Hexadecimal number.
{          The default is HEX.
{


{ DISPLAY_REGISTER parameter descriptor table:

  VAR
    display_reg_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 3] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'reg_type', syc$name_value, * ],
{   } [FALSE, 2, 'reg_num ', syc$integer_value, 0, 0, 15],
{   } [FALSE, 3, 'option  ', syc$name_value, 'HEX     ']];

  PROCEDURE reg_display
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      dec_p: ^integer,
      i: integer,
      line: string (26),
      pvt: array [1 .. 3] of syt$parameter_value,
      str: string (60),
      str_p: ^string (8),
      trapped_sf: stack_image_pointer;

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (display_reg_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY REGISTER ', text);
    IFEND;

{ Locate the stack frame associated with the trapped procedure.  Return an error code if none exists.

    find_trapped_stack_frame (trapped_sf.cell_p);
    IF trapped_sf.cell_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'no_trap_has_occurred', status);
      RETURN;
    IFEND;

    IF pvt [1].name (1, 2) = 'P ' THEN

      line (1, 16) := 'P=0 000 00000000';
      hex_string (trapped_sf.control^.p_reg.pva.ring, line, 3);
      hex_string (trapped_sf.control^.p_reg.pva.seg, line, 7);
      hex_string (trapped_sf.control^.p_reg.pva.offset, line, 16);
      syp$write_output_line (line (1, 16), status);
      RETURN;

    ELSEIF pvt [1].name (1, 2) = 'A ' THEN

      IF (pvt [2].int >= 0) AND (pvt [2].int <= trapped_sf.control^.frame_desc.a_terminate) THEN
        line (1, 17) := 'A0=0 000 00000000';
        hex_string (pvt [2].int, line, 2);
        hex_string (trapped_sf.aregs^.reg [pvt [2].int].pva.ring, line, 4);
        hex_string (trapped_sf.aregs^.reg [pvt [2].int].pva.seg, line, 8);
        hex_string (trapped_sf.aregs^.reg [pvt [2].int].pva.offset, line, 17);
        syp$write_output_line (line (1, 17), status);
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'reg_not_in_sf', status);
      IFEND;
      RETURN;

    ELSEIF pvt [1].name (1, 2) = 'X ' THEN

      IF (pvt [2].int >= trapped_sf.control^.frame_desc.x_start) AND
            (pvt [2].int <= trapped_sf.control^.frame_desc.x_terminate) THEN
        i := ((trapped_sf.control^.frame_desc.a_terminate) + 1);
        i := i + (pvt [2].int - trapped_sf.control^.frame_desc.x_start);
        dec_p := #LOC (trapped_sf.xregs^.reg [i]);
        str_p := #LOC (dec_p^);

        IF pvt [3].name (1, 3) = 'HEX' THEN
          line (1, 25) := 'X0=00000000  00000000(16)';
          hex_string (pvt [2].int, line, 2);
          hex_string (trapped_sf.xregs^.reg [i].lhalf, line, 11);
          hex_string (trapped_sf.xregs^.reg [i].rhalf, line, 21);
          syp$write_output_line (line (1, 25), status);
        ELSEIF pvt [3].name (1, 3) = 'ASC' THEN
          line (1, 11) := 'X0=yyyyyyyy';
          hex_string (pvt [2].int, line, 2);
          line (4, 8) := str_p^ (1, 8);
          syp$write_output_line (line (1, 11), status);
        ELSEIF pvt [3].name (1, 3) = 'DEC' THEN
          line (1, 26) := 'X0=0000000000000000000(10)';
          hex_string (pvt [2].int, line, 2);
          syp$binary_to_ascii (dec_p^, line, 10, 22);
          syp$write_output_line (line (1, 26), status);

        ELSE
          osp$set_status_abnormal ('DB', dbe$, 'invalid_data_type_def', status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'reg_not_in_sf', status);
      IFEND;

    ELSE
      osp$set_status_abnormal ('DB', dbe$, 'invalid_reg_type', status);

    IFEND;
  PROCEND reg_display;
?? OLDTITLE ??
?? NEWTITLE := '  REMOVE_BREAKPOINT', EJECT ??

{
{ Purpose:
{   This procedure processes the REMOVE_BREAKPOINT command.  It deactivates a previously active breakpoint or
{ specified conditions on a previously active breakpoint.  The parameters for the command are as follows:
{        NAME: Required, name.
{          Specifies the name of the breakpoint to be deactivated.  If only the name parameter is specified,
{          all conditions set for that breakpoint are cleared.
{        COND: Optional, name.
{          Specifies the particular condition to clear for the named breakpoint.  If this is the only
{          condition set, the entire breakpoint is cleared.  If more than one condition is set, the other
{          conditions and the breakpoint remain in effect.  The following keywords can be specified:
{            . RNI     - Read next instruction. This is the most commonly used breakpoint condition.
{            . READ    - Read from virtual memory.
{            . WRITE   - Write to virtual memory.
{            . BRANCH  - Branch to another location.
{            . CALL    - Call to another module.
{            . DIVFLT  - Division fault.
{            . ARLOS   - Arithmetic loss of significance.
{            . AROVFL  - Arithmetic overflow.
{            . EXOVFL  - Exponential overflow.
{            . EXUNFL  - Exponential underflow.
{            . FPLOS   - Floating-point loss of significance.
{            . FPINDEF - Floating-point indefinite operand condition.
{            . INVBDP  - Invalid business data processing (BDP) instruction.
{


{ REMOVE_BREAKPOINTS parameter descriptor table:

  VAR
    remove_brkpt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'name    ', syc$name_value, * ],
{   } [FALSE, 2, 'cond    ', syc$name_value, * ]];

  PROCEDURE remove_breakpoint
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    TYPE
      fake = packed record
        case x: 0 .. 1 of
        = 0 =
          int: 0 .. 1fff(16),
        = 1 =
          a: packed array [debug_condition] of boolean,
        casend
      recend;

    VAR
      cond_name: string (8),
      cond_ord: debug_condition,
      condition_valid: boolean,
      dbl_index: integer,
      dbl_p: ^debug_list,
      debug_mask_reg: debug_mask,
      high_remove_index: integer,
      i: integer,
      j: integer,
      l: debug_condition,
      name_found: boolean,
      pvt: array [1 .. 2] of syt$parameter_value,
      remove: array [1 .. 13] of debug_condition,
      str: string (60),
      trans: fake,
      ucr_ord: ost$user_condition;

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (remove_brkpt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' REMOVE BREAKPOINT ', text);
    IFEND;


{ Validate the breakpoint name.  Return if invalid.

    dbl_p := ^syv$debug_list;
    find_dbl_entry (pvt [1].name, dbl_index, name_found);
    IF name_found = FALSE THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_name', status);
      RETURN;
    IFEND;

{ If a condition is specified, test for validity.  Return if invalid.

    IF pvt [2].defined = TRUE THEN
      validate_brkpt_condition (pvt [2].name, cond_ord, ucr_ord, condition_valid);
      IF condition_valid = FALSE THEN
        osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_cond', status);
        RETURN;
      ELSEIF dbl_p^.sfwr_entry [dbl_index].condition [cond_ord] = FALSE THEN
        osp$set_status_abnormal ('DB', dbe$, 'condition_not_selected', status);
        RETURN;
      IFEND;
    IFEND;

{ Build an array of debug_list.sfwr_entry.condition indices which identify the breakpoint condition(s) which
{ is(are) to be removed.

    CASE pvt [2].defined OF

    = TRUE =

{ A single, specific condition is to be removed.

      remove [1] := cond_ord;
      high_remove_index := 1;

    = FALSE =

{ All conditions currently selected for the breakpoint are to be removed.

      high_remove_index := 0;
      FOR l := dc_read TO dc_invbdp DO

        IF dbl_p^.sfwr_entry [dbl_index].condition [l] = TRUE THEN
          high_remove_index := high_remove_index + 1;
          remove [high_remove_index] := l;
        IFEND;
      FOREND;
    CASEND;

{ Process removal of breakpoint condition based upon the array of condition indices previously constructed.

    FOR j := 1 TO high_remove_index DO
      dbl_p^.sfwr_entry [dbl_index].condition [remove [j]] := FALSE;
      dbl_p^.select_count [remove [j]] := dbl_p^.select_count [remove [j]] - 1;
      cond_ord_to_ucr_ord (remove [j], ucr_ord, cond_name);
      IF ucr_ord = osc$debug THEN
        dbl_p^.sfwr_entry [dbl_index].hscnt := dbl_p^.sfwr_entry [dbl_index].hscnt - 1;
        dbl_p^.hdwr_entry [dbl_index].condition [remove [j]] := FALSE;
        IF dbl_p^.select_count [remove [j]] = 0 THEN
          i := #READ_REGISTER (osc$pr_debug_mask_reg);
          debug_mask_reg.int := i;
          debug_mask_reg.condition [remove [j]] := FALSE;
          i := debug_mask_reg.int;
          #WRITE_REGISTER (osc$pr_debug_mask_reg, i);
          syv$debug_control.debug_mask := debug_mask_reg.os_code;
          debug_mask_reg.fill1 := 0;
          IF debug_mask_reg.int = 0 THEN
            syv$debug_control.selected_ucr_conditions [ucr_ord] := FALSE;
          IFEND;
        IFEND;
        IF (dbl_p^.sfwr_entry [dbl_index].hscnt = 0) AND (dbl_p^.hdwr_entry [dbl_index].eol = TRUE) THEN
          dbl_p^.hdwr_entry [dbl_index].eol := FALSE;
          i := 32;
          WHILE (i >= 1) AND (dbl_p^.sfwr_entry [i].hscnt = 0) DO
            i := i - 1;
          WHILEND;
          dbl_p^.eol_index := i;
          IF i > 0 THEN
            dbl_p^.hdwr_entry [i].eol := TRUE;
          ELSE
            syv$debug_control.set_debug_bit_in_um := FALSE;
            propagate_debug_mask_bit (FALSE);
          IFEND;
        IFEND;
      ELSEIF dbl_p^.select_count [remove [j]] = 0 THEN
        syv$debug_control.selected_ucr_conditions [ucr_ord] := FALSE;
      IFEND;
    FOREND;

{ If no conditions remain selected for this breakpoint, completely delete the breakpoint.

    trans.a := dbl_p^.sfwr_entry [dbl_index].condition;
    IF trans.int = 0 THEN
      dbl_p^.sfwr_entry [dbl_index].name := '        ';
    IFEND;
    update_debug_masks;

  PROCEND remove_breakpoint;
?? OLDTITLE ??
?? NEWTITLE := '  REPEAT_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the REPEAT command.  There are no parameters for the command.
{

  PROCEDURE repeat_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);


    VAR
      str: string (60);

    IF syv$repeatable_command_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'No command to repeat', status);
      RETURN;
    IFEND;
    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    status.normal := TRUE;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' Repeating command:', '');
      str := ' ';
      str (4, * ) := syv$repeatable_command_p^ (1, STRLENGTH (syv$repeatable_command_p^));
      syp$write_output_line (str, status);
    IFEND;
    status.normal := TRUE;

    syp$process_command_line (syv$repeatable_command_p^, ^command_table, display_id, status);

  PROCEND repeat_proc;
?? OLDTITLE ??
?? NEWTITLE := '  SAVE_REPEATABLE_COMMAND', EJECT ??
{
{ Purpose:
{   This procedure saves a "repeatable" command in the mainframe_wired heap for use later by the REPEAT
{ command.  Its basic use is for saving the PLUS and MINUS commands in a form which can be repeated.
{        COMMAND_STRING: An adaptable string containing the command which can be repeated.
{

  PROCEDURE save_repeatable_command
    (    command_string: string ( * ));

    IF syv$repeatable_command_p <> NIL THEN
      FREE syv$repeatable_command_p IN osv$mainframe_wired_heap^;
    IFEND;

    ALLOCATE syv$repeatable_command_p: [STRLENGTH (command_string)] IN osv$mainframe_wired_heap^;
    syv$repeatable_command_p^ := command_string (1, STRLENGTH (command_string));

  PROCEND save_repeatable_command;
?? OLDTITLE ??
?? NEWTITLE := '  SCMPROC', EJECT ??

{
{ Purpose:
{   This procedure processes the SUPER_CHANGE_MEMORY command.  It changes the contents of the specified
{ location in virtual memory exactly as the CHANGE_MEMORY subcommand with the additional capability to
{ change segment access attributes to allow the change and then replace the original segment access
{ attributes.  The parameters for the command are as follows:
{        FBA: Required, pointer.
{          Specifies the virtual memory address (as a PVA or symbolic address) where the new value is entered
{          (this value is an 11-digit hexadecimal number addressing a specific byte of memory).
{        MV: Required, integer.
{          Specifies a number that replaces the bytes at the specified address.
{        BC: Optional, integer.
{          Specifies the number of consecutive bytes for which the new value is entered.  The default is 1.
{          The count can be a maximum of 8.
{

  PROCEDURE scmproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      purge_buffer_param2: ^cell,
      pvt: array [1 .. 3] of syt$parameter_value,
      saved_ste: ost$segment_descriptor,
      sdte_p: ^mmt$segment_descriptor,
      str: string (60),
      xcbp: ^ost$execution_control_block;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (cm_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' SUPER CHANGE MEMORY', text);
    IFEND;

    pmp$find_executing_task_xcb (xcbp);
    IF #SEGMENT (pvt [1].ptr) > xcbp^.xp.segment_table_length THEN
      osp$set_status_abnormal ('DB', dbe$, 'segment too big', status);
      RETURN;
    IFEND;

    sdte_p := mmp$get_sdt_entry_p (xcbp, #SEGMENT (pvt [1].ptr));
    saved_ste := sdte_p^.ste;
    sdte_p^.ste.wp := osc$write_uncontrolled;
    purge_buffer_param2 := NIL;
    #PURGE_BUFFER (osc$purge_all_page_seg_map, purge_buffer_param2);
    cmproc (text, id, status);
    syp$purge_instruction_stack;
    sdte_p^.ste := saved_ste;
    #PURGE_BUFFER (osc$purge_all_page_seg_map, purge_buffer_param2);

  PROCEND scmproc;
?? OLDTITLE ??
?? NEWTITLE := '  SELECT_COMMAND', EJECT ??

{
{ Purpose:
{   This procedure processes the SELECT command.  It specifies the task or tasks in which breakpoints are to
{ be set or identifies a new control option for the task or tasks previously selected. The parameters for the
{ command are as follows:
{        OPTION: Required, name.
{          Specifies the control option used to control the tasks in which the system core debugger is active.
{          The following keywords can be specified:
{          ALLJOBS            - Activates the system core debugger in all active jobs.
{          HIGHRING           - Specifies the greatest ring number in which system core debugger traps are
{          (integer)            recognized. Traps occurring on instructions with ring numbers greater than
{  [See second parameter]       this ring number are ignored. "HIGHRING 3" is a predefined control option.
{          JOB                - Allows activation of the system core debugger in the job with the specified
{         (integer or name)     job ordinal or system_supplied name.  A job's ordinal can be found by looking
{  [See second parameter]       at the VED AJ display on the system display console, but note that if the
{                               system is swapping jobs, this may not be a reliable option because the job
{                               could swap in at a different job ordinal.
{          JOBMONITOR         - Activates the system core debugger in the job monitor task.
{          NOJOB              - Prevents the system core debugger from executing in the job previously
{          (integer or name)    specified in a JOB keyword.
{  [See second parameter]
{          NOJOBS             - Prevents the system core debugger from executing in all active jobs.
{          NOJOBMONITOR       - Prevents the system core debugger from executing in the job monitor task.
{          NOUSER             - Prevents the system core debugger from executing in user tasks.
{          USER               - Activates the system core debugger in user tasks (those that are not job
{                               monitor tasks).
{
{      [ONE OF]
{        JSN: Optional, name.
{          Specifies the system_supplied job name of the job being debugged for the required keyword [See
{          second parameter].
{        - OR -
{        N: Optional, integer.
{          Specifies the value for the required keyword [See first parameter].
{


{ SELECT parameter descriptor tables:

  VAR
    select_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'option  ', syc$name_value, * ],
{   } [FALSE, 2, 'jsn     ', syc$name_value, * ]],

    select_int_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'option  ', syc$name_value, * ],
{   } [FALSE, 2, 'n       ', syc$integer_value, 0, 0, 7fffffff(16)]];

  PROCEDURE select_command
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      ijl_bn: jmt$ijl_block_number,
      ijl_bi: jmt$ijl_block_index,
      ijle_p: ^jmt$initiated_job_list_entry,
      ijlo: jmt$ijl_ordinal,
      integer_variant: boolean,
      jobname: string (31),
      length: integer,
      n: 0 .. jmc$max_ajl_ord,
      name: ost$name,
      name_variant: boolean,
      pvt: array [1 .. 2] of syt$parameter_value,
      str: string (60);

{ Crack the command and exit if bad status.

    name_variant := FALSE;
    integer_variant := FALSE;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (select_int_pdt, text, pvt, status);
    IF NOT status.normal THEN
      syp$crack_command (select_pdt, text, pvt, status);
      IF NOT status.normal THEN
        RETURN;
      ELSE
        name_variant := TRUE;
      IFEND;
    ELSE
      integer_variant := TRUE;
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' SELECT ', text);
    IFEND;

{ Process the command.

    name := pvt [1].name;
    IF (name = 'NOJOBS') OR (name = 'ALLJOBS') THEN

      IF name = 'NOJOBS' THEN
        syv$all_jobs_selected_for_debug := FALSE;
      ELSE {name = 'ALLJOBS'}
        syv$all_jobs_selected_for_debug := TRUE;
      IFEND;

{ Update the breakpoint selection field in every job in the system.

      IF mmv$tables_initialized THEN
        FOR ijl_bn := LOWERBOUND (jmv$ijl_p.block_p^) TO jmv$ijl_p.max_block_in_use DO
          IF jmv$ijl_p.block_p^ [ijl_bn].index_p <> NIL THEN
            FOR ijl_bi := LOWERVALUE (jmt$ijl_block_index) TO UPPERVALUE (jmt$ijl_block_index) DO
              ijle_p := ^jmv$ijl_p.block_p^ [ijl_bn].index_p^ [ijl_bi];
              IF ijle_p^.entry_status <> jmc$ies_entry_free THEN
                IF name = 'NOJOBS' THEN
                  ijle_p^.system_breakpoint_selected := FALSE;
                ELSE {name = 'ALLJOBS'}
                  ijle_p^.system_breakpoint_selected := TRUE;
                IFEND;
              IFEND;
            FOREND;
          IFEND;
        FOREND;
      IFEND;
    ELSEIF (name = 'JOB') AND (name_variant) THEN
      IF mmv$tables_initialized THEN
        jobname := pvt [2].name;
        length := clp$trimmed_string_size (jobname);
        IF length <= jmc$system_supplied_name_size THEN
          jmp$find_jsn (jobname (1, length), ijle_p, ijlo);
          IF ijle_p <> NIL THEN
            ijle_p^.system_breakpoint_selected := TRUE;
          ELSE
            osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
          IFEND;
        ELSE
          osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      IFEND;
    ELSEIF (name = 'JOB') AND (integer_variant) AND (pvt [2].int <= mtv$mx_ajl_entries) THEN
      IF mmv$tables_initialized THEN
        ijle_p := jmv$ajl_p^ [pvt [2].int].ijle_p;
        IF (ijle_p <> NIL) AND (ijle_p^.ajl_ordinal = pvt [2].int) THEN
          ijle_p^.system_breakpoint_selected := TRUE;
        ELSE
          osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      IFEND;
    ELSEIF (name = 'NOJOB') AND (name_variant) THEN
      IF mmv$tables_initialized THEN
        jobname := pvt [2].name;
        length := clp$trimmed_string_size (jobname);
        IF length <= jmc$system_supplied_name_size THEN
          jmp$find_jsn (jobname (1, length), ijle_p, ijlo);
          IF ijle_p <> NIL THEN
            ijle_p^.system_breakpoint_selected := FALSE;
          ELSE
            osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
          IFEND;
        ELSE
          osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      IFEND;
    ELSEIF (name = 'NOJOB') AND (integer_variant) AND (pvt [2].int <= mtv$mx_ajl_entries) THEN
      IF mmv$tables_initialized THEN
        ijle_p := jmv$ajl_p^ [pvt [2].int].ijle_p;
        IF (ijle_p <> NIL) AND (ijle_p^.ajl_ordinal = pvt [2].int) THEN
          ijle_p^.system_breakpoint_selected := FALSE;
        ELSE
          osp$set_status_abnormal ('DB', dbe$, 'invalid job name', status);
        IFEND;
      ELSE
        osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      IFEND;
    ELSEIF name = 'JOBMONITOR' THEN
      syv$debug_control.debug_job_monitors := TRUE;
    ELSEIF name = 'NOJOBMONITOR' THEN
      syv$debug_control.debug_job_monitors := FALSE;
    ELSEIF (name = 'HIGHRING') AND (integer_variant) AND (pvt [2].int <= 15) THEN
      syv$debug_control.high_ring_for_debug := pvt [2].int;
    ELSEIF name = 'USER' THEN
      syv$debug_control.debug_user_tasks := TRUE;
    ELSEIF name = 'NOUSER' THEN
      syv$debug_control.debug_user_tasks := FALSE;
    ELSE
      osp$set_status_abnormal ('DB', dbe$, 'invalid selection', status);
    IFEND;

    IF status.normal THEN
      update_debug_masks;
    IFEND;

  PROCEND select_command;
?? OLDTITLE ??
?? NEWTITLE := '  SET_BREAKPOINT', EJECT ??

{
{ Purpose:
{   This procedure processes the SET_BREAKPOINT command. It identifies the breakpoint name and establishes the
{ specific condition that causes a program interrupt.  When the specified condition is met after the task has
{ been restarted, the interrupt occurs.  A virtual address range can be optionally specified within which the
{ specified condition causes an interrupt.  The parameters for the command are as follows:
{        NAME: Required, name.
{          Specifies the user-supplied name for the breakpoint.  Breakpoint names are a maximum of eight
{          characters in length.
{        COND: Optional, name.
{          Specifies the condition that causes an interrupt to occur.  One of the following keywords must be
{          specified:
{            . RNI     - Read next instruction. This is the most commonly used breakpoint condition.
{            . READ    - Read from virtual memory.
{            . WRITE   - Write to virtual memory.
{            . BRANCH  - Branch to another location.
{            . CALL    - Call to another module.
{            . DIVFLT  - Division fault.
{            . ARLOS   - Arithmetic loss of significance.
{            . AROVFL  - Arithmetic overflow.
{            . EXOVFL  - Exponential overflow.
{            . EXUNFL  - Exponential underflow.
{            . FPLOS   - Floating-point loss of significance.
{            . FPINDEF - Floating-point indefinite operand condition.
{            . INVBDP  - Invalid business data processing (BDP) instruction.
{        BASE: Optional, pointer.
{          Specifies the address of the breakpoint as a process virtual address (PVA) or as a symbolic name.
{          This is an 11-digit hexadecimal number addressing a specific byte of memory.  This parameter is
{          required when a new breakpoint is being established.  This parameter cannot be specified when
{          conditions are being added to an existing breakpoint.
{        OFFSET: Optional, integer.
{          Specifies the number of bytes from the specified address that the breakpoint becomes effective.
{          The address plus the offset yields the first byte address of the virtual memory address range of
{          the breakpoint.  This parameter is optional when a new breakpoint is being established.  This
{          parameter cannot be specified when conditions are being added to an existing breakpoint.
{        LENGTH: Optional, integer.
{          Specifies the number of bytes for which the breakpoint is valid.  The address plus the offset plus
{          the length - 1 yields the last byte address of the virtual memory address range.  This parameter is
{          optional when a new breakpoint is being established.  This parameter cannot be specified when
{          conditions are being added to an existing breakpoint.
{


{ SET_BREAKPOINTS parameter descriptor table:

  VAR
    brkpt_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 5] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'name    ', syc$name_value, * ],
{   } [TRUE, 2, 'cond    ', syc$name_value, * ],
{   } [FALSE, 3, 'base    ', syc$pointer_value, NIL],
{   } [FALSE, 4, 'offset  ', syc$integer_value, 0, 0, 7fffffff(16)],
{   } [FALSE, 5, 'length  ', syc$integer_value, 1, 1, 7fffffff(16)]];

  PROCEDURE set_breakpoint
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      str: string (60),

      dbl_p: ^debug_list,
      blank_name: [READ, STATIC] ost$name := '   ',
      pvt: array [1 .. 5] of syt$parameter_value,
      name_found: boolean,
      dbl_index: integer,
      cond_ord: debug_condition,
      cond_valid: boolean,
      lobyte: integer,
      hibyte: integer,
      i: integer,
      segnum: 0 .. 4095,
      debug_mask_reg: debug_mask,
      ucr_ord: ost$user_condition;

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (brkpt_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' SET BREAKPOINT ', text);
    IFEND;


{ Insure that the specified breakpoint name is not 8 blank characters.  Return an error code if it is.

    IF pvt [1].name = '        ' THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_name', status);
      RETURN;
    IFEND;

{ Search the debug list for the command-specified breakpoint name.

    dbl_p := ^syv$debug_list;
    find_dbl_entry (pvt [1].name, dbl_index, name_found);

{ Test for command specification conflicts.

    IF (name_found = TRUE) AND (pvt [3].defined = TRUE) THEN
      osp$set_status_abnormal ('DB', dbe$, 'breakpoint_name_exists', status);
      RETURN;
    IFEND;
    IF (name_found = FALSE) AND (pvt [3].defined = FALSE) THEN
      osp$set_status_abnormal ('DB', dbe$, 'base_parameter_not_specd', status);
      RETURN;
    IFEND;

{ Validate the name of the specified breakpoint condition.

    validate_brkpt_condition (pvt [2].name, cond_ord, ucr_ord, cond_valid);
    IF cond_valid = FALSE THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_breakpoint_cond', status);
      RETURN;
    IFEND;

{ At this point the problem is to either define a completely new breakpoint, or to select an additional
{ condition on an existing breakpoint.  The presence or the absence of a base PVA specification on the command
{ is used to make this determination:  the presence of the parameter signals a completely new breakpoint, its
{ absence signals an additional condition selection on an existing breakpoint.

    CASE pvt [3].defined OF

    = FALSE =

{ Select an additional condition on an existing breakpoint.

{ Test whether the specified condition is already selected.  Return if true.  (Actual selection of the
{ specified condition occurs later.)

      IF dbl_p^.sfwr_entry [dbl_index].condition [cond_ord] = TRUE THEN
        osp$set_status_abnormal ('DB', dbe$, 'condition_already_selected', status);
        RETURN;
      IFEND;

    = TRUE =

{ Establish a completely new breakpoint.
{ Find an available debug list entry.  Return if none are available.

      find_dbl_entry (blank_name, dbl_index, name_found);
      IF name_found = FALSE THEN
        osp$set_status_abnormal ('DB', dbe$, 'max_num_brkpts_already_set', status);
        RETURN;
      IFEND;

{ Construct the required debug list entries for the new breakpoint.  (Actual selection of the condition occurs
{ later).  Calculate address range and test validity.  Return if invalid.

      lobyte := #OFFSET (pvt [3].ptr);
      lobyte := lobyte + pvt [4].int;
      hibyte := (lobyte + pvt [5].int) - 1;
      IF ((lobyte < 0) OR (lobyte > 7fffffff(16))) OR ((hibyte < 0) OR (hibyte > 7fffffff(16))) OR
            (lobyte > hibyte) THEN
        osp$set_status_abnormal ('DB', dbe$, 'invalid_addrs_range', status);
        RETURN;
      IFEND;

      segnum := #SEGMENT (pvt [3].ptr);
      dbl_p^.sfwr_entry [dbl_index].segment := segnum;
      dbl_p^.sfwr_entry [dbl_index].lobyte := lobyte;
      dbl_p^.sfwr_entry [dbl_index].hibyte := hibyte;
      dbl_p^.sfwr_entry [dbl_index].name := pvt [1].name;

      dbl_p^.hdwr_entry [dbl_index].segment := segnum;
      dbl_p^.hdwr_entry [dbl_index].lobyte := lobyte;
      dbl_p^.hdwr_entry [dbl_index].hibyte := hibyte;

    CASEND;

{ Perform selection of the command_specified breakpoint condition.
{ Increment count of number of selections of the condition.

    dbl_p^.select_count [cond_ord] := dbl_p^.select_count [cond_ord] + 1;

{ Set debug list and hardware register condition bits.

    dbl_p^.sfwr_entry [dbl_index].condition [cond_ord] := TRUE;
    IF ucr_ord = osc$debug THEN
      dbl_p^.hdwr_entry [dbl_index].condition [cond_ord] := TRUE;
      debug_mask_reg.os_code := syv$debug_control.debug_mask;
      debug_mask_reg.condition [cond_ord] := TRUE;
      syv$debug_control.debug_mask := debug_mask_reg.os_code;
      dbl_p^.sfwr_entry [dbl_index].hscnt := dbl_p^.sfwr_entry [dbl_index].hscnt + 1;
      IF dbl_index > dbl_p^.eol_index THEN
        dbl_p^.hdwr_entry [dbl_index].eol := TRUE;
        IF dbl_p^.eol_index <> 0 THEN
          dbl_p^.hdwr_entry [dbl_p^.eol_index].eol := FALSE;
        IFEND;
        dbl_p^.eol_index := dbl_index;
        syv$debug_control.set_debug_bit_in_um := TRUE;
      IFEND;
      IF NOT tmv$tables_initialized THEN
        i := #READ_REGISTER (osc$pr_debug_mask_reg);
        debug_mask_reg.int := i;
        debug_mask_reg.condition [cond_ord] := TRUE;
        i := debug_mask_reg.int;
        #WRITE_REGISTER (osc$pr_debug_mask_reg, i);
        propagate_debug_mask_bit (TRUE);
      IFEND;
    IFEND;

{ Update debug control with new selected conditions.

    syv$debug_control.selected_ucr_conditions [ucr_ord] := TRUE;
    update_debug_masks;

  PROCEND set_breakpoint;
?? OLDTITLE ??
?? NEWTITLE := '  SETMSF_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the SET_MASS_STORAGE_FAULT command.  The command is used for internal
{ testing only.  For further information contact D. A. Henseler.
{


{ SET_MASS_STORAGE_FAULT parameter descriptor table:

  VAR
    setmsf_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 8] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'sfid    ', syc$integer_value, 0, 0, 07fffffff(16)],
{   } [FALSE, 2, 'skip_count', syc$integer_value, 0, 0, 07fffffff(16)],
{   } [FALSE, 3, 'count   ', syc$integer_value, 1, 0, 07fffffff(16)],
{   } [FALSE, 4, 'read_fault', syc$boolean_value, TRUE],
{   } [FALSE, 5, 'write_fault', syc$boolean_value, TRUE],
{   } [FALSE, 6, 'first_byte', syc$integer_value, 0, 0, 07fffffff(16)],
{   } [FALSE, 7, 'last_byte', syc$integer_value, 7fffffff(16), 0, 07fffffff(16)],
{   } [FALSE, 8, 'error_type', syc$name_value, 'DOWN']];

  PROCEDURE setmsf_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      locked: boolean,
      ls: ost$status,
      open: boolean,
      osv$disk_fault_simulation: [XREF] boolean,
      pvt: array [1 .. 8] of syt$parameter_value,
      sdf: ost$simulated_disk_fault,
      segment: ost$segment,
      sfid_converter: debug_sfid_converter;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (setmsf_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT osv$disk_fault_simulation THEN
      RETURN;
    IFEND;

    sfid_converter.int := pvt [1].int;
    sdf.sfid := sfid_converter.sfid;
    sdf.direct_sfid := TRUE;

  /file_attached/
    BEGIN
      sdf.skip_count := pvt [2].int;
      sdf.count := pvt [3].int;
      sdf.read_fault := pvt [4].bool;
      sdf.write_fault := pvt [5].bool;
      sdf.first_byte := pvt [6].int;
      sdf.last_byte := pvt [7].int;
      IF pvt [8].name = 'MEDIA' THEN
        sdf.error_type := ioc$media_error;
      ELSEIF pvt [8].name = 'UNRECOVERED' THEN
        sdf.error_type := ioc$unrecovered_error;
      ELSE
        sdf.error_type := ioc$unrecovered_error_unit_down;
      IFEND;

      mmp$open_file_by_sfid (sdf.sfid, 3, 3, mmc$as_random, mmc$sar_write_extend,
            segment, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;

      mmp$free_pages (#ADDRESS (1, segment, 0), 7fffffff(16), osc$wait, status);
      IF NOT status.normal THEN
        mmp$close_device_file (segment, ls);
        EXIT /file_attached/;
      IFEND;

      mmp$close_device_file (segment, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;

      sdf.in_use := TRUE;
      osp$simulate_disk_fault_r1 (sdf, status);

    END /file_attached/;

  PROCEND setmsf_proc;
?? OLDTITLE ??
?? NEWTITLE := '  SETOD_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the SET_OUTPUT_DISPOSITION command.  It determines output destination for all
{ subsequent system core debugger subcommands. The parameters for the command are as follows:
{        DISPOSAL: Optional, name.
{          Specifies whether the output generated by subsequent subcommands should be displayed at the system
{          console, retained in the $SYSTEM.DUMPS catalog, automatically listed at a central site line
{          printer, or both.  The following values describe these respective options:
{          . CONSOLE or C
{          . RETAIN or R
{          . PRINTER or P
{          . RETAIN_AND_PRINTER or RAP
{          The default value for this parameter is RETAIN_AND_PRINTER.
{        TITLE: Optional, name.
{          Specifies a set of characters that appears on the first page of the printed output.  A string must
{          be enclosed in apostrophes.  The default is a blank string.
{


{ SET_OUTPUT_DESTINATION parameter descriptor table:

  VAR
    setod_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'disposal', syc$name_value, 'RETAIN_AND_PRINTER'],
{   } [FALSE, 2, 'title   ', syc$string_value, [0, '']]];

  PROCEDURE setod_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      attributes: pmt$processor_attributes,
      date: ost$date,
      ignore_status: ost$status,
      length: integer,
      message: string (50),
      pvt: array [1 .. 2] of syt$parameter_value,
      serial_number: integer,
      serial_number_string: string (36),
      str1: string (60),
      str2: string (60),
      syv$job_template_name: [XREF] ost$name,
      time: ost$time,
      version: pmt$os_name,
      xcb_p: ^ost$execution_control_block;


    syp$crack_command (setod_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    str1 := ' System Core Debugger Dump';
    str2 := '   Output destination is ';
    IF (pvt [1].name = 'RETAIN_AND_PRINTER') OR (pvt [1].name = 'RAP') THEN
      setod_proc ('console', id, status);
      syv$debug_output_disposal_info.output_destination := syc$dod_save_and_print;
      str2 (26, * ) := 'RETAIN_AND_PRINTER';
    ELSEIF (pvt [1].name = 'RETAIN') OR (pvt [1].name = 'R') THEN
      setod_proc ('console', id, status);
      syv$debug_output_disposal_info.output_destination := syc$dod_save_on_pf;
      str2 (26, * ) := 'RETAIN';
    ELSEIF (pvt [1].name = 'PRINTER') OR (pvt [1].name = 'P') THEN
      setod_proc ('console', id, status);
      syv$debug_output_disposal_info.output_destination := syc$dod_write_for_print;
      str2 (26, * ) := 'PRINTER';
    ELSEIF (pvt [1].name = 'CONSOLE') OR (pvt [1].name = 'C') THEN
      syv$debug_output_disposal_info.output_destination := syc$dod_null;
      syv$db_displayed_console_lines := 0;
      syv$debug_line_count := 0;
      status.normal := TRUE;
      osp$end_text_dump;
      syv$dump_to_pf := FALSE;
      RETURN;
    ELSE
      osp$set_status_abnormal ('DB', dbe$, 'invalid output disposition selection', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syv$debug_output_disposal_info.job_and_file_name := jmv$jcb.system_name;
    osp$begin_text_dump (status);
    IF status.normal THEN
      syv$dump_to_pf := TRUE;
      syp$write_output_header (str1, '');

      syp$write_output_line (str2, ignore_status);
      str2 := ' ';
      syp$write_output_line (str2, ignore_status);

      IF pvt [2].text.size <> 0 THEN
        syp$write_output_line (pvt [2].text.value (1, pvt [2].text.size), status);
      IFEND;

      pmp$find_executing_task_xcb (xcb_p);
      pmp$get_os_version (version, status);
      pmp$get_legible_date_time (osc$mdy_date, date, osc$hms_time, time, status);
      pmp$get_processor_attributes (attributes, status);
      serial_number := attributes.serial_number;

      message := '    ';
      syp$write_output_line (message, status);
      message := ' Unique characteristics of this dump: ';
      syp$write_output_line (message, status);
      message := '    ';
      message (5, * ) := 'OS Version: ';
      message (17, * ) := version;
      syp$write_output_line (message, status);
      message (5, * ) := 'Creation Date: ';
      message (20, * ) := date.mdy;
      syp$write_output_line (message, status);
      message (5, * ) := 'Creation Time: ';
      message (20, * ) := time.hms;
      syp$write_output_line (message, status);
      message (5, * ) := 'System Supplied Job Name: ';
      message (31, * ) := jmv$jcb.system_name;
      syp$write_output_line (message, status);
      message (5, * ) := 'User Supplied Job Name: ';
      message (29, * ) := jmv$jcb.jobname;
      syp$write_output_line (message, status);
      message (5, * ) := 'Task Name: ';
      message (16, * ) := xcb_p^.save9;
      syp$write_output_line (message, status);
      message (5, * ) := 'Serial Number: ';
      serial_number_string := '        ';
      STRINGREP (serial_number_string, length, serial_number);
      message (22, * ) := serial_number_string;
      syp$write_output_line (message, status);
      IF NOT syv$nosve_job_template THEN
        message (5, * ) := 'Job Template Name: ';
        message (24, * ) := syv$job_template_name;
        syp$write_output_line (message, status);
      IFEND;
      syp$write_output_line ('  ', status);
      status.normal := TRUE;
    IFEND;

  PROCEND setod_proc;
?? OLDTITLE ??
?? NEWTITLE := '  SETPW_PROC', EJECT ??

{
{ Purpose:
{   This procedure processes the SET_PAGE_WAIT command.  It sets the number of lines which will be displayed
{ on the console before waiting to continue the display.  The parameter for the command is as follows:
{        NUMBER: Required, integer.
{          Specifies the number of lines which are to be displayed on the system console before the display
{          waits to continue.  The default value of this parameter depends on the size of the debugger window
{          at the time the command is entered.  If the value specified for the parameter is zero (0) then page
{          wait is not in effect, and all output of a command will be displayed.
{


{ SET_PAGE_WAIT parameter descriptor table:

  VAR
    setpw_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number  ', syc$integer_value, 0, 0, 07fffffffffffffff(16)]];

  PROCEDURE setpw_proc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      pvt: array [1 .. 1] of syt$parameter_value;


    syp$crack_command (setpw_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Set ONLY this instance of SYSDEBUG page wait; the overall variable (syv$debugger_page_wait_lines) does not
{ change.

    syv$db_page_wait_lines_instance := pvt [1].int;

  PROCEND setpw_proc;
?? OLDTITLE ??
?? NEWTITLE := '  STACK_DISPLAY', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_STACK_FRAME command.  It displays all or part of the information in a
{ specified stack frame. The parameters for the command are as follows:
{        STACK: Optional, integer.
{          Specifies the number of the stack frame for which the information is to be displayed.  Stack frame
{          number 1 is associated with the interrupted procedure, stack frame number 2 is associated with the
{          interrupted procedure's predecessor, and so on.  The default stack frame displayed is number 1.
{        SELECTOR: Optional, name.
{          Specifies how much of the selected stack frame is to be displayed.  The following
{          keywords can be specified:
{          . AUTO - Displays the memory contents of the specified stack frame.
{          . SAVE - Displays the contents of the save region of the specified stack frame.
{          . FULL - Displays the entire contents of the specified stack frame. This includes
{            information displayed for both AUTO and SAVE.
{          The default keyword is FULL.
{


{ DISPLAY_STACK_FRAME parameter descriptor table:

  VAR
    display_stk_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 2] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'frame   ', syc$integer_value, 1, 1, 10000],
{   } [FALSE, 2, 'option  ', syc$name_value, 'FULL    ']];

  PROCEDURE stack_display
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      a_line: string (40),
      auto_line: string (42),
      auto_p: ^array [1 .. 1fffffff(16)] of 0 .. 0ffffffff(16),
      base_esa: stack_image_pointer,
      base_tosf: stack_image_pointer,
      blank: string (4),
      byte_count: integer,
      char_p: ^array [1 .. 7fffffff(16)] of char,
      cond_regs: condition_reg_image,
      i: integer,
      j: integer,
      k: integer,
      l: integer,
      last_r: integer,
      p_line: string (30),
      pvt: array [1 .. 2] of syt$parameter_value,
      save_hdr_line: string (9),
      segnum: 0 .. 4095,
      sf_id_line: string (34),
      str: string (60),
      trapped_sf: stack_image_pointer,
      um_line: string (31),
      x_line: string (48);

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    blank := '    ';

{ Crack the command.  Return if errors occur.

    syp$crack_command (display_stk_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;
    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY STACK ', text);
    IFEND;

{ Locate the stack frame associated with the trapped procedure.  If found, the stack frame is considered to be
{ stack frame number one.  If no stack frame is found, return an error code and exit immediately.

    find_trapped_stack_frame (trapped_sf.cell_p);
    IF trapped_sf.cell_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'no_trap_has_occurred', status);
      RETURN;
    IFEND;

{ Locate the command-specified stack frame.  Return an error code if it does not exist.

    find_stack_frame (pvt [1].int, base_tosf.cell_p, base_esa.cell_p);
    IF base_esa.cell_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_sf_specified', status);
      RETURN;
    IFEND;
    byte_count := #OFFSET (base_esa.cell_p) - #OFFSET (base_tosf.cell_p);

    IF (pvt [2].name (1, 4) <> 'FULL') AND (pvt [2].name (1, 4) <> 'AUTO') AND (pvt [2].name (1, 4) <>
          'SAVE') THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_selector', status);
      RETURN;
    IFEND;

    sf_id_line := 'STACK FRAME 000        SEGMENT=000';
    hex_string (pvt [1].int, sf_id_line, 15);
    segnum := #SEGMENT (base_tosf.cell_p);
    hex_string (segnum, sf_id_line, 34);
    syp$write_output_line (sf_id_line, status);

    IF (pvt [2].name (1, 4) = 'FULL') OR (pvt [2].name (1, 4) = 'AUTO') THEN
      IF (base_tosf.pva.seg <> base_esa.pva.seg) OR (base_tosf.pva.ring <> base_esa.pva.ring) OR
            (base_tosf.pva.offset > base_esa.pva.offset) THEN
        syp$write_output_line ('Invalid frame a0, a1', status);
      ELSE
        auto_p := #LOC (base_tosf.cell_p^);
        char_p := #LOC (base_tosf.cell_p^);
        i := 1;
        WHILE i <= byte_count DIV 4 DO
          auto_line := '00000000    00000000  00000000            ';
          hex_string (4 * (i - 1), auto_line, 8);
          hex_string (auto_p^ [i], auto_line, 20);
          hex_string (auto_p^ [i + 1], auto_line, 30);
          l := 35;
          FOR j := (4 * i) - 3 TO ((4 * i) - 3) + 7 DO
            IF ($INTEGER (char_p^ [j]) >= 20(16)) AND ($INTEGER (char_p^ [j]) <= 7e(16)) THEN
              auto_line (l) := char_p^ [j];
            IFEND;
            l := l + 1;
          FOREND;
          syp$write_output_line (auto_line, status);
          i := i + 2;
        WHILEND;
      IFEND;
      syp$write_output_line (blank, status);
    IFEND;

    IF (pvt [2].name (1, 4) = 'FULL') OR (pvt [2].name (1, 4) = 'SAVE') THEN
      save_hdr_line := 'SAVE AREA';
      syp$write_output_line (save_hdr_line, status);

      syp$write_output_line (blank, status);

      p_line := 'P=0 000 00000000        VMID=0';
      hex_string (base_esa.control^.p_reg.pva.ring, p_line, 3);
      hex_string (base_esa.control^.p_reg.pva.seg, p_line, 7);
      hex_string (base_esa.control^.p_reg.pva.offset, p_line, 16);
      hex_string (base_esa.control^.vmid, p_line, 30);
      syp$write_output_line (p_line, status);

      um_line := 'UM=0000    UCR=0000    MCR=0000';
      cond_regs.ucr_a := base_esa.control^.user_condition;
      cond_regs.mcr_a := base_esa.control^.monitor_condition;
      cond_regs.ucm_a := base_esa.control^.user_condition_mask;
      hex_string (cond_regs.ucm_i, um_line, 7);
      IF base_esa.control^.frame_desc.a_terminate >= 5 THEN
        hex_string (cond_regs.ucr_i, um_line, 19);
        hex_string (cond_regs.mcr_i, um_line, 31);
      IFEND;
      syp$write_output_line (um_line, status);
      syp$write_output_line (blank, status);

      i := 0;
      last_r := base_esa.control^.frame_desc.a_terminate;
      WHILE i <= last_r DO
        a_line := 'A0=0 000 00000000      A0=0 000 00000000';
        hex_string (i, a_line, 2);
        hex_string (base_esa.aregs^.reg [i].pva.ring, a_line, 4);
        hex_string (base_esa.aregs^.reg [i].pva.seg, a_line, 8);
        hex_string (base_esa.aregs^.reg [i].pva.offset, a_line, 17);
        i := i + 1;
        IF i <= last_r THEN
          hex_string (i, a_line, 25);
          hex_string (base_esa.aregs^.reg [i].pva.ring, a_line, 27);
          hex_string (base_esa.aregs^.reg [i].pva.seg, a_line, 31);
          hex_string (base_esa.aregs^.reg [i].pva.offset, a_line, 40);
          syp$write_output_line (a_line, status);
          i := i + 1;
        ELSE
          syp$write_output_line (a_line (1, 17), status);
        IFEND;
      WHILEND;
      syp$write_output_line (blank, status);

      i := base_esa.control^.frame_desc.x_start;
      k := last_r + 1;
      last_r := base_esa.control^.frame_desc.x_terminate;
      WHILE i <= last_r DO
        x_line := 'X0=00000000  00000000      X0=00000000  00000000';
        hex_string (i, x_line, 2);
        hex_string (base_esa.xregs^.reg [k].lhalf, x_line, 11);
        hex_string (base_esa.xregs^.reg [k].rhalf, x_line, 21);
        i := i + 1;
        k := k + 1;
        IF i <= last_r THEN
          hex_string (i, x_line, 29);
          hex_string (base_esa.xregs^.reg [k].lhalf, x_line, 38);
          hex_string (base_esa.xregs^.reg [k].rhalf, x_line, 48);
          syp$write_output_line (x_line, status);
          i := i + 1;
          k := k + 1;
        ELSE
          syp$write_output_line (x_line (1, 21), status);
        IFEND;
      WHILEND;
    IFEND;
    RETURN;
  PROCEND stack_display;
?? OLDTITLE ??
?? NEWTITLE := '  SUBAUTOPROC', EJECT ??

{
{ Purpose:
{   This procedure a single command for the AUTO command.
{        COMMAND_TABLE_INDEX: A integer index into the auto_command list where the current AUTO subcommand
{          is found and which will be executed.
{

  PROCEDURE sub_autoproc
    (    command_table_index: integer);

    VAR
      ignore_status: ost$status;

?? NEWTITLE := '    SUBAUTOPROC - CH', EJECT ??

    PROCEDURE ch
      (    mf: ost$monitor_fault;
           ctc: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      VAR
        line_limit: string (80),
        s: string (60);

      s := ' An AUTO subcommand failed, continuing with next subcommand';
      line_limit := ' Line limit exceeded during subcommand, continuing with next subcommand';

      IF syv$terminate_sysdebug_output THEN

{ Messages have already been displayed.

        syv$terminate_sysdebug_output := FALSE;
        EXIT sub_autoproc;
      IFEND;

      IF NOT syv$dump_to_pf THEN
        IF syv$debug_line_count > syv$max_debug_output_lines THEN
          dpp$put_next_line (display_id, line_limit, ignore_status);
        ELSEIF (syv$db_page_wait_lines_instance <> 0) AND (syv$db_displayed_console_lines >=
              syv$db_page_wait_lines_instance) THEN

{ Messages have already been displayed.

          syv$db_displayed_console_lines := 0;
        ELSE
          dpp$put_next_line (display_id, s, ignore_status);
        IFEND;
      ELSE
        IF syv$debug_line_count > syv$max_debug_output_lines THEN
          osp$output_debug_text (^line_limit, ignore_status);
        ELSE
          osp$output_debug_text (^s, ignore_status);
        IFEND;
      IFEND;
      EXIT sub_autoproc;
    PROCEND ch;
?? OLDTITLE, EJECT ??

    syp$establish_condition_handler (^ch);
    syp$process_command_line (auto_cmds [command_table_index].command, ^command_table, display_id,
          ignore_status);
    IF NOT ignore_status.normal THEN
      dpp$put_next_line (display_id, 'Continuing AUTO command ...', ignore_status);
    IFEND;

  PROCEND sub_autoproc;
?? OLDTITLE ??
?? NEWTITLE := '  TRACE_BACK', EJECT ??

{
{ Purpose:
{   This procedure processes the DISPLAY_TRACE_BACK command.  It provides information relevant to stack frames
{ associated with the interrupted procedure and its predecessor procedures. The parameters for the command are
{ as follows:
{        START: Optional, integer.
{          Specifies the number of the first stack frame to be displayed.  Stack frame number 1 is associated
{          with the interrupted procedure, stack frame number 2 is associated with the interrupted procedure's
{          predecessor, and so on.  The default is 1.
{        COUNT: Optional, integer.
{          Specifies the number of stack frames to be displayed. The default is 1.
{        OPTION: Optional, name.
{          Specifies the amount of information to be displayed for each stack frame.  The following keywords
{          can be specified:
{          . SHORT - Display the module name and the P-address.
{          . FULL  - Display the module name, the P-address, and the PVAs pointing to the top of stack and the
{            current stack frame save area.
{          The default is FULL.
{        ADDRESS: Optional, pointer.
{          Specifies a stack frame's starting virtual memory address (as a PVA; a PVA is an 11-digit
{          hexadecimal number addressing a specific byte of memory).  If this parameter is specified, the
{          FRAME parameter is ignored.
{


{ DISPLAY_TRACE_BACK parameter descriptor table:

  VAR
    trace_back_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 4] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'start   ', syc$integer_value, 1, 1, 10000],
{   } [FALSE, 2, 'count   ', syc$integer_value, 1, 1, 10000],
{   } [FALSE, 3, 'option  ', syc$name_value, 'FULL'],
{   } [FALSE, 4, 'address ', syc$pointer_value, NIL]];

  PROCEDURE trace_back
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      base_esa: stack_image_pointer,
      base_tosf: stack_image_pointer,
      bs_p: ^array [1 .. 10] of record
        fill1: 0 .. 0ffff(16),
        case 0 .. 1 of
        = 0 =
          ring: 0 .. 15,
        = 1 =
          name_p: ^string (31),
        casend,
      recend,
      crnt_sf_num: integer,
      f: boolean,
      i: integer,
      len: integer,
      line: string (80),
      mn: pmt$program_name,
      num_to_display: integer,
      ofs: ost$segment_offset,
      p: ^stack_frame_control_image,
      pvt: array [1 .. 4] of syt$parameter_value,
      savep: ^cell,
      sf_tosf: stack_image_pointer,
      sf_esa: stack_image_pointer,
      sn: pmt$program_name,
      str: string (60),
      trapped_sf: stack_image_pointer;

{ Crack the command.  Return if errors occur.

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (trace_back_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    IF syv$dump_to_pf THEN
      syp$write_output_header (' DISPLAY TRACE BACK ', text);
    IFEND;

    savep := syv$debug_control.trapped_sfsa;
    IF pvt [4].ptr <> NIL THEN

{ Force the trace-back to start at a specific address.

      syv$debug_control.trapped_sfsa := pvt [4].ptr;
    IFEND;

{ Locate the stack frame associated with the trapped procedure.  If found, the stack frame is considered to be
{ stack frame number one.  If no stack frame is found, return an error code and exit immediately.

    find_trapped_stack_frame (trapped_sf.cell_p);
    IF trapped_sf.cell_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'no_trap_has_occurred', status);
      syv$debug_control.trapped_sfsa := savep;
      RETURN;
    IFEND;

{ Locate the command-specified stack frame.  Return an error code if it does not exist.

    find_stack_frame (pvt [1].int, base_tosf.cell_p, base_esa.cell_p);
    IF base_esa.cell_p = NIL THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid_sf_specified', status);
      syv$debug_control.trapped_sfsa := savep;
      RETURN;
    IFEND;

    crnt_sf_num := pvt [1].int;
    num_to_display := pvt [2].int;
    sf_esa.cell_p := #LOC (sf_esa.cell_p);
    p := base_esa.cell_p;

    WHILE (num_to_display > 0) AND (sf_esa.cell_p <> NIL) DO
      verify_stack_frame (p, sf_tosf.cell_p, sf_esa.cell_p);
      IF sf_esa.cell_p <> NIL THEN
        IF (pvt [3].name = 'FULL') OR (pvt [1].int = crnt_sf_num) THEN
          line (1, 15) := 'STACK FRAME 000';
          syp$binary_to_ascii (crnt_sf_num, line, 10, 15);
          syp$write_output_line (line (1, 15), status);
        IFEND;
        line (1, 48) := 'P=0 000 00000000';
        hex_string (sf_esa.control^.p_reg.pva.ring, line, 3);
        hex_string (sf_esa.control^.p_reg.pva.seg, line, 7);
        hex_string (sf_esa.control^.p_reg.pva.offset, line, 16);
        syp$write_output_line (line (1, 48), status);
        ocp$find_debug_address (sf_esa.control^.p_reg.pva.seg, sf_esa.control^.p_reg.pva.offset, f, mn, sn,
              ofs, status);
        IF status.normal THEN
          IF f THEN
            STRINGREP (line, len, ' M=', mn, ' P=', sn, ' O=', ofs: #(16));
            syp$write_output_line (line (1, len), status);
          IFEND;
        ELSE
          status.normal := TRUE;
        IFEND;
        IF pvt [3].name = 'FULL' THEN
          line (1, 48) := 'STACK=0 000 00000000    SAVE AREA=0 000 00000000';
          hex_string (sf_tosf.pva.ring, line, 7);
          hex_string (sf_tosf.pva.seg, line, 11);
          hex_string (sf_tosf.pva.offset, line, 20);
          hex_string (sf_esa.pva.ring, line, 35);
          hex_string (sf_esa.pva.seg, line, 39);
          hex_string (sf_esa.pva.offset, line, 48);
          syp$write_output_line (line (1, 48), status);
        IFEND;
        num_to_display := num_to_display - 1;
        crnt_sf_num := crnt_sf_num + 1;
        p := sf_esa.cell_p;
        p := p^.psa;
      IFEND;
    WHILEND;
    syv$debug_control.trapped_sfsa := savep;
  PROCEND trace_back;
?? OLDTITLE ??
?? NEWTITLE := '  UP_VOLUME', EJECT ??

{ Purpose:
{   This procedure processes the UP_VOLUME command.  This will allow use of the specified volume number.  The
{   parameter for the command is as follows:
{        NUMBER: Required, integer.
{          Specifies the active volume table index of the volume which is to be UPped.
{

  PROCEDURE up_volume
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      avti: dmt$active_volume_table_index,
      pvt: array [1 .. 1] of syt$parameter_value;

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (down_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    avti := pvt [1].int;

    IF dmv$active_volume_table.table_p^ [avti].mass_storage.volume_unavailable = FALSE THEN

{ Ignore the request - the volume is already up.

      RETURN;
    IFEND;

    dmv$number_unavailable_volumes := dmv$number_unavailable_volumes - 1;
    dmv$active_volume_table.table_p^ [avti].mass_storage.volume_unavailable := FALSE;
    dmv$active_volume_table.table_p^ [avti].mass_storage.allocation_allowed :=
          dmv$active_volume_table.table_p^ [avti].mass_storage.previous_allocation_allowed;

  PROCEND up_volume;
?? OLDTITLE ??
?? NEWTITLE := '  UPDATE_DEBUG_MASKS', EJECT ??

{
{ Purpose:
{   This procedure makes a monitor request to update a job's task(s)'s  debug mask(s) when a breakpoint is
{ added, deleted, or changed, or when a SELECT command has been invoked.
{

  PROCEDURE update_debug_masks;

    VAR
      update_debug_rb: tmt$rb_update_job_task_enviro;

    update_debug_rb.reqcode := syc$rc_update_job_task_enviro;
    update_debug_rb.subcode := tmc$ujte_update_debug_masks;
    i#call_monitor (#LOC (update_debug_rb), #SIZE (update_debug_rb));

  PROCEND update_debug_masks;
?? OLDTITLE ??
?? NEWTITLE := '  VALIDATE_BRKPT_CONDITION', EJECT ??

{
{ Purpose:
{   This procedure validates a requested breakpoint condition by comparing its name to the names found in the
{ condition conversion table.  If the name is found in the table, the condition name is valid.
{        COND_NAME: The name of the condition to be validated.
{        COND_ORD: The ordinal of the condition if it is found in the condition conversion table.
{        UCR_ORD: The ordinal of the user condition if the condition is found in the condition conversion
{          table.
{        CONDITION_VALID: A boolean returned describing whether or not the condition was found in the
{          condition conversion table.
{

  PROCEDURE validate_brkpt_condition
    (    cond_name: ost$name;
     VAR cond_ord: debug_condition;
     VAR ucr_ord: ost$user_condition;
     VAR condition_valid: boolean);

    VAR
      i: debug_condition;

    i := dc_read;
    WHILE i <= dc_invbdp DO
      IF cond_name = cond_conv_tbl [i].name THEN
        cond_ord := cond_conv_tbl [i].c_ord;
        ucr_ord := cond_conv_tbl [i].ucr_ord;
        condition_valid := TRUE;
        RETURN;
      ELSE
        i := SUCC (i);
      IFEND;
    WHILEND;
    condition_valid := FALSE;
    RETURN;
  PROCEND validate_brkpt_condition;
?? OLDTITLE ??
?? NEWTITLE := '  VERIFY_STACK_FRAME', EJECT ??

{
{ Purpose:
{   This procedure assists the DISPLAY_TRACE_BACK command and the procedure SYP$MFH_FOR_KEYPOINT_TRACEBACK.
{ It verifies that the stack frame may be accessed in write-mode and returns pointers to the current stack
{ frame and the stack frame save area for the stack frame in question.
{        CP: A pointer the stack frame which must be verified.
{        CSF_P: A pointer to the current stack frame if the stack frame is valid.
{        SA_P: A pointer to the stack frame save area if the stack frame is valid.
{

  PROCEDURE verify_stack_frame
    (    cp: ^stack_frame_control_image;
     VAR csf_p: ^cell;
     VAR sa_p: ^cell);

    VAR
      p: ^stack_frame_control_image,
      status: ost$status;

    p := cp;
    IF p <> NIL THEN
      syp$verify_access (syc$writeable, #LOC (p^.csf), status);
      IF NOT status.normal THEN
        csf_p := NIL;
      ELSE
        csf_p := p^.csf;
      IFEND;
      sa_p := p;
    ELSE
      csf_p := NIL;
      sa_p := NIL;
    IFEND;

  PROCEND verify_stack_frame;
?? OLDTITLE ??
?? NEWTITLE := '  XQAUTOPROC', EJECT ??
{
{ Purpose:
{   This procedure processes the AUTO command.  It forces a dump of the job and task environment by executing
{ the entire auto dump command list.  The parameter for the command is as follows:
{        DISPOSAL: Optional, name.
{          Specifies whether the output generated by subsequent subcommands should be displayed at the system
{          console, retained in the $SYSTEM.DUMPS catalog, automatically listed at a central site line
{          printer, or both.  The following values describe these respective options:
{          . DEFAULT or D: Uses default_debug_output_disposal system attribute (if set), or RAP if not set
{          . CONSOLE or C
{          . RETAIN or R
{          . PRINTER or P
{          . RETAIN_AND_PRINTER or RAP
{          The default value for this parameter is RETAIN_AND_PRINTER.
{


{ AUTO parameter descriptor table:

  VAR
    auto_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [FALSE, 1, 'disposal', syc$name_value, 'DEFAULT']];

  PROCEDURE xqtautoproc
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      pvt: array [1 .. 1] of syt$parameter_value,
      saved_output_disposition: syt$debug_output_disposition,
      str: string (60);

    IF NOT mmv$tables_initialized THEN
      osp$set_status_abnormal ('DB', dbe$, 'invalid request', status);
      RETURN;
    IFEND;

    syv$db_displayed_console_lines := 0;
    syv$debug_line_count := 0;
    syp$crack_command (auto_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    saved_output_disposition := syv$debug_output_disposal_info.output_destination;
    IF (pvt [1].name = 'DEFAULT') OR (pvt [1].name = 'D') THEN
      IF saved_output_disposition = syc$dod_null THEN
        setod_proc ('retain_and_printer '' Automatic Task Dump ''', display_id, status);
      ELSEIF saved_output_disposition = syc$dod_write_for_print THEN
        setod_proc ('printer '' Automatic Task Dump ''', display_id, status);
      ELSEIF saved_output_disposition = syc$dod_save_on_pf THEN
        setod_proc ('retain '' Automatic Task Dump ''', display_id, status);
      ELSEIF saved_output_disposition = syc$dod_save_and_print THEN
        setod_proc ('retain_and_printer '' Automatic Task Dump ''', display_id, status);
      ELSE {should not happen}
        osp$set_status_abnormal ('DB', dbe$, 'Unknown output disposition attribute for AUTO command', status);
        RETURN;
      IFEND;
    ELSEIF (pvt [1].name = 'RETAIN_AND_PRINTER') OR (pvt [1].name = 'RAP') THEN
      setod_proc ('retain_and_printer '' Automatic Task Dump ''', display_id, status);
    ELSEIF (pvt [1].name = 'RETAIN') OR (pvt [1].name = 'R') THEN
      setod_proc ('retain '' Automatic Task Dump ''', display_id, status);
    ELSEIF (pvt [1].name = 'PRINTER') OR (pvt [1].name = 'P') THEN
      setod_proc ('printer '' Automatic Task Dump ''', display_id, status);
    ELSEIF (pvt [1].name = 'CONSOLE') OR (pvt [1].name = 'C') THEN
      osp$set_status_abnormal ('DB', dbe$, 'AUTO cannot display output to console', status);
      RETURN;
    ELSE
      osp$set_status_abnormal ('DB', dbe$, 'Unknown output disposition for AUTO command', status);
      RETURN;
    IFEND;

    autoproc ({dump segments 3,4,6 =} TRUE, FALSE, status);
    dpp$put_next_line (display_id, 'AUTO command dump complete.', status);

    IF saved_output_disposition = syc$dod_save_and_print THEN
      setod_proc ('retain_and_printer ', display_id, status);
    ELSEIF saved_output_disposition = syc$dod_save_on_pf THEN
      setod_proc ('retain ', display_id, status);
    ELSEIF saved_output_disposition = syc$dod_write_for_print THEN
      setod_proc ('printer ', display_id, status);
    ELSEIF saved_output_disposition = syc$dod_null THEN
      setod_proc ('console', display_id, status);
    IFEND;

  PROCEND xqtautoproc;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$CONVERT_BYTES', EJECT ??
{
{ Purpose:
{   This procedure converts a portion of memory into a string representation of that memory and returns it in
{ in a specified string.  Optionally, it can return the string representation at the end of a non-empty
{ string by separating the original string from the converted value with a space character.
{        P: A pointer to a packed array of hexidecimal digits which will be converted to characters for
{          display.
{        LENGTH: An integer value which specifies the maximum index of the packed array which must be
{          converted.
{        MSG: An adaptable string which will contain the converted packed array.
{        ADD_TO_EOL: A boolean which determines whether or not the memory conversion should be appended at the
{          end of the existing string contained in the MSG parameter.
{

  PROCEDURE [XDCL] syp$convert_bytes
    (    p: ^packed array [1 .. 1000] of 0 .. 0f(16);
         length: integer;
     VAR msg: string ( * );
         add_to_eol: boolean);

    VAR
      ch: integer,
      eol: integer,
      i: integer;

{ Find the end-of-line of the input string.

    eol := 1;

    IF add_to_eol THEN

    /find_eol/
      FOR i := STRLENGTH (msg) DOWNTO 1 DO
        IF msg (i) <> ' ' THEN
          eol := i + 2;
          EXIT /find_eol/;
        IFEND;
      FOREND /find_eol/;
    IFEND;

    IF eol > STRLENGTH (msg) THEN
      RETURN;
    IFEND;

    FOR i := 1 TO (length * 2) DO
      ch := p^ [i];
      IF ch < 0a(16) THEN
        msg (eol) := $CHAR (ch + $INTEGER ('0'));
      ELSE
        msg (eol) := $CHAR (ch + $INTEGER ('A') - 0a(16));
      IFEND;
      eol := eol + 1;
      IF eol > STRLENGTH (msg) THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND syp$convert_bytes;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$INITIALIZE_JT_PTR_ARRAY', EJECT ??

{
{ Purpose:
{   This procedure will initialize the (job fixed) data structures used by the system core
{   debugger to access job template data structures.
{

  PROCEDURE [XDCL, #GATE] syp$initialize_jt_ptr_array
    (    template_debug_pointers: ^array [1 .. * ] of ^cell);

    IF template_debug_pointers = NIL THEN
      RETURN;
    IFEND;
    IF syv$nosve_job_template THEN
      ALLOCATE syv$job_template_ptr_array: [1 .. UPPERBOUND (template_debug_pointers^)] IN
            osv$mainframe_pageable_heap^;
      nosve_template_ptr_array := syv$job_template_ptr_array;
    ELSE
      ALLOCATE syv$job_template_ptr_array: [1 .. UPPERBOUND (template_debug_pointers^)] IN
            osv$job_fixed_heap^;
    IFEND;
    IF syv$job_template_ptr_array <> NIL THEN
      syv$job_template_ptr_array^ := template_debug_pointers^;
    IFEND;

{ Changes the ring numbers associated with the local and global log control descriptor arrays to allow write
{ access to the log control descriptors.  This is needed to allow the system core debugger to use the logging
{ interfaces that need to interlock the logs (and thus write to the log control descriptors).

    syv$job_template_ptr_array^ [1] := #ADDRESS (osc$tmtr_ring, #SEGMENT (syv$job_template_ptr_array^ [1]),
          #OFFSET (syv$job_template_ptr_array^ [1]));
    syv$job_template_ptr_array^ [2] := #ADDRESS (osc$os_ring_1, #SEGMENT (syv$job_template_ptr_array^ [2]),
          #OFFSET (syv$job_template_ptr_array^ [2]));

  PROCEND syp$initialize_jt_ptr_array;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$INVOKE_SYSTEM_DEBUGGER', EJECT ??

{
{ Purpose:
{   This procedure invokes the system core debugger.  The parameters for the procedure are as follows:
{        TEXT: Not used.
{        ID: Specifies the window which will be used on the system console for the debugger display.
{        STATUS: VAR of ost$status.
{

  PROCEDURE [XDCL, #GATE] syp$invoke_system_debugger
    (    text: string ( * );
         id: dpt$window_id;
     VAR status: ost$status);

    VAR
      i: integer,
      normal: boolean,
      old_te: 0 .. 3,
      sa_p: ^stack_frame_control_image;

    IF avv$security_options [avc$vso_secure_analysis].active THEN
      dpp$put_critical_message ('SYSDEBUG call ignored, it was disabled at deadstart.', {ignore} status);
      status.normal := TRUE;
      RETURN;
    IFEND;

    i#disable_traps (old_te);
    sa_p := #PREVIOUS_SAVE_AREA ();

{ Initiate debug command processing.

    process_commands (sa_p^.psa, 'command ', '  ', FALSE, status);

    i#restore_traps (old_te);

  PROCEND syp$invoke_system_debugger;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$MFH_FOR_DUMP_JOB', EJECT ??

{
{ Purpose:
{   This procedure is the flag handler for the DUMPJOB flag, which is set by the DUMPJOB command.
{

  PROCEDURE [XDCL] syp$mfh_for_dump_job;

    VAR
      i: integer,
      normal: boolean,
      old_te: 0 .. 3,
      sa_p: ^stack_frame_control_image,
      status: ost$status;

    IF avv$security_options [avc$vso_secure_analysis].active THEN
      dpp$put_critical_message ('DUMP JOB call ignored, it was disabled at deadstart.', {ignore} status);
      RETURN;
    IFEND;

    i#disable_traps (old_te);
    sa_p := #PREVIOUS_SAVE_AREA ();

{ Initiate debug command processing.

    process_commands (sa_p^.psa, 'command ', '  ', TRUE, status);

    i#restore_traps (old_te);

  PROCEND syp$mfh_for_dump_job;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$MFH_FOR_KEYPOINT_TRACEBACK', EJECT ??

{
{ Purpose:
{   This procedure is the flag handler for the INVOKE KEYPOINT TRACEBACK flag.  It displays a trace-back of
{ the task into the keypoint buffer for later analysis.
{

  PROCEDURE [XDCL] syp$mfh_for_keypoint_traceback;

    VAR
      base_esa: stack_image_pointer,
      base_tosf: stack_image_pointer,
      lock: [STATIC] ost$signature_lock,
      p: ^stack_frame_control_image,
      savep: ^stack_frame_control_image,
      sf_esa: stack_image_pointer,
      sf_tosf: stack_image_pointer,
      status: ost$status;


    savep := #PREVIOUS_SAVE_AREA ();
    savep := savep^.psa;

{ Locate the first stack frame.  Return if it does not exist.

    syp$verify_access (syc$writeable, #LOC (savep^.csf), status);
    IF NOT status.normal THEN
      base_tosf.cell_p := NIL;
    ELSE
      base_tosf.cell_p := savep^.csf;
    IFEND;
    base_esa.cell_p := savep;
    sf_esa.cell_p := #LOC (sf_esa.cell_p);
    p := base_esa.cell_p;

    osp$set_signature_lock (lock, osc$wait, status);
    #KEYPOINT (osk$performance, osk$m * (jmv$jcb.ijl_ordinal.block_number *
          32 + jmv$jcb.ijl_ordinal.block_index), ptk$stack_ijl_ordinal);
    WHILE sf_esa.cell_p <> NIL DO
      verify_stack_frame (p, sf_tosf.cell_p, sf_esa.cell_p);
      IF sf_esa.cell_p <> NIL THEN
        #KEYPOINT (osk$performance, osk$m * sf_esa.control^.p_reg.pva.seg, ptk$stack_p_segment);
        #KEYPOINT (osk$performance, osk$m * (sf_esa.control^.p_reg.pva.offset DIV 100000(16)),
              ptk$stack_p_upper_offset);
        #KEYPOINT (osk$performance, osk$m * (sf_esa.control^.p_reg.pva.offset MOD 100000(16)),
              ptk$stack_p_lower_offset);
        #KEYPOINT (osk$performance, osk$m * sf_tosf.pva.seg, ptk$stack_tos_segment);
        #KEYPOINT (osk$performance, osk$m * (sf_tosf.pva.offset DIV 100000(16)), ptk$stack_tos_upper_offset);
        #KEYPOINT (osk$performance, osk$m * (sf_tosf.pva.offset MOD 100000(16)), ptk$stack_tos_lower_offset);
        #KEYPOINT (osk$performance, osk$m * sf_esa.pva.seg, ptk$stack_esa_segment);
        #KEYPOINT (osk$performance, osk$m * (sf_esa.pva.offset DIV 100000(16)), ptk$stack_esa_upper_offset);
        #KEYPOINT (osk$performance, osk$m * (sf_esa.pva.offset MOD 100000(16)), ptk$stack_esa_lower_offset);
        p := sf_esa.cell_p;

{ This p must be verified before it can be de-referenced.

        verify_stack_frame (p, sf_tosf.cell_p, sf_esa.cell_p);
        p := p^.psa;
      IFEND;
    WHILEND;

{ The following keypoint identifies the end of a stack frame trace.

    #KEYPOINT (osk$performance, 0, ptk$end_of_stack_trace);
    osp$clear_signature_lock (lock, status);

  PROCEND syp$mfh_for_keypoint_traceback;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$MFH_FOR_SYSTEM_DEBUG', EJECT ??

  PROCEDURE [XDCL] syp$mfh_for_system_debug;

    VAR
      bit_value: boolean,
      dlp: debug_list_pointer,
      dm: debug_mask,
      null_debug_mask: [STATIC, READ] ost$debug_mask := [FALSE, FALSE, [REP 5 of FALSE]],
      sa_p: ^stack_frame_control_image;

    IF (jmv$jcb.ijle_p^.system_breakpoint_selected) AND (syv$debug_control.set_debug_bit_in_um) THEN
      dlp.cell_p := syv$debug_control.debug_list_p;
      dm.os_code := syv$debug_control.debug_mask;
    ELSE
      dlp.cell_p := NIL;
      dm.os_code := null_debug_mask;
    IFEND;

    #WRITE_REGISTER (osc$pr_debug_list_pointer, dlp.int);
    #WRITE_REGISTER (osc$pr_debug_mask_reg, dm.int);

    sa_p := #PREVIOUS_SAVE_AREA ();
    bit_value := (#READ_REGISTER (osc$pr_debug_mask_reg) <> 0);
    propagate_debug_mask_bit (bit_value);
  PROCEND syp$mfh_for_system_debug;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$MFH_TO_INVOKE_SYSDEBUG', EJECT ??

{
{ Purpose:
{   This procedure is the flag handler for the SYSDEBUG flag.  It invokes the system core debugger on the task
{ which executes the procedure.
{

  PROCEDURE [XDCL] syp$mfh_to_invoke_sysdebug;

    VAR
      status: ost$status;

    syp$invoke_system_debugger ('', display_id, status);

  PROCEND syp$mfh_to_invoke_sysdebug;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$VERIFY_ACCESS', EJECT ??
{
{ Purpose:
{   This procedure verifies that access can be made to a segment in an expected manner (ring <> 0, segment
{ number within the address space of the task, valid segment, readable and able to read at this ring number,
{ writeable and able to write at this ring number, non-negative offset, and offset within segment length).
{        ACCESS_TYPE: Specifies the type of access which is expected for the segment specified in the second
{          parameter
{        CELL_PP: A pointer to a pointer which will be verified for correct access
{        STATUS: VAR of ost$status.
{

  PROCEDURE [XDCL] syp$verify_access
    (    access_type: (syc$readable, syc$writeable);
         cell_pp: ^^cell;
     VAR status: ost$status);

    VAR
      cell_p: ^cell,
      pva_p: ^ost$pva,
      sdte_p: ^mmt$segment_descriptor,
      sl: integer,
      ste: ost$segment_descriptor,
      xcbp: ^ost$execution_control_block;

    pva_p := #LOC (cell_pp^);
    IF pva_p^.ring = 0 THEN
      osp$set_status_abnormal ('DB', dbe$, 'Ring zero', status);
      RETURN;
    IFEND;
    cell_p := cell_pp^;

    pmp$find_executing_task_xcb (xcbp);
    IF #SEGMENT (cell_p) > xcbp^.xp.segment_table_length THEN
      osp$set_status_abnormal ('DB', dbe$, 'segment too big', status);
      RETURN;
    IFEND;

    sdte_p := mmp$get_sdt_entry_p (xcbp, #SEGMENT (cell_p));
    ste := sdte_p^.ste;

    IF ste.vl = osc$vl_invalid_entry THEN
      osp$set_status_abnormal ('DB', dbe$, 'segment not in use', status);
      RETURN;
    IFEND;

    CASE access_type OF
    = syc$readable =
      IF ste.rp = osc$non_readable THEN
        osp$set_status_abnormal ('DB', dbe$, 'segment not readable', status);
        RETURN;
      IFEND;
      IF ste.r2 < #RING (cell_p) THEN
        osp$set_status_abnormal ('DB', dbe$, 'segment R2 lt p-ring', status);
        RETURN;
      IFEND;

    = syc$writeable =
      IF ste.wp = osc$non_writable THEN
        osp$set_status_abnormal ('DB', dbe$, 'segment not writeable', status);
        RETURN;
      IFEND;
      IF ste.r1 < #RING (cell_p) THEN
        osp$set_status_abnormal ('DB', dbe$, 'segment R1 lt p-ring', status);
        RETURN;
      IFEND;
    CASEND;

    IF #OFFSET (cell_p) < 0 THEN
      osp$set_status_abnormal ('DB', dbe$, 'verify pva negative offset', status);
      RETURN;
    IFEND;
    get_segment_length (cell_p, sl);
    IF #OFFSET (cell_p) >= sl THEN
      osp$set_status_abnormal ('DB', dbe$, 'verify pva offset > segl & read only', status);
      RETURN;
    IFEND;

    status.normal := TRUE;
  PROCEND syp$verify_access;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$WRITE_OUTPUT_HEADER', EJECT ??

{
{ Purpose:
{   This procedure writes a string to the buffer which is accessed by the partner Broken_Dump_Task for further
{ disposition.  It checks for timeouts when displaying output that is not destined for the console.
{        TITLE_PART_1: The first part of the header string which is to be written to the output buffer.
{        TITLE_PART_2: The last part of the header string which is to be written to the output buffer.
{

  PROCEDURE [XDCL] syp$write_output_header
    (    title_part_1: string ( * );
         title_part_2: string ( * ));

    CONST
      c$max_header_length = 60;

    VAR
      header: string (c$max_header_length),
      ignore_status: ost$status,
      length: integer,
      status: ost$status,
      text: string (80);


    status.normal := TRUE;
    IF syv$dump_to_pf THEN
      length := STRLENGTH (title_part_1);
      header := title_part_1;
      IF length < c$max_header_length THEN
        header (length + 1, *) := title_part_2;
      IFEND;
      osp$output_debug_heading (^header, status);
      IF NOT status.normal THEN
        STRINGREP (text, length, 'status.condition = ', status.condition: #(16));
        dpp$put_next_line (display_id, text (1, length), ignore_status);
        syv$debugger_task_timeout := TRUE;
        syp$cause_condition (syc$udc_debugger_task_timeout);
      IFEND;
    IFEND;

  PROCEND syp$write_output_header;
?? OLDTITLE ??
?? NEWTITLE := '  SYP$WRITE_OUTPUT_LINE', EJECT ??

{
{ Purpose:
{   This procedure writes a string to the buffer which is accessed by the partner Broken_Dump_Task for further
{ disposition.  It checks for output line limits, timeouts, and page_wait when displaying output to the
{ console.
{        S: The string which is to be written to the output buffer.
{        STATUS: VAR of ost$status.
{

  PROCEDURE [XDCL] syp$write_output_line
    (    s: string ( * );
     VAR status: ost$status);

    VAR
      ignore_status: ost$status,
      length: integer,
      line_received: boolean,
      text: string (80);


    status.normal := TRUE;

    IF syv$terminate_sysdebug_output THEN
      dpp$put_next_line (display_id, 'Display terminated.', status);
      syp$cause_condition (syc$udc_display_cmnd_terminated);
    IFEND;

    IF syv$debug_output_disposal_info.output_destination <> syc$dod_null THEN

{ Send the output line to the appropriate destination(s):
{ Retain on a permanent file and/or send to the printer.

      syv$debug_line_count := syv$debug_line_count + 1;
      IF syv$debug_line_count > syv$max_debug_output_lines THEN
        syp$cause_condition (syc$udc_max_debug_output_lines);
      IFEND;
      osp$output_debug_text (^s, status);
      IF NOT status.normal THEN
        STRINGREP (text, length, 'status.condition = ', status.condition: #(16));
        dpp$put_next_line (display_id, text (1, length), ignore_status);
        syv$debugger_task_timeout := TRUE;
        syp$cause_condition (syc$udc_debugger_task_timeout);
      IFEND;
    ELSE

{ Send to the system console.

      dpp$put_next_line (display_id, s, status);
      syv$db_displayed_console_lines := syv$db_displayed_console_lines + 1;
      IF (syv$db_page_wait_lines_instance <> 0) AND (syv$db_displayed_console_lines >=
            syv$db_page_wait_lines_instance) THEN
        dpp$put_next_line (display_id, '<OVER>', status);
        status.normal := TRUE;
        dpp$get_next_line (display_id, osc$wait, text, line_received);
        IF text = '' THEN
          syv$db_displayed_console_lines := 0;
          RETURN;
        ELSE
          syv$terminate_sysdebug_output := TRUE;
          dpp$put_next_line (display_id, 'Display terminated.', status);
          syp$cause_condition (syc$udc_display_cmnd_terminated);
        IFEND;
      IFEND;
      status.normal := TRUE;
    IFEND;

  PROCEND syp$write_output_line;
??EJECT??

VAR
    setdcl_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number', syc$integer_value, 1, 1, dbc$max_auto_cmds]];

VAR
    disdcl_pdt: [READ, oss$mainframe_paged_literal] array [1 .. 1] of syt$parameter_descriptor := [
{   } [TRUE, 1, 'number', syc$integer_value, 1, 1, dbc$max_auto_cmds]];


  PROCEDURE disdclproc (text: string ( * );
        id: dpt$window_id;
    VAR status: ost$status);

    VAR
      msg: string (50),
      ii: integer,
      str: string (60),
      i: integer;

    syv$debug_line_count := 0;
    IF syv$dump_to_pf THEN
      str := ' DISPLAY AUTO COMMAND LIST ';
      str (28, * ) := text;
      osp$output_debug_heading (^str, status);

      IF NOT status.normal THEN
        RETURN;
      IFEND;

    IFEND;


    i := 1;
    WHILE auto_cmds [i].command <> '   ' DO
      msg := '   ';
      STRINGREP (msg, ii, ' ', i, ': ');
      msg (7, * ) := auto_cmds [i].command;
      syp$write_output_line (msg, status);
      i := i + 1;
    WHILEND;
    status.normal := TRUE;
  PROCEND disdclproc;
?? EJECT ??

  PROCEDURE setdclproc (text: string ( * );
        id: dpt$window_id;
    VAR status: ost$status);

    VAR
      i,
      j: integer,
      state: (s1, s2),
      str: string (60),
      pvt: array [1 .. 1] of syt$parameter_value,
      sss: string (dbc$max_auto_cmd_length);


    syv$debug_line_count := 0;
    syp$crack_command (setdcl_pdt, text, pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    IF syv$dump_to_pf THEN
      str := ' SET AUTO COMMAND LIST ';
      str (26, * ) := text;
      osp$output_debug_heading (^str, status);

      IF NOT status.normal THEN
        RETURN;
      IFEND;

    IFEND;

    status.normal := TRUE;
    sss := '   ';
    state := s1;
    j := 1;
    FOR i := 1 TO STRLENGTH (text) DO
      CASE state OF
      = s1 =
        IF text (i) = '''' THEN
          state := s2;
        IFEND;
      = s2 =
        IF j > dbc$max_auto_cmd_length THEN
          osp$set_status_abnormal ('DB', dbe$, 'command too long', status);
          RETURN;
        IFEND;
        IF text (i) = '''' THEN
          auto_cmds [pvt [1].int].command  := sss;
          auto_cmds [pvt [1].int].jobmntr_execution_only := FALSE;
          RETURN;
        ELSE
          sss (j) := text (i);
          j := j + 1;
        IFEND;
      CASEND;
    FOREND;
    osp$set_status_abnormal ('DB', dbe$, 'no end of cmd', status);
  PROCEND setdclproc;










?? OLDTITLE, OLDTITLE ??
MODEND sym$debug;
