PROCEDURE dum$display_locked_segments, display_locked_segments, disls (
  ajl_ordinal, ao: any of
      key (all a) keyend
      integer
    anyend = all
  output, o: file = $output
  status)

" This procedure performs an analysis of all tasks in all jobs which are currently active (have ajl entries),
" plus monitor.  It displays the sdtx entry for any locked segment.

  VAR
    cctqm: string 1..256 = '???????????????????????????????? !"#$%&''()*+,-./0123456789:;'//..
          '<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~????????????????'//..
          '???????????????????????????????????????????????????????????????????????????????????'//..
          '??????????????????????????????'
    jmv$jcb: integer = 300000000(16)               "($sa(jmv$jcb))
    job_fixed_seg_num: integer = 14(16)            "relative to monitor address space
    job_monitor_xcb_offset: integer = 100(16)      "from start of job fixed
    sdtx_entry_size: integer = 24(16)
  VAREND

  VAR
    ajl: integer
    ajl_entry_size: integer
    ajl_ord: integer
    ajl_p: integer
    field_length: integer
    field_offset: integer
    function: integer
    in_use: integer
    in_use_len: integer
    job_monitor_xcb: integer
    job_name: integer
    last_ajl_ordinal: integer
    link: integer
    local_file: file = $fname('$local.'//$unique)
    local_status: status
    mcr: integer
    monitor_functions: ARRAY 0 .. 74 OF string
    number_of_entries: integer
    output_file: file
    pva: integer
    sdt_len_off: integer
    sdtx_offset_offset: integer
    sdtx_p: integer
    segment_lock: integer
    start_ajl_ordinal: integer
    system_ajl_ordinal: integer
    task_name: integer
    task_xcb: integer
    temp_file: file = $fname('$local.'//$unique)
    user_id: integer
  VAREND

  IF $file(output open_position) = '$BOI' THEN
    delete_file f=output status=local_status
    set_file_attributes f=output fc=list
  IFEND
  output_file = output.$eoi
  set_file_attributes f=temp_file fc=unknown

  put_line l='1COMMAND: DISPLAY_LOCKED_SEGMENTS' o=output_file
  put_line l=' ' o=output_file

  change_default e=monitor am=pva

  jmt$active_job_list_entry field=IN_USE offset=field_offset length=field_length
  in_use = field_offset/8                 "offset into ajl
  in_use_len = field_length/8             "length of in_use field in bytes
  ost$execution_control_block field=SAVE9 offset=field_offset length=field_length
  task_name = field_offset/8              "offset into the XCB
  ost$execution_control_block field=LINK offset=field_offset length=field_length
  link = field_offset/8                   "offset into xcb
  ost$execution_control_block field=SDTX_OFFSET offset=field_offset length=field_length
  sdtx_offset_offset = field_offset/8
  ost$exchange_package field=SEGMENT_TABLE_LENGTH offset=field_offset length=field_length
  sdt_len_off = field_offset/8
  mmt$segment_descriptor_extended field=SEGMENT_LOCK offset=field_offset length=field_length
  segment_lock = field_offset/8           "offset into segment descriptor table extended
  jmt$job_control_block field=JOBNAME offset=field_offset length=field_length
  job_name = field_offset/8               "offset into job control block
  jmt$job_control_block field=USER_ID offset=field_offset length=field_length
  user_id = field_offset/8                "offset into job control block

  ajl_p = $symbol_address(jmv$ajl_p)
  ajl = $memory(ajl_p)
  IF $nil_pva(ajl) THEN
    put_line l=' The active job list has not yet been established.' o=output_file
    EXIT PROCEDURE
  IFEND

  ajl_entry_size = $memory(ajl_p+14 4)
  system_ajl_ordinal = $memory(ajl_p+10 4)
  number_of_entries = $memory(ajl_p+6 4) / ajl_entry_size
  last_ajl_ordinal = system_ajl_ordinal + number_of_entries - 1

  change_processor_register ..
        jps=$rma(((system_ajl_ordinal + job_fixed_seg_num)*100000000(16))+job_monitor_xcb_offset)
  change_default e=job

  create_monitor_func_file f=local_file
  accept_line v=monitor_functions i=local_file
  detach_file f=local_file

  IF $value_kind(ajl_ordinal) = 'INTEGER' THEN
    start_ajl_ordinal = ajl_ordinal
    IF start_ajl_ordinal > last_ajl_ordinal THEN
      put_line l=' The specified ordinal is beyond the end of the active job list.' o=output_file
      EXIT PROCEDURE
    IFEND
    last_ajl_ordinal = start_ajl_ordinal
  ELSE
    start_ajl_ordinal = system_ajl_ordinal
  IFEND

  FOR ajl_ord = start_ajl_ordinal TO last_ajl_ordinal DO
    IF $memory(((ajl + (ajl_ord * ajl_entry_size)) + in_use), in_use_len) > 0 THEN "process entry
      put_line l=' *************************************************************************' o=output_file
      put_line l=' processing ajl ordinal '//$strrep(ajl_ord, 16) o=output_file
      pva = ((ajl_ord + job_fixed_seg_num) * 100000000(16)) + job_monitor_xcb_offset
      job_monitor_xcb = $rma(pva monitor)
      change_processor_register jps=job_monitor_xcb

      IF ajl_ord <> system_ajl_ordinal THEN
        put_line l=' job name = '//$trim($translate(cctqm $memory_string(jmv$jcb+job_name 31))) o=output_file
      IFEND
      put_line l=' user id = '//$trim($translate(cctqm $memory_string(jmv$jcb+user_id 31))) o=output_file
      put_line l=' -------------------------------------------------------------------------' o=output_file

      task_xcb = $memory($symbol_address(job_xcb_list))

      process_tasks: ..
      REPEAT
        change_processor_register jps=$rma(task_xcb)

        " Look for locked segments.

        sdtx_p = 300000000(16) + $memory((task_xcb + sdtx_offset_offset), 4)
        number_of_entries = $memory((task_xcb + sdt_len_off), 2)
        found = FALSE

        FOR index = 0 to number_of_entries - 1 DO
          entry_p = sdtx_p + sdtx_entry_size * index
          IF $memory(entry_p+segment_lock 1) > 2 THEN
            IF NOT found THEN
              put_line l='1Task name = '//$trim($translate(cctqm $memory_string((task_xcb+task_name) 31))) ..
                    o=output_file
              mcr = $process_register(mcr) / 10(16)
              IF mcr = ((mcr / 2) * 2) THEN
                function = $memory(task_xcb+088(16) 1)
                IF (function > 0) AND (function < 75) THEN
                  put_line l=' monitor request = '//monitor_functions(function) o=output_file
                IFEND
              IFEND
            IFEND
            put_line l=' SEGMENT '//$strrep(index) o=output_file
            display_memory a=entry_p b=sdtx_entry_size t='SEGMENT '//$strrep(index) o=temp_file
            copy_file i=temp_file o=output_file
            found = TRUE
          IFEND
        FOREND
        IF found THEN
          display_call e=job t=$strrep(ajl_ord)//' '//$memory_string((task_xcb+task_name) 24) o=temp_file
          copy_file i=temp_file o=output_file
        IFEND
        EXIT process_tasks WHEN $rma(task_xcb) = job_monitor_xcb
        task_xcb = $memory(task_xcb+link)
      UNTIL $nil_pva(task_xcb)
    IFEND
  FOREND

PROCEND dum$display_locked_segments
