?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Named Task Manager' ??
MODULE clm$named_task_manager;

{
{ PURPOSE:
{   This module contains the procedures that manage the named task list.
{   Entries are added to the list via an aynchronous EXECUTE_TASK command or TASK/TASKEND statement.
{

?? NEWTITLE := 'Global Declarations' ??
?? NEWTITLE := 'Named Task List', EJECT ??
*copyc clt$named_task
?? OLDTITLE, EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_command_processing
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_named_task
*copyc clt$block
*copyc clt$task_name_reference
*copyc osd$virtual_address
*copyc oss$task_private
*copyc ost$caller_identifier
*copyc ost$name
*copyc ost$status
*copyc pme$execution_exceptions
*copyc pmt$task_id
*copyc pmt$task_status
?? SKIP := 6 ??

{ This is a dummy procedure that will never be called; it's sole
{ purpose is to fool SCU so that the XREF deck for clv$named_task_group_list
{ will not be called in later and cause a conflict between it and the
{ XDCL of the variable.

  PROCEDURE [INLINE] dummy;

*copyc clp$find_nt_group_list_first
*copyc clv$named_task_group_list

  PROCEND dummy;
?? SKIP := 6 ??
?? POP ??
*copyc avp$ring_min
*copyc clp$find_current_block
*copyc clp$find_named_task_group_list
*copyc clp$find_task_block
*copyc clp$validate_name
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osv$lower_to_upper
*copyc osv$task_shared_heap
*copyc pmp$execute_with_command_file
*copyc pmp$get_task_id
?? TITLE := 'clv$named_task_group_list', EJECT ??

  VAR
    clv$named_task_group_list: [XDCL, #GATE, oss$task_private] ^^clt$named_task := NIL;

?? TITLE := 'clp$execute_named_task', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$execute_named_task
    (    task_name: ost$name;
         target_ring: ost$valid_ring;
         program_description: pmt$program_description;
         parameters: pmt$program_parameters;
         command_file: amt$local_file_name;
     VAR task_id: pmt$task_id;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      named_task_group_list: ^^clt$named_task,
      interactive: boolean,
      task_status: pmt$task_status,
      named_task: ^clt$named_task,
      named_task_list: ^clt$named_task,
      validated_task_name: ost$name,
      valid_name: boolean;


    #CALLER_ID (caller_id);
    status.normal := TRUE;

    IF target_ring < avp$ring_min () THEN

{ The only caller's of this interface that are expected to specify a ring number other
{ than their own are the TASK command and the invoking of a program command.
{ The latter case is recognized by the current SCL block being a "command block" for
{ a "program command" and allows the target ring to be less than the user's
{ validated minimum ring.

      clp$find_current_block (block);
      IF (block = NIL) OR (block^.kind <> clc$command_block) OR (block^.command_kind <> clc$program_command)
            THEN
        osp$set_status_abnormal ('CL', cle$task_taskend_ring_below_min, '', status);
        RETURN;
      IFEND;
    IFEND;


    clp$find_named_task_group_list (named_task_group_list);

    IF task_name = osc$null_name THEN

{ Synchronous mode - actually not a "named" task.

      pmp$execute_with_command_file (target_ring, program_description, parameters, command_file, osc$wait,
            TRUE, task_id, task_status, status);
      IF status.normal AND (NOT task_status.status.normal) AND
            (task_status.status.condition <> pme$terminated_by_parent) THEN

{ NOTE: The check for pme$terminated_by_parent is included in the above IF
{ statement so that if the task is terminated as a result of an SCL EXIT
{ statement, this procedure's status parameter will not be affected.

        status := task_status.status;
      IFEND;
    ELSE

{ Asynchronous mode.

      clp$validate_name (task_name, validated_task_name, valid_name);
      IF (NOT valid_name) OR (validated_task_name = 'ALL') OR (validated_task_name = 'NONE') THEN
        osp$set_status_abnormal ('CL', cle$invalid_exec_task_name, task_name, status);
      IFEND;

      create_named_task_entry (task_name, named_task_group_list, named_task, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      pmp$execute_with_command_file (target_ring, program_description, parameters, command_file, osc$nowait,
            TRUE, named_task^.id, named_task^.status, status);

      IF NOT status.normal THEN
        clp$delete_named_task_entry (task_name);
        RETURN;
      IFEND;
      task_id := named_task^.id;
    IFEND;

  PROCEND clp$execute_named_task;
?? TITLE := 'create_named_task_entry', EJECT ??

  PROCEDURE create_named_task_entry
    (    task_name: ost$name;
         named_task_group_list: ^^clt$named_task;
     VAR named_task: ^clt$named_task;
     VAR status: ost$status);

    VAR
      current_task_id: pmt$task_id,
      new_named_task: ^clt$named_task,
      new_named_task_node: ^^clt$named_task;


    status.normal := TRUE;

    pmp$get_task_id (current_task_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    new_named_task_node := named_task_group_list;
    named_task := new_named_task_node^;

  /search/
    WHILE named_task <> NIL DO
      IF named_task^.name = task_name THEN
        IF named_task^.status.complete THEN
          named_task^.status.complete := FALSE;
          named_task^.status.status.normal := TRUE;
          named_task^.parent_task_id := current_task_id;
          RETURN;
        IFEND;
        osp$set_status_abnormal ('CL', cle$task_name_in_use, task_name, status);
        RETURN;
      ELSE
        IF (named_task^.status.complete) AND
           (named_task^.status.status.normal) THEN
          new_named_task_node^ := named_task^.link;
          FREE named_task IN osv$task_shared_heap^;
          named_task := new_named_task_node^;
        ELSE
          new_named_task_node := ^named_task^.link;
          named_task := new_named_task_node^;
        IFEND;
      IFEND;
    WHILEND /search/;

    ALLOCATE new_named_task IN osv$task_shared_heap^;

    new_named_task^.link := new_named_task_node^;
    new_named_task^.name := task_name;
    new_named_task^.status.complete := FALSE;
    new_named_task^.status.status.normal := TRUE;
    new_named_task^.parent_task_id := current_task_id;

    new_named_task_node^ := new_named_task;
    named_task := new_named_task;

  PROCEND create_named_task_entry;
?? TITLE := 'clp$find_nt_group_list_first', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$find_nt_group_list_first
    (VAR named_task_list: ^^clt$named_task);

    VAR
      block_status: ost$status,
      task_block: ^clt$block;

    clp$find_task_block (task_block, block_status);
    IF NOT block_status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block.', ^block_status);
      RETURN;
    IFEND;

    WHILE task_block^.synchronous_with_parent DO
      task_block := task_block^.parent;
    WHILEND;

    clv$named_task_group_list := ^task_block^.named_task_list;
    named_task_list := clv$named_task_group_list;

  PROCEND clp$find_nt_group_list_first;
?? TITLE := 'clp$fetch_named_task_entry', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$fetch_named_task_entry
    (    task_name: ost$name;
     VAR named_task: clt$named_task);

    VAR
      named_task_group_list: ^^clt$named_task,
      named_task_entry: ^clt$named_task,
      ignore_status: ost$status;

    clp$find_named_task_group_list (named_task_group_list);

    named_task_entry := named_task_group_list^;
    WHILE named_task_entry <> NIL DO
      IF named_task_entry^.name = task_name THEN
        named_task := named_task_entry^;
        RETURN;
      IFEND;
      named_task_entry := named_task_entry^.link;
    WHILEND;

    named_task.link := NIL;
    named_task.name := osc$null_name;
    named_task.status.complete := TRUE;
    named_task.status.status.normal := TRUE;

    pmp$get_task_id (named_task.parent_task_id, ignore_status);

  PROCEND clp$fetch_named_task_entry;
?? TITLE := 'clp$get_task_status', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$get_task_status
    (    task_name: clt$task_name_reference;
     VAR task_status: pmt$task_status;
     VAR status: ost$status);

    VAR
      local_task_name: ost$name,
      named_task: clt$named_task;

    status.normal := TRUE;

    #TRANSLATE (osv$lower_to_upper, task_name, local_task_name);
    clp$fetch_named_task_entry (local_task_name, named_task);

    task_status := named_task.status;

  PROCEND clp$get_task_status;
?? TITLE := 'clp$delete_named_task_entry', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$delete_named_task_entry
    (    task_name: ost$name);

    VAR
      named_task_group_list: ^^clt$named_task,
      named_task: ^clt$named_task;

    clp$find_named_task_group_list (named_task_group_list);

    named_task := named_task_group_list^;
    WHILE named_task <> NIL DO
      IF named_task^.name = task_name THEN
        named_task_group_list^ := named_task^.link;
        FREE named_task IN osv$task_shared_heap^;
        RETURN;
      IFEND;
      named_task_group_list := ^named_task^.link;
      named_task := named_task^.link;
    WHILEND;

  PROCEND clp$delete_named_task_entry;

MODEND clm$named_task_manager;
