?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Operator Facility : Operator Message Processing' ??
MODULE ofm$operator_message_procedures;

{ PURPOSE:
{   This module contains (2,D,D) procedures for operator message
{   processing.

?? TITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ife$error_codes
*copyc ofd$type_definition
*copyc ofe$error_codes
*copyc oft$operator_classes
*copyc oft$operator_message_descriptor
*copyc ost$status
*copyc ost$wait
?? POP ??
*copyc clp$change_variable
*copyc clp$evaluate_parameters
*copyc clp$get_type_information
*copyc clp$get_value
*copyc clp$get_variable
*copyc clp$get_work_area
*copyc clp$put_job_command_response
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc clp$write_variable
*copyc ifp$invoke_pause_utility
*copyc ofp$acknowledge_operator_msg
*copyc ofp$clear_operator_message
*copyc ofp$receive_operator_resp_r3
*copyc ofp$send_operator_message
*copyc ofp$send_to_operator
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
*copyc pmp$establish_condition_handler
*copyc pmp$long_term_wait
?? TITLE := 'clp$request_op_action_command', EJECT ??

{ The following procedure has been moved from clm$request_op_action_command and
{ is being retained only for compatibility with previous releases of NOS/VE.

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

{ PDT request_op_action_pdt (
{   message, m : STRING 0 .. ofc$max_send_message = $REQUIRED
{   reply, r : VAR OF STRING = $OPTIONAL
{   STATUS)

?? PUSH (LISTEXT := ON) ??

    VAR
      request_op_action_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^request_op_action_pdt_names, ^request_op_action_pdt_params];

    VAR
      request_op_action_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['MESSAGE', 1], ['M', 1], ['REPLY', 2], ['R', 2],
            ['STATUS', 3]];

    VAR
      request_op_action_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of
            clt$parameter_descriptor := [

{ MESSAGE M }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$string_value, 0, ofc$max_send_message]],

{ REPLY R }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$string_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??

    PROCEDURE receive_from_operator_reply
      (    wait: ost$wait;
       VAR text: ost$string;
       VAR operator_id: oft$operator_id;
       VAR reply_received: boolean;
       VAR status: ost$status);

      VAR
        estab_handler: pmt$established_handler,
        condition: pmt$condition;

      PROCEDURE handle_break
        (    cond: pmt$condition;
             cd_p: ^pmt$condition_information;
             sa_p: ^ost$stack_frame_save_area;
         VAR proc_status: ost$status);

        VAR
          local_status: ost$status;

        IF cond.interactive_condition = ifc$pause_break THEN

          { start pause utility - pause break

          ifp$invoke_pause_utility (local_status);

          osp$set_status_abnormal (ofc$operator_facility_id, ife$pause_break_received, '', status);

        ELSEIF cond.interactive_condition = ifc$terminate_break THEN
          ofp$clear_operator_message (ofc$system_operator, local_status);

          osp$set_status_abnormal (ofc$operator_facility_id, ife$terminate_break_received, '', status);
          pmp$continue_to_cause (pmc$execute_standard_procedure, proc_status);
          EXIT receive_from_operator_reply;
        IFEND;

      PROCEND handle_break;

      status.normal := TRUE;
      condition.selector := pmc$condition_combination;
      condition.combination := $pmt$condition_combination [ifc$interactive_condition];
      pmp$establish_condition_handler (condition, ^handle_break, ^estab_handler, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;


      REPEAT
        ofp$receive_from_operator (wait, text, operator_id, status);
      UNTIL status.normal OR NOT (status.condition = ife$pause_break_received);

      IF status.normal THEN
        reply_received := TRUE;
      IFEND;

    PROCEND receive_from_operator_reply;

    CONST
      ofc$system_operator_id = 'SYSTEM_OPERATOR                ';

    VAR
      ignore_operator_id: oft$operator_id,
      reply_area_p: ^SEQ (ost$string),
      reply_variable_p: ^array [1 .. * ] of cell,
      reply_response_p: ^string ( * ),
      reply_received: boolean,
      reply_p: ^ost$string,
      value_reply: clt$value,
      value_send: clt$value;

    status.normal := TRUE;
    reply_received := FALSE;

    clp$scan_parameter_list (parameter_list, request_op_action_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('MESSAGE', 1, 1, clc$low, value_send, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

      clp$get_value ('REPLY', 1, 1, clc$low, value_reply, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      PUSH reply_area_p;

      ofp$send_to_operator (value_send.str.value (1, value_send.str.size), ofc$system_operator_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    REPEAT
      #SPOIL (reply_received);
      status.normal := TRUE;

      RESET reply_area_p;
      NEXT reply_p IN reply_area_p;

      receive_from_operator_reply (osc$wait, reply_p^, ignore_operator_id, reply_received, status);
      IF NOT status.normal AND (status.condition <> ofe$message_not_available) THEN
        RETURN;
      IFEND;

    UNTIL reply_received;

    IF value_reply.kind = clc$variable_reference THEN

      RESET reply_area_p;
      NEXT reply_variable_p: [1 .. UPPERBOUND (value_reply.var_ref.value.string_value^)] IN reply_area_p;
      IF reply_p^.size > value_reply.var_ref.value.max_string_size THEN
        reply_p^.size := value_reply.var_ref.value.max_string_size;
      IFEND;
      value_reply.var_ref.value.string_value := reply_variable_p;
      clp$write_variable (value_reply.var_ref.reference.value (1, value_reply.var_ref.reference.size),
            value_reply.var_ref.value, status);

    ELSE

      PUSH reply_response_p: [1 + reply_p^.size];
      reply_response_p^ (1) := ' ';
      reply_response_p^ (2, reply_p^.size) := reply_p^.value (1, reply_p^.size);
      clp$put_job_command_response (reply_response_p^, status);

    IFEND;

  PROCEND clp$request_op_action_command;

?? TITLE := 'ofp$acknowledge_oper_msg_cmd', EJECT ??

{ PURPOSE:
{ The purpose of this procedure is to send an acknowledgement to an operator
{ message.

  PROCEDURE [XDCL, #GATE] ofp$acknowledge_oper_msg_cmd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$ackom) acknowledge_operator_message, ackom (
{    message, m: integer 0 .. 0ffff(16) = $REQUIRED
{    response, r: string 1 .. 256 = $OPTIONAL
{    STATUS)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 5, 11, 11, 55, 19, 328],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'OSM$ACKOM'], [
    ['M                              ',clc$abbreviation_entry, 1],
    ['MESSAGE                        ',clc$nominal_entry, 1],
    ['R                              ',clc$abbreviation_entry, 2],
    ['RESPONSE                       ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, 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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [4, 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, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [5, 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$integer_type], [0, 0ffff(16), 10]],
{ PARAMETER 2
    [[1, 0, clc$string_type], [1, 256, FALSE]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$message = 1,
      p$response = 2,
      p$status = 3;

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

    VAR
      response_string: ost$string;

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

    IF pvt [p$response].specified THEN
      response_string.value := pvt [p$response].value^.string_value^;
      response_string.size := #SIZE (pvt [p$response].value^.string_value^);
    ELSE
      response_string.value := '';
      response_string.size := 0;
    IFEND;

    ofp$acknowledge_operator_msg (pvt [p$message].value^.integer_value.value, response_string, status);

  PROCEND ofp$acknowledge_oper_msg_cmd;
?? TITLE := 'ofp$receive_from_operator', EJECT ??

{ PURPOSE:
{ The following procedure is being retained only for compatibility with
{ previous versions of NOS/VE.

  PROCEDURE [XDCL, #GATE] ofp$receive_from_operator
    (    wait: ost$wait;
     VAR text: ost$string;
     VAR operator_id: oft$operator_id;
     VAR status: ost$status);

    status.normal := TRUE;
    ofp$receive_operator_response (ofc$system_operator, wait, text, status);

{ For compatibility with previous systems, a value conforming to the old
{ oft$operator_id type is returned to the caller. Also, any returned abnormal
{ status from ofp$receive_operator_response is mapped into the status which
{ was returned by previous systems (ofe$message_not_available).

    operator_id := ofc$system_operator_id;

    IF NOT status.normal THEN
      osp$set_status_abnormal (ofc$operator_facility_id, ofe$message_not_available, ' ', status);
    IFEND;

  PROCEND ofp$receive_from_operator;
?? TITLE := 'ofp$receive_operator_response', EJECT ??

*copyc ofh$receive_operator_response

  PROCEDURE [XDCL, #GATE] ofp$receive_operator_response
    (    operator_class: oft$operator_class;
         wait: ost$wait;
     VAR response: ost$string;
     VAR status: ost$status);

    status.normal := TRUE;

    REPEAT
      ofp$receive_operator_resp_r3 (operator_class, response, status);
      IF (NOT status.normal AND (status.condition = ofe$no_response_available)) AND (wait = osc$wait) THEN
        pmp$long_term_wait (300000, 30000);
      IFEND;
    UNTIL status.normal OR (wait = osc$nowait) OR (NOT status.normal AND
          (status.condition <> ofe$no_response_available));
  PROCEND ofp$receive_operator_response;
?? TITLE := 'ofp$send_operator_message_cmd', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to send a message to the operator.

  PROCEDURE [XDCL] ofp$send_operator_message_cmd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   PROCEDURE (osm$senom) send_operator_message, senom (
{     message, m: string 1 .. 256 = $REQUIRED
{     response, r: (VAR) string = $OPTIONAL
{     operator_class, oc: key
{         (system_operator, so)
{         (removable_media_operator, rmo)
{       keyend = system_operator
{     STATUS)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (15),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 2, 10, 16, 54, 45, 470],
    clc$command, 7, 4, 1, 0, 0, 1, 4, 'OSM$SENOM'], [
    ['M                              ',clc$abbreviation_entry, 1],
    ['MESSAGE                        ',clc$nominal_entry, 1],
    ['OC                             ',clc$abbreviation_entry, 3],
    ['OPERATOR_CLASS                 ',clc$nominal_entry, 3],
    ['R                              ',clc$abbreviation_entry, 2],
    ['RESPONSE                       ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [2, 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, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 8,
  clc$optional_parameter, 0, 0],
{ PARAMETER 3
    [4, 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, 155,
  clc$optional_default_parameter, 0, 15],
{ PARAMETER 4
    [7, 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$string_type], [1, 256, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['REMOVABLE_MEDIA_OPERATOR       ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['RMO                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['SO                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['SYSTEM_OPERATOR                ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'system_operator'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$message = 1,
      p$response = 2,
      p$operator_class = 3,
      p$status = 4;

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

    VAR
      access_mode: clt$data_access_mode,
      class: clt$variable_class,
      condition: pmt$condition,
      establish_descriptor: pmt$established_handler,
      evaluation_method: clt$expression_eval_method,
      operator_class: oft$operator_class,
      response_p: ^ost$string,
      response_string_p: ^string ( * ),
      response_value: clt$data_value,
      type_information: clt$type_information,
      type_specification: ^clt$type_specification,
      value: ^clt$data_value,
      work_area_pp: ^^clt$work_area;

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   This condition handler is intended to clean up the message that
{   may have been sent by this task in the event that a block exit
{   condition occurs.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_info_p: ^pmt$condition_information;
           stack_p: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      CASE condition.selector OF

      = pmc$block_exit_processing =

        ofp$clear_operator_message (operator_class, condition_status);
        condition_status.normal := TRUE; {Ignore the returned status.}
      ELSE
      CASEND;
    PROCEND condition_handler;
?? OLDTITLE, EJECT ??

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

    IF (pvt [p$operator_class].value^.keyword_value = 'SYSTEM_OPERATOR')
          OR (pvt [p$operator_class].value^.keyword_value = 'SO') THEN
      operator_class := ofc$system_operator;
    ELSE
      operator_class := ofc$removable_media_operator;
    IFEND;

    IF pvt [p$response].specified THEN
      IF pvt [p$response].variable = NIL THEN
        osp$set_status_condition (ofe$response_param_must_be_var, status);
        RETURN;
      IFEND;

      clp$get_work_area (#RING(^work_area_pp), work_area_pp, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$get_variable (pvt [p$response].variable^, work_area_pp^, class, access_mode,
            evaluation_method, type_specification, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$get_type_information (type_specification, work_area_pp^, type_information, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF type_information.max_string_size < osc$max_string_size THEN
        osp$set_status_abnormal (ofc$operator_facility_id, ofe$response_variable_too_small,
              pvt [p$response].variable^, status);
        RETURN;
      IFEND;
    IFEND;

    condition.selector := pmc$block_exit_processing;
    condition.reason := $pmt$block_exit_reason [pmc$block_exit, pmc$program_termination, pmc$program_abort];
    pmp$establish_condition_handler (condition, ^condition_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    REPEAT
      ofp$send_operator_message (pvt [p$message].value^.string_value^, operator_class, TRUE, status);
      IF NOT status.normal THEN
        IF status.condition <> ofe$allocate_structure_failed THEN
          RETURN;
        IFEND;
        pmp$long_term_wait (4000, 4000);
      IFEND;
    UNTIL status.normal;

    PUSH response_p;
    ofp$receive_operator_response (operator_class, osc$wait, response_p^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$response].specified THEN
      response_value.kind := clc$string;
      response_value.string_value := ^response_p^.value(1, response_p^.size);
      clp$change_variable (pvt [p$response].variable^, ^response_value, status);
    ELSEIF response_p^.size > 0 THEN
      PUSH response_string_p: [1 + response_p^.size];
      response_string_p^ (1) := ' ';
      response_string_p^ (2, response_p^.size) := response_p^.value (1, response_p^.size);
      clp$put_job_command_response (response_string_p^, status);
    IFEND;

  PROCEND ofp$send_operator_message_cmd;
MODEND ofm$operator_message_procedures;
