?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : File Access Procedure for local queues' ??
MODULE clm$local_queue_fap;

{
{ PURPOSE:
{   This module contains the file access procedure (FAP) that processes
{   I/O requests for files which have been associated with local queues
{   via a REQUEST_LOCAL_QUEUE. Only open, close, get_next, and put_next
{   requests are processed.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$fap_validation_errors
*copyc amt$fap_declarations
*copyc cle$ecc_expression_result
*copyc cle$ecc_miscellaneous
*copyc fsc$local
*copyc ost$caller_identifier
?? POP ??
*copyc amp$set_file_instance_abnormal
*copyc amp$validate_caller_privilege
*copyc bap$close
*copyc bap$fetch
*copyc clp$get_fs_path_elements
*copyc fsp$path_element
*copyc i#move
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$connect_queue
*copyc pmp$define_queue
*copyc pmp$disconnect_queue
*copyc pmp$receive_from_queue
*copyc pmp$remove_queue
*copyc pmp$send_to_queue

*copyc bav$task_file_table
?? TITLE := 'clp$local_queue_fap', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$local_queue_fap
    (    file_identifier: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);


    VAR
      caller_id: ost$caller_identifier,
      data_area: ^cell,
      data_length: ^amt$file_byte_address,
      evaluated_file_reference: fst$evaluated_file_reference,
      ignore_structure_pointer: ^cell,
      local_status: ost$status,
      message: ^pmt$message_value,
      message_seq: pmt$message,
      queue_id: pmt$queue_connection,
      queue_name: pmt$queue_name;

    #CALLER_ID (caller_id);
    status.normal := TRUE;
    amp$validate_caller_privilege (file_identifier, call_block, layer_number,
          $pft$usage_selections [pfc$append], caller_id.ring, ignore_structure_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_fs_path_elements (bav$task_file_table^ [file_identifier.ordinal].local_file_name,
          evaluated_file_reference, status);
    queue_name := fsp$path_element (^evaluated_file_reference, 2) ^;
    CASE call_block.operation OF

    = amc$open_req =
      IF fsp$path_element (^evaluated_file_reference, 1) ^ = fsc$local THEN
        pmp$define_queue (queue_name, caller_id.ring, caller_id.ring, status);
        IF NOT status.normal AND (status.condition = pme$queue_already_defined) THEN
          status.normal := TRUE;
        IFEND;
      ELSE
        osp$set_status_condition (cle$only_permitted_on_loc_file, status);
      IFEND;

    = amc$get_next_req =
      pmp$connect_queue (queue_name, queue_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      pmp$receive_from_queue (queue_id, osc$nowait, message_seq, status);
      pmp$disconnect_queue (queue_id, local_status);
      IF message_seq.contents = pmc$no_message THEN
        call_block.getn.file_position^ := amc$eoi;
        RETURN;
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF message_seq.contents <> pmc$message_value THEN
        osp$set_status_condition (pme$incorrect_message_type, status);
        RETURN;
      IFEND;
      message := ^message_seq.value;
      RESET message;
      NEXT data_length IN message;
      IF data_length^ > (#SIZE (message_seq.value) - #SIZE (data_length^)) THEN
        osp$set_status_abnormal ('CL', cle$string_too_long, ' for get_next of local queue line', status);
        RETURN;
      IFEND;
      NEXT data_area IN message;
      IF call_block.getn.working_storage_length < data_length^ THEN
        call_block.getn.transfer_count^ := call_block.getn.working_storage_length;
        call_block.getn.file_position^ := amc$mid_record;
      ELSE
        call_block.getn.transfer_count^ := data_length^;
        call_block.getn.file_position^ := amc$eor;
      IFEND;
      i#move (data_area, call_block.getn.working_storage_area, call_block.getn.transfer_count^);
      call_block.getn.byte_address^ := 0;

    = amc$put_next_req =
      IF call_block.putn.working_storage_length > (#SIZE (message_seq.value) - #SIZE (amt$file_byte_address))
            THEN
        osp$set_status_abnormal ('CL', cle$string_too_long, ' for put_next of local queue line', status);
        RETURN;
      IFEND;
      message_seq.contents := pmc$message_value;
      message := ^message_seq.value;
      RESET message;
      NEXT data_length IN message;
      data_length^ := call_block.putn.working_storage_length;
      NEXT data_area IN message;
      i#move (call_block.putn.working_storage_area, data_area, data_length^);

      pmp$connect_queue (queue_name, queue_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      pmp$send_to_queue (queue_id, message_seq, status);
      IF status.normal THEN
        call_block.putn.byte_address^ := 0;
      IFEND;

      pmp$disconnect_queue (queue_id, local_status);
      IF status.normal AND NOT local_status.normal THEN
        status := local_status;
      IFEND;

    = amc$close_req =
      pmp$remove_queue (queue_name, local_status);

      bap$close (file_identifier, status);

    = amc$fetch_req =
      bap$fetch (file_identifier, call_block, layer_number, status);

    ELSE
      amp$set_file_instance_abnormal (file_identifier, ame$improper_fap_operation, call_block.operation, '',
            status);
    CASEND;

  PROCEND clp$local_queue_fap;

MODEND clm$local_queue_fap;
