?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Program Execution Commands' ??
MODULE clm$program_execution_commands;

{
{ PURPOSE:
{   This module contains the processors for wait command and the $task_status,
{   $task_complete, and $ring functions.

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_expression_result
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parameter_list
*copyc clt$work_area
*copyc osd$virtual_address
*copyc ost$caller_identifier
*copyc ost$status
*copyc pfe$error_condition_codes
?? POP ??
*copyc clp$count_list_elements
*copyc clp$evaluate_parameters
*copyc clp$fetch_named_task_entry
*copyc clp$make_boolean_value
*copyc clp$make_integer_value
*copyc clp$make_status_value
*copyc osp$await_activity_completion
*copyc osp$establish_block_exit_hndlr
*copyc osp$disestablish_cond_handler
*copyc pmp$connect_queue
*copyc pmp$define_queue
*copyc pmp$disconnect_queue
?? TITLE := 'clp$_wait', EJECT ??

{ PURPOSE:
{   This routine processes the wait command.

  PROCEDURE [XDCL] clp$_wait
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$wai) wait, wai (
{   time, t: any of
{       integer 0..osc$maximum_wait_time
{       time_increment
{     anyend = $optional
{   task_names, task_name, tn: list of name = $optional
{   queue_names, queue_name, qn: list of name = $optional
{   until, u: key
{       all, any
{     keyend = all
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 11] of clt$pdt_parameter_name,
        parameters: array [1 .. 5] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
          recend,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
        type4: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 2] of clt$keyword_specification,
          default_value: string (3),
        recend,
        type5: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 9, 26, 14, 31, 0, 665], clc$command, 11, 5, 0, 0, 0, 0, 5, 'OSM$WAI'],
            [['QN                             ', clc$abbreviation_entry, 3],
            ['QUEUE_NAME                     ', clc$alias_entry, 3],
            ['QUEUE_NAMES                    ', clc$nominal_entry, 3],
            ['STATUS                         ', clc$nominal_entry, 5],
            ['T                              ', clc$abbreviation_entry, 1],
            ['TASK_NAME                      ', clc$alias_entry, 2],
            ['TASK_NAMES                     ', clc$nominal_entry, 2],
            ['TIME                           ', clc$nominal_entry, 1],
            ['TN                             ', clc$abbreviation_entry, 2],
            ['U                              ', clc$abbreviation_entry, 4],
            ['UNTIL                          ', clc$nominal_entry, 4]], [

{ PARAMETER 1

      [8, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 43, clc$optional_parameter, 0, 0],

{ PARAMETER 2

      [7, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 21, clc$optional_parameter, 0, 0],

{ PARAMETER 3

      [3, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 21, clc$optional_parameter, 0, 0],

{ PARAMETER 4

      [11, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 81, clc$optional_default_parameter, 0, 3],

{ PARAMETER 5

      [4, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_parameter, 0, 0]],

{ PARAMETER 1

      [[1, 0, clc$union_type], [[clc$integer_type, clc$time_increment_type], FALSE, 2], 20,
            [[1, 0, clc$integer_type], [0, osc$maximum_wait_time, 10]], 3, [[1, 0, clc$time_increment_type]]],

{ PARAMETER 2

      [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
            [[1, 0, clc$name_type], [1, osc$max_name_size]]],

{ PARAMETER 3

      [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
            [[1, 0, clc$name_type], [1, osc$max_name_size]]],

{ PARAMETER 4

      [[1, 0, clc$keyword_type], [2], [['ALL                            ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['ANY                            ', clc$nominal_entry,
            clc$normal_usage_entry, 2]], 'all'],

{ PARAMETER 5

      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$time = 1,
      p$task_names = 2,
      p$queue_names = 3,
      p$until = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

?? NEWTITLE := 'delete_connected_queues', EJECT ??

{ PURPOSE:
{   Disconnect any queues connected to the task by this command.

    PROCEDURE delete_connected_queues;

      VAR
        local_status: ost$status,
        queue_index: clt$list_size;

      FOR queue_index := 1 TO connected_queues DO
        pmp$disconnect_queue (queue_id_list^ [queue_index], local_status);
      FOREND;
    PROCEND delete_connected_queues;
?? OLDTITLE ??
?? NEWTITLE := 'end_handler', EJECT ??

{ PURPOSE:
{   Cleans up if the procedure exits abnormally.

    PROCEDURE end_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      delete_connected_queues;

    PROCEND end_handler;
?? OLDTITLE, EJECT ??

    VAR
      connected_queues: clt$list_size,
      milliseconds: integer,
      named_task: clt$named_task,
      queue_count: clt$list_size,
      queue_id: pmt$queue_connection,
      queue_id_list: ^array [1 .. * ] of pmt$queue_connection,
      ready_index: integer,
      remaining_activities: integer,
      task_count: clt$list_size,
      time_increment: ^pmt$time_increment,
      value: ^clt$data_value,
      wait_for_any: boolean,
      wait_list: ^ost$wait_list;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT (pvt [p$time].specified OR pvt [p$task_names].specified OR pvt [p$queue_names].specified) THEN
      RETURN;
    IFEND;

    task_count := clp$count_list_elements (pvt [p$task_names].value);
    queue_count := clp$count_list_elements (pvt [p$queue_names].value);

    PUSH wait_list: [1 .. task_count + queue_count + $INTEGER (pvt [p$time].specified)];
    IF pvt [p$time].specified THEN
      wait_list^ [UPPERBOUND (wait_list^)].activity := osc$await_time;
      value := pvt [p$time].value;
      IF value^.kind = clc$integer THEN
        wait_list^ [UPPERBOUND (wait_list^)].milliseconds := value^.integer_value.value;
      ELSE
        time_increment := value^.time_increment_value;
        milliseconds := time_increment^.millisecond + time_increment^.second * 1000 + time_increment^.minute *
              60 * 1000 + time_increment^.hour * 60 * 60 * 1000 + time_increment^.day * 24 * 60 * 60 *
              1000 + time_increment^.month * 30 * 24 * 60 * 60 * 1000 + time_increment^.year * 365 * 24 * 60 *
              60 * 1000;
        IF milliseconds <= 0 THEN
          RETURN; {No point in hanging around for 0 MS }
        ELSEIF milliseconds > osc$maximum_wait_time THEN
          milliseconds := osc$maximum_wait_time;
        IFEND;
        wait_list^ [UPPERBOUND (wait_list^)].milliseconds := milliseconds;
      IFEND;
    IFEND;

    value := pvt [p$task_names].value;
    FOR ready_index := 1 TO task_count DO
      clp$fetch_named_task_entry (value^.element_value^.name_value, named_task);
      IF named_task.name = osc$null_name THEN
        wait_list^ [ready_index].activity := osc$null_activity;
      ELSE
        wait_list^ [ready_index].activity := pmc$await_task_termination;
        wait_list^ [ready_index].task_id := named_task.id;
      IFEND;
      value := value^.link;
    FOREND;

  /wait/
    BEGIN
      connected_queues := 0;
      #SPOIL (connected_queues);
      osp$establish_block_exit_hndlr (^end_handler);

      IF queue_count > 0 THEN
        value := pvt [p$queue_names].value;
        PUSH queue_id_list: [1 .. queue_count];
        FOR ready_index := 1 TO queue_count DO
          pmp$connect_queue (value^.element_value^.name_value, queue_id, status);
          IF NOT status.normal AND (status.condition = pme$unknown_queue_name) THEN
            pmp$define_queue (value^.element_value^.name_value, osc$user_ring_2, osc$user_ring_2, status);
            IF NOT status.normal AND (status.condition <> pme$queue_already_defined) THEN
              EXIT /wait/;
            IFEND;
            status.normal := TRUE;
            pmp$connect_queue (value^.element_value^.name_value, queue_id, status);
          IFEND;
          IF NOT status.normal THEN
            IF NOT (status.condition = pme$task_already_connected) THEN
              EXIT /wait/;
            IFEND;
            status.normal := TRUE;
          ELSE
            queue_id_list^ [connected_queues + 1] := queue_id;
            #SPOIL (queue_id_list^ [connected_queues + 1]);
            connected_queues := connected_queues + 1;
            #SPOIL (connected_queues);
          IFEND;
          wait_list^ [task_count + ready_index].activity := pmc$await_local_queue_message;
          wait_list^ [task_count + ready_index].qid := queue_id;
          value := value^.link;
        FOREND;
      IFEND;

      wait_for_any := (pvt [p$until].value^.keyword_value = 'ANY');
      REPEAT
        osp$await_activity_completion (wait_list^, ready_index, status);
        IF NOT status.normal THEN
          EXIT /wait/;
        IFEND;

        IF wait_for_any THEN
          EXIT /wait/;
        IFEND;

        wait_list^ [ready_index].activity := osc$null_activity;
        remaining_activities := 0;
        FOR ready_index := 1 TO UPPERBOUND (wait_list^) DO
          IF wait_list^ [ready_index].activity <> osc$null_activity THEN
            remaining_activities := remaining_activities + 1;
          IFEND;
        FOREND;
      UNTIL remaining_activities = 0;
    END /wait/;
    delete_connected_queues;
    osp$disestablish_cond_handler;

  PROCEND clp$_wait;
?? TITLE := 'clp$$task_complete', EJECT ??

{ PURPOSE:
{   This command processes the $task_complete function.

  PROCEDURE [XDCL] clp$$task_complete
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$task_complete) $task_complete (
{   task_name: name = $required
{   )

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 1] of clt$pdt_parameter_name,
        parameters: array [1 .. 1] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend := [[1, [88, 9, 26, 14, 31, 50, 187], clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$TASK_COMPLETE'],
            [['TASK_NAME                      ', clc$nominal_entry, 1]], [

{ PARAMETER 1

      [1, clc$normal_usage_entry, clc$non_secure_parameter,
            $clt$parameter_spec_methods [clc$specify_positionally], clc$pass_by_value,
            clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0]],

{ PARAMETER 1

      [[1, 0, clc$name_type], [1, osc$max_name_size]]];

?? POP ??

    CONST
      p$task_name = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      named_task: clt$named_task;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$fetch_named_task_entry (pvt [p$task_name].value^.name_value, named_task);

    clp$make_boolean_value (named_task.status.complete, clc$true_false_boolean, work_area, result);

  PROCEND clp$$task_complete;
?? TITLE := 'clp$$task_status', EJECT ??

{ PURPOSE:
{   This command processes the $task_status function.

  PROCEDURE [XDCL] clp$$task_status
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$task_status) $task_status (
{   task_name: name = $required
{   status_information: key
{      (complete, completed, c), (status, s)
{     keyend = status
{   )

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 2] of clt$pdt_parameter_name,
        parameters: array [1 .. 2] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 5] of clt$keyword_specification,
          default_value: string (6),
        recend,
      recend := [[1, [88, 9, 26, 14, 32, 32, 764], clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$TASK_STATUS'],
            [['STATUS_INFORMATION             ', clc$nominal_entry, 2],
            ['TASK_NAME                      ', clc$nominal_entry, 1]], [

{ PARAMETER 1

      [2, clc$normal_usage_entry, clc$non_secure_parameter,
            $clt$parameter_spec_methods [clc$specify_positionally], clc$pass_by_value,
            clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0, 0],

{ PARAMETER 2

      [1, clc$normal_usage_entry, clc$non_secure_parameter,
            $clt$parameter_spec_methods [clc$specify_positionally], clc$pass_by_value,
            clc$immediate_evaluation, clc$standard_parameter_checking, 192, clc$optional_default_parameter, 0,
            6]],

{ PARAMETER 1

      [[1, 0, clc$name_type], [1, osc$max_name_size]],

{ PARAMETER 2

      [[1, 0, clc$keyword_type], [5], [['C                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 1], ['COMPLETE                       ', clc$nominal_entry,
            clc$normal_usage_entry, 1], ['COMPLETED                      ', clc$alias_entry,
            clc$normal_usage_entry, 1], ['S                              ', clc$abbreviation_entry,
            clc$normal_usage_entry, 2], ['STATUS                         ', clc$nominal_entry,
            clc$normal_usage_entry, 2]], 'status']];

?? POP ??

    CONST
      p$task_name = 1,
      p$status_information = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      named_task: clt$named_task;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$fetch_named_task_entry (pvt [p$task_name].value^.name_value, named_task);

    IF pvt [p$status_information].value^.keyword_value = 'COMPLETE' THEN
      clp$make_boolean_value (named_task.status.complete, clc$true_false_boolean, work_area, result);
    ELSE {pvt [p$status_information].value^.keyword_value = 'STATUS'
      clp$make_status_value (named_task.status.status, work_area, result);
      IF (named_task.name = osc$null_name) OR (NOT named_task.status.complete) THEN
        result^.status_value^.normal := TRUE;
      IFEND;
    IFEND;

  PROCEND clp$$task_status;
?? TITLE := 'clp$$ring', EJECT ??

{ PURPOSE:
{   This routine processes the $ring function.

  PROCEDURE [XDCL] clp$$ring
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$ring) $ring

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
      recend := [[1, [88, 9, 26, 14, 33, 5, 903], clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$RING']];

?? POP ??

    VAR
      caller_id: ost$caller_identifier;

    #CALLER_ID (caller_id);

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_integer_value (caller_id.ring, 10, FALSE, work_area, result);

  PROCEND clp$$ring;
MODEND clm$program_execution_commands;
