?? RIGHT := 110 ??
?? TITLE := 'NOS/VE Broken_Job Dump Support' ??
MODULE osm$broken_job_dump;

{  PURPOSE:
{    The purpose of the routines in this module is to support the
{    dumping of a job/task environment from within a broken task
{    to a perm file.

?? PUSH (LISTEXT := ON) ??
*copyc syc$monitor_request_codes
*copyc tmt$rb_delay
*copyc i#call_monitor
*copyc i#move
*copyc osp$clear_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$test_set_main_sig_lock
*copyc osp$test_sig_lock
*copyc pmp$get_executing_task_gtid
*copyc pmp$ready_task
*copyc osv$mainframe_pageable_heap
*copyc syv$debug_output_disposal_info
?? POP ??

  CONST
    buffer_size = 16 * 1024,

    text_output = 0,
    heading_output = 1;

  TYPE
    ost$broken_job_buffer = record
      status: ost$broken_job_buffer_status,
      hdr: ost$broken_job_dump_header,
      buf: array [1 .. buffer_size] of cell,
    recend,
    ost$broken_job_buffer_status = (osc$wait_data, osc$wait_dump),
    ost$broken_job_dump_header = record
      case dt: (osc$start_dump, osc$new_segment, osc$text, osc$segment_data,
        osc$end_dump) of
      = osc$start_dump =
        dum1: boolean,
      = osc$new_segment =
        seg_num: 0 .. 0fff(16),
        length: 0 .. 0ffffffff(16),
      = osc$text =
        text_length: 0 .. buffer_size,
      = osc$end_dump =
        dum2: boolean,
      casend,
    recend;

  VAR
    broken_job_dump_lock: ost$signature_lock,
    ctl: integer,
    dump_task_lock: ost$signature_lock,
    dump_active: boolean := FALSE,
    broken_job_dumper_gtid: ost$global_task_id,
    broken_job_buffer: ^ost$broken_job_buffer := NIL,
    broken_job_gtid: ost$global_task_id,
    osv$debugger_output_disposition: [XDCL, #GATE] syt$debug_output_disposal_info := [syc$dod_null, *];

?? NEWTITLE := '  RESPOND', EJECT ??

  PROCEDURE respond (s: ost$broken_job_buffer_status;
    VAR st: ost$status);

    VAR
      i: integer,
      osv$timeout_count: [XDCL] integer := 6;

    st.normal := TRUE;
    CASE s OF
    = osc$wait_data =
      broken_job_buffer^.status := osc$wait_data;
      pmp$ready_task (broken_job_gtid, st);
      IF NOT st.normal THEN
        RETURN;
      IFEND;
      WHILE broken_job_buffer^.status <> osc$wait_dump DO
        pause (10000);
      WHILEND;
    = osc$wait_dump =
      broken_job_buffer^.status := osc$wait_dump;
      pmp$ready_task (broken_job_dumper_gtid, st);
      IF NOT st.normal THEN
        RETURN;
      IFEND;
      i := 0;
      WHILE (broken_job_buffer^.status <> osc$wait_data) AND (i < osv$timeout_count) DO
        pause (10000);
        i := i + 1;
      WHILEND;
      IF broken_job_buffer^.status <> osc$wait_data THEN
        osp$set_status_abnormal ('OS', 0, 'Dump task not responding to presence of dump data', st);
      IFEND;
    CASEND;
  PROCEND respond;
?? OLDTITLE ??
?? NEWTITLE := '  OSP$BEGIN_TEXT_DUMP', EJECT ??
  PROCEDURE [XDCL] osp$begin_text_dump (VAR status: ost$status);

    VAR
      local_status: ost$status,
      ls: ost$signature_lock_status,
      locked: boolean,
      p: ^ost$broken_job_buffer;

    osp$test_sig_lock (broken_job_dump_lock, ls);
    IF ls = osc$sls_locked_by_current_task THEN
      osp$set_status_abnormal ('OS', 0, 'Dump to file/printer already in progress', status);
      RETURN;
    IFEND;
    osp$test_set_main_sig_lock (broken_job_dump_lock, locked);
    IF NOT locked THEN
      osp$set_status_abnormal ('OS', 0, 'Dump to file/printer already in progress', status);
      RETURN;
    IFEND;

    pmp$get_executing_task_gtid (broken_job_gtid);

    ALLOCATE p IN osv$mainframe_pageable_heap^;
    IF p = NIL THEN
      osp$set_status_abnormal ('OS', 0, 'cant allocate dump buffer', status);
      osp$clear_mainframe_sig_lock (broken_job_dump_lock);
      RETURN;
    IFEND;

    p^.status := osc$wait_data;
    broken_job_buffer := p;
    dump_active := TRUE;

    broken_job_buffer^.hdr.dt := osc$start_dump;
    respond (osc$wait_dump, local_status);
    IF NOT local_status.normal THEN
      dump_active := FALSE;
      FREE broken_job_buffer IN osv$mainframe_pageable_heap^;
      osp$clear_mainframe_sig_lock (broken_job_dump_lock);
      osp$set_status_abnormal ('OS', 0, 'dump task not present/reponding', status);
    ELSE
      ctl := 0;
      broken_job_buffer^.hdr.dt := osc$text;
    IFEND;
  PROCEND osp$begin_text_dump;
?? OLDTITLE ??
?? NEWTITLE := '  OSP$END_TEXT_DUMP', EJECT ??
  PROCEDURE [XDCL] osp$end_text_dump;

    VAR
      ls: ost$signature_lock_status,
      ignore_status: ost$status;

    osp$test_sig_lock (broken_job_dump_lock, ls);
    IF ls <> osc$sls_locked_by_current_task THEN
      RETURN;
    IFEND;

    IF ctl <> 0 THEN
      broken_job_buffer^.hdr.text_length := ctl;
      respond (osc$wait_dump, ignore_status);
      ctl := 0;
    IFEND;

    broken_job_buffer^.hdr.dt := osc$end_dump;
    respond (osc$wait_dump, ignore_status);

    FREE broken_job_buffer IN osv$mainframe_pageable_heap^;
    osp$clear_mainframe_sig_lock (broken_job_dump_lock);
  PROCEND osp$end_text_dump;
?? OLDTITLE ??
?? NEWTITLE := '  OSP$OUTPUT_DEBUG_TEXT', EJECT ??
  PROCEDURE [XDCL] osp$output_debug_text (s: ^string ( * );
    VAR status: ost$status);

    VAR
      zero: 0 .. 0ff(16),
      ps: 0 .. 0ffff(16);

    zero := text_output;

    IF broken_job_buffer = NIL THEN
      RETURN;
    IFEND;

    ps := STRLENGTH (s^);
    IF (ctl + ps + #SIZE (ps) + #SIZE (zero)) > buffer_size THEN
      broken_job_buffer^.hdr.text_length := ctl;
      broken_job_buffer^.hdr.dt := osc$text;
      respond (osc$wait_dump, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      ctl := 0;
    IFEND;

    i#move (#LOC (zero), #LOC (broken_job_buffer^.buf [ctl + 1]), #SIZE
          (zero));
    ctl := ctl + #SIZE (zero);


    i#move (#LOC (ps), #LOC (broken_job_buffer^.buf [ctl + 1]), #SIZE
          (ps));
    ctl := ctl + #SIZE (ps);
    i#move (#LOC (s^ (1)), #LOC (broken_job_buffer^.buf [ctl + 1]), ps);
    ctl := ctl + ps;

  PROCEND osp$output_debug_text;
?? OLDTITLE ??
?? NEWTITLE := '  OSP$OUTPUT_DEBUG_HEADING', EJECT ??
  PROCEDURE [XDCL] osp$output_debug_heading (s: ^string ( * );
    VAR status: ost$status);

    VAR
      one: 0 .. 0ff(16),
      ps: 0 .. 0ffff(16);

    one := heading_output;

    IF broken_job_buffer = NIL THEN
      RETURN;
    IFEND;

    ps := STRLENGTH (s^);
    IF (ctl + ps + #SIZE (ps) + #SIZE (one)) > buffer_size THEN
      broken_job_buffer^.hdr.text_length := ctl;
      broken_job_buffer^.hdr.dt := osc$text;
      respond (osc$wait_dump, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      ctl := 0;
    IFEND;

    i#move (#LOC (one), #LOC (broken_job_buffer^.buf [ctl + 1]), #SIZE
          (one));
    ctl := ctl + #SIZE (one);

    i#move (#LOC (ps), #LOC (broken_job_buffer^.buf [ctl + 1]), #SIZE
          (ps));
    ctl := ctl + #SIZE (ps);
    i#move (#LOC (s^ (1)), #LOC (broken_job_buffer^.buf [ctl + 1]), ps);
    ctl := ctl + ps;

  PROCEND osp$output_debug_heading;
?? OLDTITLE ??
?? NEWTITLE := '  OSP$DUMP_BROKEN_TASK', EJECT ??
  PROCEDURE [XDCL, #GATE] osp$dump_broken_task
    (    sp: ^array [1 .. 00fffffff(16)] OF cell;
     VAR dump_in_progress: boolean;
     VAR amount: integer);

    VAR
      ignore_status: ost$status,
      locked: boolean,
      status: ost$status,
      tl: integer;

    pmp$get_executing_task_gtid (broken_job_dumper_gtid);
    IF (NOT dump_active) OR (broken_job_buffer = NIL) THEN
      dump_in_progress := FALSE;
      RETURN;
    IFEND;
    wait_dump;
    osp$test_set_main_sig_lock (dump_task_lock, locked );
    dump_in_progress := TRUE;
    ignore_status.normal := TRUE;
    status.normal := TRUE;

  /dump/
    BEGIN
      CASE broken_job_buffer^.hdr.dt OF
      = osc$start_dump =

{ Tell the broken job dump task how the incoming data should be disposed of.

        osv$debugger_output_disposition := syv$debug_output_disposal_info;
        respond (osc$wait_data, status);
        dump_in_progress := status.normal;

      = osc$new_segment, osc$segment_data =
        respond (osc$wait_data, status);
        dump_in_progress := status.normal;

      = osc$text =
        tl := broken_job_buffer^.hdr.text_length;
        i#move (#LOC (broken_job_buffer^.buf), #LOC (sp^ [amount + 1]), tl);
        amount := amount + tl;
        respond (osc$wait_data, status);
        dump_in_progress := status.normal;

      = osc$end_dump =
        broken_job_buffer^.status := osc$wait_data;
        pmp$ready_task (broken_job_gtid, ignore_status);
        dump_in_progress := FALSE;
        dump_active := FALSE;
      CASEND;
    END /dump/;
    osp$clear_mainframe_sig_lock (dump_task_lock);

  PROCEND osp$dump_broken_task;
?? OLDTITLE ??
?? NEWTITLE := '  WAIT_DUMP', EJECT ??
  PROCEDURE wait_dump;

    WHILE broken_job_buffer^.status <> osc$wait_dump DO
      pause (10000);
    WHILEND;

  PROCEND wait_dump;
?? OLDTITLE ??
?? NEWTITLE := '  PAUSE', EJECT ??
  PROCEDURE pause (ms: 0 .. 0ffffffff(16));

    VAR
      delay: tmt$rb_delay;

    delay.reqcode := syc$rc_delay;
    delay.requested_wait_time := #free_running_clock (0) + ms * 1000;
    delay.expected_wait_time := delay.requested_wait_time;
    i#call_monitor (#LOC (delay), #SIZE (delay));

  PROCEND pause;
?? OLDTITLE, OLDTITLE ??
MODEND
