PROC qcm$display_locked_segments, disls (
  ajl_ordinal, ao: integer or key all, a = all
  output, o: file = $output
  status)


  crev s k=status
  IF $file($value(output) open_position) = '$BOI' THEN
    rewind_file $value(output) status=s
    output_file = $string($value(output)) // '.$asis'
  ELSE
    output_file = $string($value(output))
  IFEND
  change_default e=m am=pva

  crev field_len integer
  crev field_off integer
"Constants:
  in_use = 0 "offset into ajl entry of in use flag
  job_fixed_seg_num = 14(16) "relative to monitor address space
  job_monitor_xcb_offset = 100(16)" from start of job fixed
  ost$execution_control_block field=save9 offset=field_off length=field_len
  task_name = field_off/8  "offset into the XCB
  ost$execution_control_block field=link offset=field_off  length=field_len
  link = field_off/8 "offset into xcb
  ost$execution_control_block field=sdtx_p offset=field_off  length=field_len
  sdtx_p_offset = field_off/8 "offset into xcb
  mmt$segment_descriptor_extended field=segment_lock offset=field_off length=field_len
  segment_lock = field_off/8 "offset into segment descriptor table extended
  jmt$job_control_block field=job_name offset=field_off  length=field_len
  job_name = field_off/8 "offset into job control block
  jmt$job_control_block field=user_id offset=field_off   length=field_len
  user_id = field_off/8 "offset into job control block

  ajl_p = $sa(jmv$ajl_p)
  ajl = $mem(ajl_p)
  IF $nil_pva(ajl) THEN
    put_line '1the active job list has not yet been established.' ..
          o=$fname(output_file)
    EXIT_PROC
  IFEND
  ajl_entry_size = $mem(ajl_p+14 4)
  system_ajl_ordinal = $mem(ajl_p+10 4)
  number_of_entries = $mem(ajl_p+6 4) / ajl_entry_size
  last_ajl_ordinal = system_ajl_ordinal + number_of_entries - 1
  system_job_fixed = system_ajl_ordinal + job_fixed_seg_num
  system_job_monitor_xcb = $rma(..
        ((system_job_fixed*100000000(16))+job_monitor_xcb_offset))
  change_default e=job
  change_processor_register jps=system_job_monitor_xcb
  jmv$jcb = 300000000(16) "($sa(jmv$jcb))
  create_variable monitor_functions k=string d=0..74
  f1 = $unique
  create_monitor_func_file ($fname(f1))
  accl monitor_functions $fname(f1)
  delf $fname(f1)
  create_variable swap_status k=string d=0..16
  f1 = $unique
  create_swap_status_file ($fname(f1))
  accl swap_status $fname(f1)
  delf $fname(f1)

  IF $value_kind(ajl_ordinal) = 'INTEGER' THEN
    start_ajl_ordinal = $value(ajl_ordinal)
    IF start_ajl_ordinal > last_ajl_ordinal THEN
      putl ' ordinal is beyond end of active job list' o=$fname(output_file)
      EXIT_PROC
    IFEND
    last_ajl_ordinal = start_ajl_ordinal
  ELSE
    start_ajl_ordinal = system_ajl_ordinal
  IFEND


crev cctqm k=(string,256) value= '????????????'//..
'???????????????????? !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijkl'//..
'mnopqrstuvwxyz{|}~????????????????????????????????????????????????????????????????????????????????'//..
'?????????????????????????????????????????????????'

  FOR ajl_ord = start_ajl_ordinal TO last_ajl_ordinal DO

    ajl_entry = ajl + (ajl_ord * ajl_entry_size)

    IF $mem(ajl_entry+in_use, 1) = 1 THEN "process entry

      putl '0processing ajl ordinal '//$strrep(ajl_ord,16) o=$fname(output_file)

      seg_num = ajl_ord + job_fixed_seg_num
      pva = (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
        putl '0job name = '//$trim($translate(cctqm $ms(jmv$jcb+job_name 31))) o=$fname(output_file)
      IFEND
      putl '0user id = '//$trim($translate(cctqm $ms(jmv$jcb+user_id 31))) o=$fname(output_file)

      task_xcb = $mem($sa(job_xcb_list))

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

  " Look for locked segments.

        sdtx_p = task_xcb + sdtx_p_offset
        sdtx_length = $mem(sdtx_p+6 4)
        sdtx_size = $mem(sdtx_p+14 4)
        number_of_entries = sdtx_length / sdtx_size
        found = FALSE
        sdtx_p = $mem(sdtx_p 6)

        FOR index = 0 to number_of_entries - 1 DO
          entry_p = sdtx_p + sdtx_size * index
          lock = $mem(entry_p+segment_lock 1)
          IF lock <> 0 THEN
            IF NOT found THEN
               put_line '0Task name = '//$trim($ms((task_xcb+task_name) 31)) ..
                o=$fname(output_file)
              mcr = $process_register(mcr)
              mcr = mcr / 10(16)
              temp = mcr / 2
              temp = temp * 2
              IF mcr = temp THEN
                function = $mem(task_xcb+088(16) 1)
                IF (function > 0) AND (function < 75) THEN
                  putl ' monitor request = '//monitor_functions(function) o=$fname(output_file)
                IFEND
              IFEND
            IFEND
            putl ' SEGMENT '//$strrep(index) o=$fname(output_file)
            dism entry_p sdtx_size t='SEGMENT '//$strrep(index)   o=$fname(output_file)
            found = true
          IFEND
        FOREND

        IF found THEN
          display_call e=job o=$fname(output_file) ..
                t=$strrep(ajl_ord)//' '//$ms((task_xcb+task_name) 24)
        IFEND


        EXIT process_tasks WHEN $rma(task_xcb) = job_monitor_xcb
        task_xcb = $mem(task_xcb+link)

      UNTIL $nil_pva(task_xcb)

    IFEND

  FOREND

PROCEND qcm$display_locked_segments
