?? TITLE := 'NOS/VE : Tasking : Ring 1 support' ??
MODULE pmm$tasking_support_ring_1;
?? RIGHT := 110 ??

{  PURPOSE:
{    This module contains ring 1 procedures and data structures necessary to support tasking.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc mmt$io_control_block
*copyc mmt$iocb_index
*copyc pme$execution_exceptions
*copyc pme$program_services_exceptions
*copyc pmp$send_signal
*copyc pmt$condition_name
*copyc pmt$task_cp_time
*copyc pmt$task_id
*copyc ost$execution_control_block
*copyc ost$status
*copyc ose$heap_full_exceptions
*copyc syt$monitor_request_code
*copyc syc$monitor_request_codes
*copyc tme$monitor_mode_exceptions
*copyc ost$wait
*copyc ost$global_task_id
*copyc oss$job_fixed
*copyc osc$processor_defined_registers
*copyc osd$code_base_pointer
*copyc tmc$signal_identifiers
*copyc ost$heap
*copyc pmt$ready_task_list
*copyc pmt$stack_segment
*copyc tmt$primary_task_list
*copyc tmt$rb_ready_task_list
?? POP ??
*copyc job_xcb_list
*copyc osp$expand_ptl
*copyc osp$system_error
*copyc osp$set_status_abnormal
*copyc osp$initialize_sig_lock
*copyc osp$set_mainframe_sig_lock
*copyc osp$clear_mainframe_sig_lock
*copyc osp$set_status_from_mtr_status
*copyc osp$set_status_condition
*copyc i#call_monitor
*copyc i#move
*copyc jmp$job_monitor_xcb
*copyc pmf$executing_task_xcb
*copyc pmf$task_xcb
*copyc pmp$cycle
*copyc pmp$get_task_cp_time
*copyc syp$cycle
*copyc jmv$jcb
*copyc jmv$task_private_templ_p
*copyc osv$job_fixed_heap
*copyc pmv$task_template
*copyc osv$mainframe_wired_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    unexpected_abnormal_status = 'unexpected abnormal status';

?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$initialize_task_xcb', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$initialize_job_xcb_list
    (    job_monitor_task_id: pmt$task_id;
         job_monitor_tcb: ^cell;
         trap_handler: ^procedure);

{  PURPOSE:
{    This procedure adds the job_monitor XCB to the job XCB list and sets the trap handler pointer.

*copyc jmv$job_trap_handler

    VAR
      xcb: ^ost$execution_control_block,
      local_status: ost$status;

{!  Temporary until locks can be initialized statically.
    osp$initialize_sig_lock (job_xcb_list.lock);
{!  End temporary code.
    xcb := jmp$job_monitor_xcb ();
    xcb^.link := NIL;
    xcb^.task_id := job_monitor_task_id;
    xcb^.task_control_block := #ADDRESS (osc$tmtr_ring, #SEGMENT (job_monitor_tcb),
          #OFFSET (job_monitor_tcb));
    xcb^.received_message_list.fill := 0;
    xcb^.received_message_list.next_received_message := NIL;
    xcb^.save9 {task_name} := '$JOBMNTR';
    job_xcb_list.head := xcb;
    jmv$job_trap_handler := trap_handler;
    pmv$task_template := jmv$task_private_templ_p;

  PROCEND pmp$initialize_job_xcb_list;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$find_task_xcb', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$find_task_xcb
    (    task_id: pmt$task_id;
     VAR xcb: ^ost$execution_control_block);

*copyc pmh$find_task_xcb

    xcb := pmf$task_xcb (task_id);

  PROCEND pmp$find_task_xcb;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$get_executing_task_gtid', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_executing_task_gtid
    (VAR global_task_id: ost$global_task_id);

*copyc pmh$get_executing_task_gtid

    global_task_id := pmf$executing_task_xcb () ^.global_task_id

  PROCEND pmp$get_executing_task_gtid;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$create_child_xcb', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$create_child_xcb
    (    task_id: pmt$task_id;
         task_control_block: ^cell;
         initial_procedure: ^procedure;
         initial_ring: ost$ring;
         task_kind: ost$task_kind;
     VAR status: ost$status);

{  PURPOSE:
{    This procedure creates an XCB for a new child task and adds it to the job XCB list.

    VAR
      xcb,
      parent_xcb: ^ost$execution_control_block,
      osv$default_pit: [XREF] integer,
      code_base_pointer: ^ost$external_code_base_pointer,
      converter: record
        case 0 .. 3 of
        = 0 =
          procedure_pointer: ^procedure,
        = 1 =
          code_base_pointer: ^ost$external_code_base_pointer,
        = 2 =
          pva: ost$pva,
        = 3 =
          cell_p: ^cell,
        casend,
      recend;

    ALLOCATE xcb IN osv$job_fixed_heap^;
    IF #OFFSET (xcb) > UPPERVALUE (tmt$xcb_offset_size) THEN
      FREE xcb IN osv$job_fixed_heap^;
      osp$set_status_abnormal ('PM', pme$xcb_offset_exceeds_maximum, '', status);
      RETURN; {----->
    IFEND;
    xcb^ := pmv$task_template^.xcb;
    converter.procedure_pointer := initial_procedure;
    code_base_pointer := converter.code_base_pointer;
    xcb^.xp.p_register.pva.ring := initial_ring;
    xcb^.xp.p_register.pva.seg := #SEGMENT (code_base_pointer^.code_pva);
    xcb^.xp.p_register.pva.offset := #OFFSET (code_base_pointer^.code_pva);
    xcb^.xp.a3 := #ADDRESS (initial_ring, #SEGMENT (code_base_pointer^.binding_pva),
          #OFFSET (code_base_pointer^.binding_pva));
    converter.pva := xcb^.xp.tos_registers [initial_ring].pva;
    xcb^.xp.a0_dynamic_space_pointer := converter.cell_p;
    xcb^.xp.a1_current_stack_frame := converter.cell_p;
    xcb^.xp.base_constant_1 := #OFFSET (xcb) DIV 10000(16);
    xcb^.xp.base_constant_2 := #OFFSET (xcb) MOD 10000(16);
    xcb^.xp.process_interval_timer_1 := osv$default_pit DIV 10000(16);
    xcb^.xp.process_interval_timer_2 := osv$default_pit MOD 10000(16);
    xcb^.pit_count := osv$default_pit;
    xcb^.task_id := task_id;
    xcb^.task_control_block := task_control_block;
    xcb^.received_message_list.fill := 0;
    xcb^.received_message_list.next_received_message := NIL;
    xcb^.task_kind := task_kind;
    xcb^.save9 {task_name} := osc$null_name;

    parent_xcb := pmf$executing_task_xcb ();
    xcb^.processor_selections := parent_xcb^.processor_selections;
    xcb^.requested_processor_selections := parent_xcb^.requested_processor_selections;
    xcb^.relative_task_priority := 128;
    xcb^.dispatching_priority := parent_xcb^.dispatching_priority;
    xcb^.dispatching_priority_bias_id := parent_xcb^.dispatching_priority_bias_id;
    xcb^.dispatching_priority_bias := parent_xcb^.dispatching_priority_bias;

    osp$set_mainframe_sig_lock (job_xcb_list.lock);
    xcb^.link := job_xcb_list.head;
    job_xcb_list.head := xcb;
    osp$clear_mainframe_sig_lock (job_xcb_list.lock);

  PROCEND pmp$create_child_xcb;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$release_child_xcb', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$release_child_xcb
    (    task_id: pmt$task_id;
     VAR child_tcb: ^cell);

{  PURPOSE:
{    This procedure removes a child task's XCB from the job XCB list and frees the space occupied
{    by the XCB.

    VAR
      predecessor: ^^ost$execution_control_block,
      child_xcb: ^ost$execution_control_block;

    osp$set_mainframe_sig_lock (job_xcb_list.lock);
    predecessor := ^job_xcb_list.head;
    WHILE (predecessor^ <> NIL) AND (predecessor^^.task_id <> task_id) DO
      predecessor := ^predecessor^^.link;
    WHILEND;
    IF predecessor^ = NIL THEN
      osp$clear_mainframe_sig_lock (job_xcb_list.lock);
      osp$system_error ('child XCB lost', NIL);
    ELSE
      child_xcb := predecessor^;
      predecessor^ := child_xcb^.link;
      osp$clear_mainframe_sig_lock (job_xcb_list.lock);

      child_tcb := child_xcb^.task_control_block;

      FREE child_xcb IN osv$job_fixed_heap^;
    IFEND;

  PROCEND pmp$release_child_xcb;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$initiate_child_task', EJECT ??

*copyc pmt$spy_identifier

  PROCEDURE [XDCL, #GATE] pmp$initiate_child_task
    (    child: pmt$task_id;
         spy_identifier: pmt$spy_identifier;
         wait: ost$wait;
     VAR child_initiated: boolean);

{  PURPOSE:
{    This procedure issues the monitor request to activate a new child task.
*copyc tmt$rb_initiate_task

    VAR
      request_block: tmt$rb_initiate_task,
      local_status: ost$status;

    request_block.reqcode := syc$rc_initiate_task;
    request_block.xcb_p := pmf$task_xcb (child);
    IF spy_identifier > UPPERVALUE (pmt$spy_identifier) THEN
      osp$system_error ('invalid spy identifier', NIL);
    ELSE
      request_block.xcb_p^.xp.p_register.global_key := spy_identifier;
    IFEND;
    request_block.wait := osc$nowait;

  /issue_system_call/
    WHILE TRUE DO
      i#call_monitor (#LOC (request_block), #SIZE (request_block));
      IF request_block.status.normal THEN
        child_initiated := TRUE;
        RETURN {----->
      ELSE
        IF request_block.status.condition = tme$ptl_full THEN
          osp$expand_ptl ({ unconditionally_expand } FALSE, local_status);
          IF NOT local_status.normal THEN
            child_initiated := FALSE;
            RETURN {----->
          IFEND;
        ELSE
          osp$system_error (unexpected_abnormal_status, NIL);
        IFEND;
      IFEND;
    WHILEND /issue_system_call/;
  PROCEND pmp$initiate_child_task;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$task_end', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$task_end
    (    executing_task_id: pmt$task_id;
         parent_id: ost$global_task_id);

{  PURPOSE:
{    This procedure issues the monitor request to terminate task execution.
{  DESIGN:
{    If the task has an I/O control block for asynchronous I/O, the task must
{    cycle until all active I/O has completed.  The IOCB is freed, then the
{    monitor request to terminate task execution is issued.

*copyc tmt$rb_task_exit

    VAR
      io_active: boolean,
      iocb_index: mmt$iocb_index,
      iocb_ptr: ^mmt$io_control_block,
      local_status: ost$status,
      request_block: tmt$rb_task_exit,
      signal_contents_converter: ^^pmt$signal_contents,
      task_id: ^pmt$task_id,
      xcb_p: ^ost$execution_control_block;

    xcb_p := pmf$executing_task_xcb ();
    IF xcb_p^.iocb_p <> NIL THEN

{ Wait for any active io to complete.  When all I/O is complete, free the iocb.

      iocb_ptr := xcb_p^.iocb_p;
      io_active := TRUE;
      WHILE io_active DO
        io_active := FALSE;

      /check_io_active/
        FOR iocb_index := LOWERBOUND (iocb_ptr^.iocb_table) TO iocb_ptr^.maximum_iocb_index_in_use DO
          IF iocb_ptr^.iocb_table [iocb_index].active_io_count > 0 THEN
            io_active := TRUE;
            pmp$cycle (local_status);
            EXIT /check_io_active/; {----->
          IFEND;
        FOREND /check_io_active/;
      WHILEND;
      FREE xcb_p^.iocb_p IN osv$job_fixed_heap^;
    IFEND;

    request_block.reqcode := syc$rc_task_exit;
    request_block.signal.identifier := pmc$ss_child_terminated;
    task_id := ^executing_task_id;
    signal_contents_converter := #LOC (task_id);
    request_block.signal.contents := signal_contents_converter^^;
    request_block.parent_global_task_id := parent_id;

  /issue_system_call/
    WHILE TRUE DO
      i#call_monitor (#LOC (request_block), #SIZE (request_block));
      IF request_block.status.normal THEN
        EXIT /issue_system_call/ {----->
      ELSEIF request_block.status.condition = tme$mtr_signal_buffers_full THEN
        pmp$cycle (local_status);
        IF NOT local_status.normal THEN
          osp$system_error (unexpected_abnormal_status, ^local_status);
        IFEND;
      ELSE
        osp$system_error (unexpected_abnormal_status, NIL);
      IFEND;
    WHILEND /issue_system_call/;

  PROCEND pmp$task_end;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL, #GATE] pmp$update_tos_ring_1', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$update_tos_ring_1
    (    top_of_stack: ^cell);

    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          pva: ost$pva,
        = 1 =
          cell_pointer: ^cell,
        casend,
      recend,

      xcb: ^ost$execution_control_block,
      pva: ost$pva;

    xcb := pmf$executing_task_xcb ();

    converter.cell_pointer := top_of_stack;
    pva := converter.pva;


    IF pva.seg = xcb^.xp.tos_registers [pva.ring].pva.seg THEN
      xcb^.xp.tos_registers [pva.ring].pva.offset := pva.offset;
    ELSE
      {! should never get here, but just in case.
    IFEND;

  PROCEND pmp$update_tos_ring_1;
?? OLDTITLE ??
?? NEWTITLE := '  TEMPORARY procedures to support HCS tasking', EJECT ??
*copyc pmt$raw_task_statistics
?? NEWTITLE := '    [XDCL, #GATE] pmp$collect_raw_task_statistics', EJECT ??

{ PURPOSE:
{   The purpose of this request is to collect statistics for the
{   system command language DISPLAY_ACTIVE_TASKS command.
{
{ NOTES:
{   This procedure should only be used if approximate CPU statistics are
{   desired since the method of obtaining them (from xcb.cp_time) are not
{   accurate - the last task_time_slice is omitted.

  PROCEDURE [XDCL, #GATE] pmp$collect_raw_task_statistics
    (VAR active_task_count: 0 .. pmc$max_task_id;
     VAR active_task_statistics: array [1 .. * ] of pmt$raw_task_statistics);

    VAR
      xcb: ^ost$execution_control_block;

    active_task_count := 0;
    osp$set_mainframe_sig_lock (job_xcb_list.lock);
    xcb := job_xcb_list.head;
    WHILE (xcb <> NIL) AND (active_task_count < UPPERBOUND (active_task_statistics)) DO
      active_task_count := active_task_count + 1;
      active_task_statistics [active_task_count].task_name := xcb^.save9 {task_name} ;
      active_task_statistics [active_task_count].cp_time.task_time := xcb^.cp_time.time_spent_in_job_mode;
      active_task_statistics [active_task_count].cp_time.monitor_time := xcb^.cp_time.time_spent_in_mtr_mode;
      active_task_statistics [active_task_count].page_fault_count := xcb^.paging_statistics.page_fault_count;
      xcb := xcb^.link;
    WHILEND;
    WHILE (xcb <> NIL) DO
      active_task_count := active_task_count + 1;
      xcb := xcb^.link;
    WHILEND;
    osp$clear_mainframe_sig_lock (job_xcb_list.lock);

  PROCEND pmp$collect_raw_task_statistics;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] PMP$READY_TASK_LIST_R1', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$ready_task_list_r1
    (    highest_index: integer;
     VAR taskid_list: {input} pmt$ready_task_list;
         taskid_response_list_p: {output} ^pmt$ready_task_response_list;
     VAR first_bad_task_id_index: ost$task_index;
     VAR status: ost$status);

    VAR
      ready_task_list: tmt$rb_ready_task_list,
      tid_list_p: ^pmt$ready_task_list,
      response_list_p: ^pmt$ready_task_response_list;

    status.normal := TRUE;
    IF UPPERBOUND (taskid_list) < highest_index THEN
      osp$set_status_condition (pme$ready_task_list_size_error, status);
      RETURN; {----->
    ELSEIF (taskid_response_list_p <> NIL) AND (UPPERBOUND (taskid_response_list_p^) < highest_index) THEN
      osp$set_status_condition (pme$taskid_response_size_error, status);
      RETURN; {----->
    IFEND;

    ALLOCATE tid_list_p: [0 .. highest_index] IN osv$mainframe_wired_heap^;
    ALLOCATE response_list_p: [0 .. highest_index] IN osv$mainframe_wired_heap^;
    i#move (^taskid_list, ^tid_list_p^, #SIZE (tid_list_p^));

    ready_task_list.reqcode := syc$rc_ready_task_list;
    ready_task_list.highest_index := highest_index;
    ready_task_list.taskid_list_p := tid_list_p;
    ready_task_list.taskid_response_list_p := response_list_p;

    i#call_monitor (#LOC (ready_task_list), #SIZE (ready_task_list));

    IF ready_task_list.bad_task_id_found THEN
      first_bad_task_id_index := ready_task_list.bad_task_id_index;
    ELSE
      first_bad_task_id_index := highest_index + 1;
    IFEND;

    IF taskid_response_list_p <> NIL THEN
      i#move (^response_list_p^, ^taskid_response_list_p^, #SIZE (response_list_p^));
    IFEND;

    FREE tid_list_p IN osv$mainframe_wired_heap^;
    FREE response_list_p IN osv$mainframe_wired_heap^;

    IF NOT ready_task_list.status.normal THEN
      osp$set_status_from_mtr_status (ready_task_list.status, status);
    IFEND;

  PROCEND pmp$ready_task_list_r1;
?? OLDTITLE ??
?? NEWTITLE := '    [XDCL, #GATE] pmp$record_task_name', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$record_task_name
    (    task_name: ost$name;
         override_old_name: boolean);

    VAR
      xcb: ^ost$execution_control_block;

    xcb := pmf$executing_task_xcb ();
    IF override_old_name OR (xcb^.save9 {task_name} = osc$null_name) THEN
      xcb^.save9 {task_name} := task_name;
    IFEND;

  PROCEND pmp$record_task_name;
?? OLDTITLE ??
?? NEWTITLE := '   [XDCL, #GATE] pmp$set_relative_priority_r1 ', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$set_relative_priority_r1
    (    priority: 0 .. 255);

{ The following procedure is the ring one interface to modify
{ or set the relative priority of a task. The relative priority
{ of a task is used in determining the dispatching order of the
{ task.

    VAR
      xcb_p: ^ost$execution_control_block;

    xcb_p := pmf$executing_task_xcb ();

    xcb_p^.relative_task_priority := priority;
    xcb_p^.system_give_up_cpu := TRUE;
    jmv$jcb.ijle_p^.relative_priority_enabled := TRUE;

{ Issue a cycle request to force the task out of the DCT chain. This
{ will force the task to be re-positioned into the DCT chain at
{ the new priority.

    syp$cycle;

  PROCEND pmp$set_relative_priority_r1;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$cause_condition_in_tasks', EJECT ??
*copy pmh$cause_condition_in_tasks

  PROCEDURE [XDCL, #GATE] pmp$cause_condition_in_tasks
    (    condition_name: pmt$condition_name);

    VAR
      condition_name_p: ^pmt$condition_name,
      ignore_status: ost$status,
      signal: pmt$signal,
      xcb_p: ^ost$execution_control_block;

    signal.identifier := pmc$multi_task_condition;
    condition_name_p := #LOC (signal.contents);
    condition_name_p^ := condition_name;

    osp$set_mainframe_sig_lock (job_xcb_list.lock);
    xcb_p := job_xcb_list.head;
    WHILE (xcb_p <> NIL) DO
      pmp$send_signal (xcb_p^.global_task_id, signal, ignore_status);
      xcb_p := xcb_p^.link;
    WHILEND;
    osp$clear_mainframe_sig_lock (job_xcb_list.lock);

  PROCEND pmp$cause_condition_in_tasks;
?? OLDTITLE ??
MODEND pmm$tasking_support_ring_1;
