?? LEFT := 1, RIGHT := 110 ??                                                                                 
?? FMT (FORMAT := ON, INDENT := 2) ??                                                                         
?? SET (LIST := ON, LISTCTS := OFF) ??                                                                        
?? NEWTITLE := 'NOS/VE : common_task_communication' ??                                                        
MODULE nfm$common_task_communication;                                                                         
                                                                                                              
{********************************************************************************}                            
{                                                                                }                            
{  PURPOSE:                                                                      }                            
{     This module provides easy to use interfaces for the establishment of       }                            
{     asynchronous tasks, and the communication between asynchronous tasks.      }                            
{                                                                                }                            
{  DESCRIPTION:                                                                  }                            
{     The Common Task Communication Module uses the facilities of the system     }                            
{     Job Local Queue Manager and a shared segment to pass messages between      }                            
{     asynchronous tasks. The parent task can request the establishment of       }                            
{     multiple child tasks that run independently of the parent. All tasks       }                            
{     conceived from the same parent can communicate with any other task from    }                            
{     the same parent.                                                           }                            
{                                                                                }                            
{     The shared segment acts as an intertask directory and message buffer.      }                            
{     Messages sent to an asynchronous task are placed in the buffer until       }                            
{     they are picked up by the destination task. Multiple messages can be       }                            
{     queued for the same task.                                                  }                            
{                                                                                }                            
{     The messages are unstructured in format and left to the descretion of      }                            
{     user although there must be agreement between the communication tasks      }                            
{     as to the format of messages.                                              }                            
{                                                                                }                            
{********************************************************************************}                            
?? NEWTITLE := 'global declarations', EJECT ??                                                                
                                                                                                              
  CONST                                                                                                       
    nfc$millisecond = 1000;                                                                                   
                                                                                                              
*copyc nft$intertask_transfer_size                                                                            
*copyc nft$intertask_wait_time                                                                                
                                                                                                              
  TYPE                                                                                                        
    nft$lock_functions = (nfc$lock, nfc$unlock, nfc$examine),                                                 
                                                                                                              
    nft$key_definition = PACKED RECORD                                                                        
        lock_bits: ALIGNED [0 MOD 8] 0 .. 0ffffffff(16),                                                      
        lock_id: 0 .. 0ffffffff(16),                                                                          
      RECEND,                                                                                                 
                                                                                                              
    nft$lock_status = RECORD                                                                                  
        CASE condition: ost$signature_lock_status OF                                                          
          = osc$sls_not_locked =                                                                              
            ,                                                                                                 
          = osc$sls_locked_by_current_task =                                                                  
            ,                                                                                                 
          = osc$sls_locked_by_another_task =                                                                  
            task_id: pmt$task_id,                                                                             
        CASEND,                                                                                               
      RECEND;                                                                                                 
                                                                                                              
  TYPE                                                                                                        
    nft$directory_ordinal = 1 .. pmc$max_queues_per_job,                                                      
                                                                                                              
    nft$segment_directory = ARRAY [nft$directory_ordinal] OF                                                  
      RECORD                                                                                                  
        lock: ALIGNED [ 0 MOD 8 ] INTEGER,                                                                    
        task_id: pmt$task_id,                                                                                 
        transfer_symbol: pmt$program_name,                                                                    
        queue_id: pmt$queue_connection,                                                                       
        message_count: pmt$messages_per_queue,                                                                
      RECEND;                                                                                                 
                                                                                                              
  VAR {shared communication segment definition}                                                               
    nfv$segment_initialized: BOOLEAN := FALSE,                                                                
    nfv$segment_name: amt$local_file_name := ' ',                                                             
    nfv$segment_id: amt$file_identifier,                                                                      
    nfv$segment_pointer: amt$segment_pointer,                                                                 
    nfv$segment_directory: ^nft$segment_directory,                                                            
    nfv$segment_lock: ^INTEGER,                                                                               
    nfv$segment_heap: ^HEAP ( * ),                                                                            
    nfv$segment_attributes: ARRAY [1 .. 2] OF amt$file_item :=                                                
      [[amc$access_mode,                                                                                      
        $pft$usage_selections [pfc$read, pfc$shorten, pfc$append, pfc$modify]],                               
       [amc$record_type, amc$undefined]];                                                                     
                                                                                                              
  VAR {intertask message definition}                                                                          
    nfv$intertask_message: pmt$message,                                                                       
    nfv$intertask_message_pointer: ^pmt$message_value := ^nfv$intertask_message.value,                        
    nfv$intertask_buffer_pointer: ^SEQ ( * ),                                                                 
    nfv$intertask_buffer_rpointer: ^REL (HEAP ( * )) ^SEQ ( * );                                              
                                                                                                              
  VAR                                                                                                         
    nfv$trap_handler_conditions: [STATIC, READ, oss$job_paged_literal] pmt$condition :=                       
      [pmc$condition_combination,                                                                             
        [pmc$system_conditions, mmc$segment_access_condition,                                                 
         pmc$user_defined_condition, ifc$interactive_condition]];                                             
                                                                                                              
  VAR {miscellaneous definitions}                                                                             
    nfv$dir_ord: nft$directory_ordinal,                                                                       
    nfv$ignore_status: ost$status,                                                                            
    nfv$ignore_task_status: pmt$task_status,                                                                  
    nfv$task_id: pmt$task_id;                                                                                 
                                                                                                              
*copyc nfe$common_task_communication                                                                          
?? NEWTITLE := 'external reference declarations', EJECT ??                                                    
*copyc amp$close                                                                                              
*copyc amp$get_segment_pointer                                                                                
*copyc amp$open                                                                                               
*copyc amp$return                                                                                             
*copyc clp$convert_integer_to_string                                                                          
*copyc clp$convert_string_to_integer                                                                          
*copyc cyd$run_time_error_condition                                                                           
*copyc osp$format_message                                                                                     
*copyc osp$i_await_activity_completion                                                                        
*copyc osp$set_status_abnormal                                                                                
*copyc osp$set_status_from_condition                                                                          
*copyc oss$job_paged_literal                                                                                  
*copyc ost$signature_lock                                                                                     
*copyc osv$lower_to_upper                                                                                     
*copyc pmp$abort                                                                                              
*copyc pmp$connect_queue                                                                                      
*copyc pmp$continue_to_cause                                                                                  
*copyc pmp$define_queue                                                                                       
*copyc pmp$disconnect_queue                                                                                   
*copyc pmp$establish_condition_handler                                                                        
*copyc pmp$execute                                                                                            
*copyc pmp$get_unique_name                                                                                    
*copyc pmp$get_program_description                                                                            
*copyc pmp$get_program_size                                                                                   
*copyc pmp$get_task_id                                                                                        
*copyc pmp$log                                                                                                
*copyc pmp$receive_from_queue                                                                                 
*copyc pmp$remove_queue                                                                                       
*copyc pmp$send_to_queue                                                                                      
*copyc pmp$status_queue                                                                                       
?? OLDTITLE ??                                                                                                
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'nfp$request_asynchronous_task', EJECT ??                                                      
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc nfh$request_asynchronous_task                                                                          
?? POP ??                                                                                                     
  PROCEDURE [XDCL] nfp$request_asynchronous_task (transfer_symbol: pmt$program_name;                          
        debug_mode: pmt$debug_mode;                                                                           
    VAR connected_task: pmt$task_id;                                                                          
    VAR queue_id: pmt$queue_connection;                                                                       
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    If the shared segment has not been opened and initialized, this is        }                            
  {    done by obtaining a unique name, opening the segment, and building        }                            
  {    a empty directory for the connected tasks at the begining of the          }                            
  {    sequence. The directory entry for the requesting task is then             }                            
  {    esatblished.                                                              }                            
  {                                                                              }                            
  {    When the shared segment has been initialized, an empty directory entry    }                            
  {    is found and locked for the requested task to use when it makes its       }                            
  {    NFP$BEGIN_ASYNCHRONOUS_TASK call to initialize itself. The lock for the   }                            
  {    new tasks directory entry is changed from a lock built from the           }                            
  {    requestors task id to a lock built from the requested tasks id. This      }                            
  {    procedure will then enter a wait loop for the lock to clear or time       }                            
  {    limit exceeded.                                                           }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      number_of_object_files: pmt$number_of_object_files,                                                     
      number_of_modules: pmt$number_of_modules,                                                               
      number_of_libraries: pmt$number_of_libraries,                                                           
                                                                                                              
      program_description: ^pmt$program_description,                                                          
      program_attributes: ^pmt$program_attributes,                                                            
      program_parameters: ^pmt$program_parameters,                                                            
                                                                                                              
      dir_ordinal: nft$directory_ordinal,                                                                     
      queue_name: pmt$queue_name,                                                                             
      unique_name: ost$name,                                                                                  
      shared_segment_name: ^amt$local_file_name,                                                              
      async_task_id: ^pmt$task_id,                                                                            
      repeat_count: 1 .. 360,                                                                                 
      trap_handler_descriptor: pmt$established_handler,                                                       
      lock_status: nft$lock_status;                                                                           
  ?? EJECT ??                                                                                                 
                                                                                                              
 /request_asynchronous_task/                                                                                  
    BEGIN                                                                                                     
      status.normal := TRUE;                                                                                  
      pmp$establish_condition_handler (nfv$trap_handler_conditions,                                           
        ^unlock_and_clean_up, ^trap_handler_descriptor, nfv$ignore_status);                                   
      pmp$get_program_size (number_of_object_files,                                                           
        number_of_modules, number_of_libraries, nfv$ignore_status);                                           
                                                                                                              
      PUSH program_description: [[REP (#SIZE (pmt$program_attributes) +                                       
        (number_of_object_files * #SIZE (amt$local_file_name)) +                                              
        (number_of_modules * #SIZE (pmt$program_name)) +                                                      
        (number_of_libraries * #SIZE (amt$local_file_name))) OF CELL]];                                       
                                                                                                              
      pmp$get_program_description (program_description^, nfv$ignore_status);                                  
                                                                                                              
      RESET program_description;                                                                              
      NEXT program_attributes IN program_description;                                                         
      program_attributes^.contents := program_attributes^.contents +                                          
        $pmt$prog_description_contents [pmc$starting_proc_specified, pmc$term_error_level_specified,          
          pmc$debug_mode_specified, pmc$debug_input_specified, pmc$debug_output_specified];                   
                                                                                                              
      IF NOT nfv$segment_initialized THEN                                                                     
                                                                                                              
        pmp$get_unique_name (unique_name, nfv$ignore_status);                                                 
        nfv$segment_name := unique_name;                                                                      
        initialize_shared_segment (nfv$segment_name, status);                                                 
                                                                                                              
        IF NOT status.normal THEN                                                                             
          EXIT /request_asynchronous_task/;                                                                   
        IFEND;                                                                                                
                                                                                                              
        RESET nfv$segment_heap^;                                                                              
                                                                                                              
        nfv$segment_lock^ := 0;                                                                               
        FOR dir_ordinal := LOWERVALUE(dir_ordinal) TO UPPERVALUE(dir_ordinal) DO {clear all entries}          
          nfv$segment_directory^[dir_ordinal].lock := 0;                                                      
          clear_directory_entry (dir_ordinal);                                                                
        FOREND;                                                                                               
                                                                                                              
        get_directory_ordinal (pmc$max_task_id, nfv$dir_ord, status);                                         
                                                                                                              
        IF NOT status.normal THEN                                                                             
          EXIT /request_asynchronous_task/;                                                                   
        IFEND;                                                                                                
                                                                                                              
        process_lock (nfc$lock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);                 
        IF lock_status.condition = osc$sls_locked_by_current_task THEN                                        
                                                                                                              
          generate_queue_name (nfv$task_id, queue_name);                                                      
          pmp$define_queue (queue_name, osc$user_ring, osc$user_ring, status);                                
          IF status.normal THEN                                                                               
                                                                                                              
            nfv$segment_directory^[nfv$dir_ord].task_id := nfv$task_id;                                       
            nfv$segment_directory^[nfv$dir_ord].                                                              
              transfer_symbol := program_attributes^.starting_procedure;                                      
            pmp$connect_queue (queue_name, nfv$segment_directory^[nfv$dir_ord].queue_id, status);             
            queue_id := nfv$segment_directory^[nfv$dir_ord].queue_id;                                         
                                                                                                              
          IFEND;                                                                                              
                                                                                                              
          process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);             
                                                                                                              
        IFEND;                                                                                                
                                                                                                              
        IF NOT status.normal THEN                                                                             
          EXIT /request_asynchronous_task/;                                                                   
        IFEND;                                                                                                
                                                                                                              
      IFEND;                                                                                                  
                                                                                                              
      REPEAT                                                                                                  
        get_directory_ordinal (pmc$max_task_id, dir_ordinal, status);                                         
        IF NOT status.normal THEN                                                                             
          EXIT /request_asynchronous_task/;                                                                   
        IFEND;                                                                                                
        process_lock (nfc$lock, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);                 
      UNTIL lock_status.condition = osc$sls_locked_by_current_task;                                           
                                                                                                              
      #TRANSLATE (osv$lower_to_upper, transfer_symbol, program_attributes^.starting_procedure);               
      program_attributes^.termination_error_level := pmc$fatal_load_errors;                                   
      program_attributes^.debug_mode := debug_mode;                                                           
      program_attributes^.debug_input := 'COMMAND';                                                           
      program_attributes^.debug_output := '$OUTPUT';                                                          
                                                                                                              
      PUSH program_parameters: [[REP 1 OF amt$local_file_name, REP 1 OF pmt$task_id]];                        
      RESET program_parameters;                                                                               
      NEXT shared_segment_name IN program_parameters;                                                         
      shared_segment_name^ := nfv$segment_name;                                                               
      NEXT async_task_id IN program_parameters;                                                               
      async_task_id^ := nfv$task_id;                                                                          
                                                                                                              
      pmp$execute (program_description^,                                                                      
        program_parameters^, osc$nowait, connected_task, nfv$ignore_task_status, status);                     
                                                                                                              
      IF status.normal THEN {interlock directory for asynchronous task}                                       
                                                                                                              
        nfv$segment_directory^[dir_ordinal].lock := key_for_lock(connected_task);                             
        FOR repeat_count := LOWERVALUE(repeat_count) TO UPPERVALUE(repeat_count) DO                           
                                                                                                              
          process_lock (nfc$examine, 0, 1, nfv$segment_directory^[dir_ordinal].lock, lock_status);            
          IF lock_status.condition = osc$sls_not_locked THEN                                                  
            {asynchronous task running}                                                                       
            EXIT /request_asynchronous_task/;                                                                 
          IFEND;                                                                                              
                                                                                                              
        FOREND;                                                                                               
                                                                                                              
        clear_directory_entry (dir_ordinal);                                                                  
        nfv$segment_directory^[dir_ordinal].lock := key_for_lock(0);                                          
        osp$set_status_abnormal (nfc$status_id, nfe$task_not_responding , '', status);                        
                                                                                                              
      IFEND;                                                                                                  
                                                                                                              
      process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);                 
                                                                                                              
    END /request_asynchronous_task/;                                                                          
                                                                                                              
  PROCEND nfp$request_asynchronous_task;                                                                      
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'nfp$begin_asynchronous_task', EJECT ??                                                        
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc nfh$begin_asynchronous_task                                                                            
?? POP ??                                                                                                     
  PROCEDURE [XDCL] nfp$begin_asynchronous_task (parameters: pmt$program_parameters;                           
    VAR connected_task: pmt$task_id;                                                                          
    VAR queue_id: pmt$queue_connection;                                                                       
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    This interface uses the shared segment name and requestors task id        }                            
  {    passed through the procedure call parameters to establish communication   }                            
  {    with the requesting task. The shared segment is opened and the directory  }                            
  {    is searched for an entry that has previously been locked for this task.   }                            
  {    When the entry has been found, it completes initialization and clears     }                            
  {    the lock. This is an indication to the requestor that communication       }                            
  {    has been established and subsequent NFP$GET_ASYNC_TASK_MESSAGE and        }                            
  {    NFP$PUT_ASYNC_TASK_MESSAGE calls can be accepted.                         }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    CONST                                                                                                     
      retry_limit = 20;                                                                                       
                                                                                                              
    VAR                                                                                                       
      number_of_object_files: pmt$number_of_object_files,                                                     
      number_of_modules: pmt$number_of_modules,                                                               
      number_of_libraries: pmt$number_of_libraries,                                                           
                                                                                                              
      program_description: ^pmt$program_description,                                                          
      program_attributes: ^pmt$program_attributes,                                                            
      program_parameters: ^pmt$program_parameters,                                                            
                                                                                                              
      dir_ordinal: nft$directory_ordinal,                                                                     
      queue_name: pmt$queue_name,                                                                             
      shared_segment_name: ^amt$local_file_name,                                                              
      async_task_id: ^pmt$task_id,                                                                            
      retry_count: 0 .. 3600,                                                                                 
      trap_handler_descriptor: pmt$established_handler,                                                       
      lock_status: nft$lock_status;                                                                           
  ?? OLDTITLE, EJECT ??                                                                                       
                                                                                                              
 /begin_asynchronous_task/                                                                                    
    BEGIN                                                                                                     
      status.normal := TRUE;                                                                                  
      pmp$establish_condition_handler (nfv$trap_handler_conditions,                                           
        ^unlock_and_clean_up, ^trap_handler_descriptor, nfv$ignore_status);                                   
                                                                                                              
      IF NOT nfv$segment_initialized THEN                                                                     
                                                                                                              
        pmp$get_program_size (number_of_object_files,                                                         
          number_of_modules, number_of_libraries, nfv$ignore_status);                                         
                                                                                                              
        PUSH program_description: [[REP (#SIZE (pmt$program_attributes) +                                     
          (number_of_object_files * #SIZE (amt$local_file_name)) +                                            
          (number_of_modules * #SIZE (pmt$program_name)) +                                                    
          (number_of_libraries * #SIZE (amt$local_file_name))) OF CELL]];                                     
                                                                                                              
        pmp$get_program_description (program_description^, nfv$ignore_status);                                
                                                                                                              
        RESET program_description;                                                                            
        NEXT program_attributes IN program_description;                                                       
        program_attributes^.contents := program_attributes^.contents +                                        
          $pmt$prog_description_contents [pmc$starting_proc_specified];                                       
        program_parameters := ^parameters;                                                                    
                                                                                                              
        RESET program_parameters;                                                                             
        NEXT shared_segment_name IN program_parameters;                                                       
        nfv$segment_name := shared_segment_name^;                                                             
        NEXT async_task_id IN program_parameters;                                                             
        connected_task := async_task_id^;                                                                     
        RESET program_parameters;                                                                             
                                                                                                              
        initialize_shared_segment (nfv$segment_name, status);                                                 
        IF status.normal THEN                                                                                 
                                                                                                              
          FOR retry_count := LOWERVALUE(retry_count) TO retry_limit DO                                        
            FOR nfv$dir_ord := LOWERVALUE(nfv$dir_ord) TO UPPERVALUE(nfv$dir_ord) DO                          
                                                                                                              
              process_lock (nfc$examine, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);        
              IF lock_status.condition = osc$sls_locked_by_current_task THEN                                  
                                                                                                              
                generate_queue_name (nfv$task_id, queue_name);                                                
                pmp$define_queue (queue_name, osc$user_ring, osc$user_ring, status);                          
                IF status.normal THEN                                                                         
                                                                                                              
                  nfv$segment_directory^[nfv$dir_ord].task_id := nfv$task_id;                                 
                  nfv$segment_directory^[nfv$dir_ord].                                                        
                    transfer_symbol := program_attributes^.starting_procedure;                                
                  pmp$connect_queue (queue_name, nfv$segment_directory^[nfv$dir_ord].queue_id, status);       
                  queue_id := nfv$segment_directory^[nfv$dir_ord].queue_id;                                   
                  process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);     
                  EXIT /begin_asynchronous_task/;                                                             
                                                                                                              
                IFEND;                                                                                        
                process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);       
                                                                                                              
              IFEND;                                                                                          
                                                                                                              
            FOREND;                                                                                           
          FOREND;                                                                                             
                                                                                                              
          osp$set_status_abnormal (nfc$status_id, nfe$async_task_timeout, '', status);                        
        IFEND;                                                                                                
        EXIT /begin_asynchronous_task/;                                                                       
                                                                                                              
      IFEND;                                                                                                  
      osp$set_status_abnormal (nfc$status_id, nfe$redundant_begin_task, '', status);                          
    END  /begin_asynchronous_task/;                                                                           
                                                                                                              
  PROCEND nfp$begin_asynchronous_task;                                                                        
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'nfp$get_async_task_message', EJECT ??                                                         
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc nfh$get_async_task_message                                                                             
?? POP ??                                                                                                     
  PROCEDURE [XDCL] nfp$get_async_task_message (connected_task: pmt$task_id;                                   
        working_storage_area: ^CELL;                                                                          
        working_storage_length: nft$intertask_transfer_size;                                                  
        wait_time: nft$intertask_wait_time;                                                                   
    VAR transfer_count: nft$intertask_transfer_size;                                                          
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    The indication that a message is available is made by statusing the       }                            
  {    tasks unique job local queue. If a message(s) is waiting it is            }                            
  {    retrieved and the senders task id is compared against the task id from    }                            
  {    from the call. If they are equal, the message is written to the callers   }                            
  {    working storage area. If they are not equal, the message is requeued      }                            
  {    and an attempt is made to obtain another message until all messages have  }                            
  {    been scanned.                                                             }                            
  {                                                                              }                            
  {  DESIGN NOTE:                                                                }                            
  {    Because of the possibility of messages being requeued, the user of these  }                            
  {    interfaces can not be assured that messages will be returned in any       }                            
  {    specific order.                                                           }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      async_ordinal: nft$directory_ordinal,                                                                   
      async_queue_id: pmt$queue_connection,                                                                   
      dir_ordinal: nft$directory_ordinal,                                                                     
      lock_status: nft$lock_status,                                                                           
      queue_status: pmt$queue_status,                                                                         
      trap_handler_descriptor: pmt$established_handler,                                                       
      working_storage_pointer: ^STRING (nfc$max_transfer_size),                                               
      ignore_status: ost$status;                                                                              
                                                                                                              
    VAR                                                                                                       
      data_pointer: ^ARRAY [ * ] OF CELL,                                                                     
      data_size: ^INTEGER,                                                                                    
      sender_id: ^pmt$task_id;                                                                                
                                                                                                              
    VAR                                                                                                       
      ready_index: INTEGER,                                                                                   
      wait_list: ^ost$i_wait_list;                                                                            
  ?? EJECT ??                                                                                                 
                                                                                                              
 /get_async_task_message/                                                                                     
    BEGIN                                                                                                     
      status.normal := TRUE;                                                                                  
      transfer_count := 0;                                                                                    
                                                                                                              
      IF NOT nfv$segment_initialized THEN                                                                     
        osp$set_status_abnormal (nfc$status_id, nfe$module_not_initialized, '', status);                      
        EXIT /get_async_task_message/;                                                                        
      IFEND;                                                                                                  
                                                                                                              
      IF (working_storage_area = NIL) OR (working_storage_length = 0) THEN                                    
        EXIT /get_async_task_message/;                                                                        
      IFEND;                                                                                                  
                                                                                                              
      IF wait_time > 0 THEN {build delay interval}                                                            
        PUSH wait_list: [1 .. 2];                                                                             
        wait_list^[1].activity := osc$i_await_time;                                                           
        wait_list^[1].milliseconds := wait_time * nfc$millisecond;                                            
        wait_list^[2].activity := pmc$i_await_local_queue_message;                                            
        wait_list^[2].qid := nfv$segment_directory^[nfv$dir_ord].queue_id;                                    
      ELSE { no wait time specified }                                                                         
        wait_list := NIL;                                                                                     
      IFEND;                                                                                                  
                                                                                                              
      REPEAT {check job local queue}                                                                          
        pmp$status_queue (nfv$segment_directory^[nfv$dir_ord].queue_id, queue_status, status);                
        IF (NOT status.normal) OR ((wait_list = NIL) AND (queue_status.messages = 0)) THEN                    
          EXIT /get_async_task_message/;                                                                      
        ELSEIF {wait_list <> NIL AND} queue_status.messages = 0 THEN                                          
          osp$i_await_activity_completion (wait_list^, ready_index, nfv$ignore_status);                       
          wait_list := NIL;                                                                                   
        IFEND;                                                                                                
      UNTIL queue_status.messages > 0;                                                                        
                                                                                                              
      pmp$establish_condition_handler (nfv$trap_handler_conditions,                                           
        ^unlock_and_clean_up, ^trap_handler_descriptor, nfv$ignore_status);                                   
      working_storage_pointer := working_storage_area;                                                        
                                                                                                              
      /get_intertask_message/                                                                                 
      WHILE queue_status.messages > 0 DO                                                                      
        pmp$receive_from_queue (nfv$segment_directory^[nfv$dir_ord].queue_id,                                 
          osc$nowait, nfv$intertask_message, status);                                                         
                                                                                                              
        IF status.normal THEN {intertask message received}                                                    
          IF nfv$intertask_message.contents = pmc$message_value THEN                                          
                                                                                                              
            queue_status.messages := queue_status.messages - 1;                                               
            RESET nfv$intertask_message_pointer;                                                              
            NEXT nfv$intertask_buffer_rpointer IN nfv$intertask_message_pointer;                              
            nfv$intertask_buffer_pointer := #ptr (nfv$intertask_buffer_rpointer^, nfv$segment_heap^);         
                                                                                                              
            RESET nfv$intertask_buffer_pointer;                                                               
            NEXT sender_id IN nfv$intertask_buffer_pointer;                                                   
                                                                                                              
            IF (sender_id <> NIL) AND (sender_id^ <> connected_task) THEN                                     
              pmp$send_to_queue (nfv$segment_directory^[nfv$dir_ord].                                         
                queue_id, nfv$intertask_message, nfv$ignore_status);                                          
              CYCLE /get_intertask_message/;                                                                  
            IFEND;                                                                                            
                                                                                                              
            NEXT data_size IN nfv$intertask_buffer_pointer;                                                   
            NEXT data_pointer: [1 .. data_size^] IN nfv$intertask_buffer_pointer;                             
                                                                                                              
            IF (data_size <> NIL) AND (data_pointer <> NIL) THEN                                              
                                                                                                              
              connect_to_task (sender_id^, async_ordinal, async_queue_id, status);                            
              IF status.normal THEN {update senders message count and transfer message}                       
                                                                                                              
                IF nfv$segment_directory^[async_ordinal].message_count > 0 THEN                               
                  nfv$segment_directory^[async_ordinal].message_count :=                                      
                    nfv$segment_directory^[async_ordinal].message_count - 1;                                  
                ELSE {senders message count not valid}                                                        
                  nfv$segment_directory^[async_ordinal].message_count := 0;                                   
                IFEND;                                                                                        
                                                                                                              
                disconnect_from_task (sender_id^, async_ordinal, nfv$ignore_status);                          
                                                                                                              
              IFEND;                                                                                          
                                                                                                              
              #UNCHECKED_CONVERSION (data_pointer^, working_storage_pointer^ (1, data_size^));                
              transfer_count := data_size^;                                                                   
              process_lock (nfc$lock, 10, 1, nfv$segment_lock^, lock_status);                                 
              IF lock_status.condition <> osc$sls_locked_by_current_task THEN                                 
                osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                           
                  '', status);                                                                                
                log_status_message (status, ignore_status);                                                   
                RETURN;                                                                                       
              IFEND;                                                                                          
              FREE nfv$intertask_buffer_pointer IN nfv$segment_heap^;                                         
              process_lock (nfc$unlock, 10, 1, nfv$segment_lock^, lock_status);                               
              IF lock_status.condition <> osc$sls_not_locked THEN                                             
                osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                           
                  '', status);                                                                                
                log_status_message (status, ignore_status);                                                   
              IFEND;                                                                                          
              EXIT /get_async_task_message/;                                                                  
                                                                                                              
            IFEND;                                                                                            
          IFEND;                                                                                              
          osp$set_status_abnormal (nfc$status_id, nfe$bad_message_discarded, '', status);                     
                                                                                                              
        IFEND;                                                                                                
        EXIT /get_intertask_message/;                                                                         
      WHILEND /get_intertask_message/;                                                                        
    END /get_async_task_message/;                                                                             
                                                                                                              
  PROCEND nfp$get_async_task_message;                                                                         
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'nfp$put_async_task_message', EJECT ??                                                         
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc nfh$put_async_task_message                                                                             
?? POP ??                                                                                                     
  PROCEDURE [XDCL] nfp$put_async_task_message (connected_task: pmt$task_id;                                   
        working_storage_area: ^CELL;                                                                          
        working_storage_length: nft$intertask_transfer_size;                                                  
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    Messages are sent to the asynchronous task by copying the message from    }                            
  {    the callers working storage area to the shared segment, and placing       }                            
  {    a message containg a pointer to the data in the unique job local queue    }                            
  {    for the asynchronous task.                                                }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      queue_id: pmt$queue_connection,                                                                         
      trap_handler_descriptor: pmt$established_handler,                                                       
      working_storage_pointer: ^ARRAY [1 .. nfc$max_transfer_size] OF CELL,                                   
      dir_ordinal: nft$directory_ordinal,                                                                     
      async_ordinal: nft$directory_ordinal,                                                                   
      lock_status: nft$lock_status,                                                                           
      ignore_status: ost$status;                                                                              
                                                                                                              
    VAR                                                                                                       
      sender_id: ^pmt$task_id,                                                                                
      data_size: ^INTEGER,                                                                                    
      data_pointer: ^ARRAY [ * ] OF CELL;                                                                     
  ?? EJECT ??                                                                                                 
                                                                                                              
 /put_async_task_message/                                                                                     
    BEGIN                                                                                                     
      status.normal := TRUE;                                                                                  
                                                                                                              
      IF NOT nfv$segment_initialized THEN                                                                     
        osp$set_status_abnormal (nfc$status_id, nfe$module_not_initialized, '', status);                      
        EXIT /put_async_task_message/;                                                                        
      IFEND;                                                                                                  
                                                                                                              
      IF (working_storage_area = NIL) OR (working_storage_length = 0) THEN                                    
        EXIT /put_async_task_message/;                                                                        
      IFEND;                                                                                                  
                                                                                                              
      working_storage_pointer := working_storage_area;                                                        
      process_lock (nfc$lock, 10, 1, nfv$segment_lock^, lock_status);                                         
      IF lock_status.condition <> osc$sls_locked_by_current_task THEN                                         
         osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                  
           '', status);                                                                                       
         log_status_message (status, ignore_status);                                                          
         RETURN;                                                                                              
      IFEND;                                                                                                  
      ALLOCATE nfv$intertask_buffer_pointer:                                                                  
        [[REP 1 OF pmt$task_id,                                                                               
          REP 1 OF INTEGER,                                                                                   
          REP working_storage_length OF CELL]] IN nfv$segment_heap^;                                          
      IF nfv$intertask_buffer_pointer = NIL THEN                                                              
        osp$set_status_abnormal (nfc$status_id, nfe$allocation_failure, '', status);                          
        log_status_message (status, ignore_status);                                                           
        RETURN;                                                                                               
      IFEND;                                                                                                  
      process_lock (nfc$unlock, 10, 1, nfv$segment_lock^, lock_status);                                       
      IF lock_status.condition <> osc$sls_not_locked THEN                                                     
         osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                  
           '', status);                                                                                       
         log_status_message (status, ignore_status);                                                          
         RETURN;                                                                                              
      IFEND;                                                                                                  
      RESET nfv$intertask_buffer_pointer;                                                                     
      NEXT sender_id IN nfv$intertask_buffer_pointer;                                                         
      sender_id^ := nfv$task_id;                                                                              
      NEXT data_size IN nfv$intertask_buffer_pointer;                                                         
      data_size^ := working_storage_length;                                                                   
      NEXT data_pointer: [1 .. data_size^] IN nfv$intertask_buffer_pointer;                                   
      data_pointer^ := working_storage_pointer^;                                                              
      nfv$intertask_message.contents := pmc$message_value;                                                    
                                                                                                              
      RESET nfv$intertask_message_pointer;                                                                    
      NEXT nfv$intertask_buffer_rpointer IN nfv$intertask_message_pointer;                                    
      nfv$intertask_buffer_rpointer^ := #REL (nfv$intertask_buffer_pointer, nfv$segment_heap^);               
                                                                                                              
      pmp$establish_condition_handler (nfv$trap_handler_conditions,                                           
        ^unlock_and_clean_up, ^trap_handler_descriptor, nfv$ignore_status);                                   
      process_lock (nfc$lock, 60, 1, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);                  
      IF lock_status.condition = osc$sls_locked_by_current_task THEN                                          
                                                                                                              
        connect_to_task (connected_task, async_ordinal, queue_id, status);                                    
                                                                                                              
        IF status.normal THEN                                                                                 
                                                                                                              
          pmp$send_to_queue (queue_id, nfv$intertask_message, status);                                        
          IF status.normal THEN                                                                               
                                                                                                              
            IF nfv$segment_directory^[nfv$dir_ord].message_count >= 0 THEN                                    
              nfv$segment_directory^[nfv$dir_ord].message_count :=                                            
               nfv$segment_directory^[nfv$dir_ord].message_count + 1;                                         
            ELSE                                                                                              
              nfv$segment_directory^[nfv$dir_ord].message_count := 1;                                         
            IFEND;                                                                                            
                                                                                                              
          IFEND;                                                                                              
          disconnect_from_task (connected_task, async_ordinal, nfv$ignore_status);                            
                                                                                                              
        IFEND;                                                                                                
                                                                                                              
        process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);               
                                                                                                              
      ELSE                                                                                                    
        osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task, '', status);                      
      IFEND;                                                                                                  
                                                                                                              
      IF NOT status.normal THEN {message not transfered}                                                      
        process_lock (nfc$lock, 10, 1, nfv$segment_lock^, lock_status);                                       
        IF lock_status.condition <> osc$sls_locked_by_current_task THEN                                       
          osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                 
            '', status);                                                                                      
          log_status_message (status, ignore_status);                                                         
          RETURN;                                                                                             
        IFEND;                                                                                                
        FREE nfv$intertask_buffer_pointer IN nfv$segment_heap^;                                               
        process_lock (nfc$unlock, 10, 1, nfv$segment_lock^, lock_status);                                     
        IF lock_status.condition <> osc$sls_not_locked THEN                                                   
          osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                 
            '', status);                                                                                      
          log_status_message (status, ignore_status);                                                         
        IFEND;                                                                                                
      IFEND;                                                                                                  
                                                                                                              
    END /put_async_task_message/;                                                                             
                                                                                                              
  PROCEND nfp$put_async_task_message;                                                                         
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'nfp$end_async_communication', EJECT ??                                                        
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc nfh$end_async_communication                                                                            
?? POP ??                                                                                                     
  PROCEDURE [XDCL] nfp$end_async_communication (check_activity: BOOLEAN;                                      
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    If the caller requests that termination should not be completed with      }                            
  {    activity pending (CHECK_ACTIVITY := TRUE), the activity pending           }                            
  {    status condition will be returned if the tasks unique job local queue     }                            
  {    contains messages or if there are messages that this task has sent        }                            
  {    that have not been picked up. If CHECK_ACTIVITY := FALSE, intertask       }                            
  {    communication through nfm$common_task_communication is unconditionally    }                            
  {    terminated.                                                               }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      queue_name: pmt$queue_name,                                                                             
      queue_status: pmt$queue_status,                                                                         
      trap_handler_descriptor: pmt$established_handler,                                                       
      lock_status: nft$lock_status;                                                                           
  ?? EJECT ??                                                                                                 
                                                                                                              
 /end_async_communication/                                                                                    
    BEGIN                                                                                                     
      status.normal := TRUE;                                                                                  
      pmp$establish_condition_handler (nfv$trap_handler_conditions,                                           
        ^unlock_and_clean_up, ^trap_handler_descriptor, nfv$ignore_status);                                   
                                                                                                              
      IF nfv$segment_initialized THEN                                                                         
                                                                                                              
        process_lock (nfc$lock, 60, 1, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);                
        IF lock_status.condition = osc$sls_locked_by_current_task THEN                                        
                                                                                                              
          pmp$status_queue (nfv$segment_directory^[nfv$dir_ord].queue_id, queue_status, status);              
          IF status.normal THEN                                                                               
            IF (NOT check_activity) OR (nfv$segment_directory^[nfv$dir_ord].message_count +                   
                queue_status.messages + queue_status.waiting_tasks = 0) THEN                                  
                                                                                                              
              empty_queue (nfv$ignore_status);                                                                
              pmp$disconnect_queue (nfv$segment_directory^[nfv$dir_ord].queue_id, nfv$ignore_status);         
              generate_queue_name (nfv$task_id, queue_name);                                                  
              pmp$remove_queue (queue_name, nfv$ignore_status);                                               
              clear_directory_entry (nfv$dir_ord);                                                            
              process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);         
              amp$close (nfv$segment_id, nfv$ignore_status);                                                  
              nfv$segment_initialized := FALSE;                                                               
              amp$return (nfv$segment_name, nfv$ignore_status);                                               
              RETURN;                                                                                         
                                                                                                              
            ELSE                                                                                              
              osp$set_status_abnormal (nfc$status_id, nfe$activity_pending, '', status);                      
            IFEND;                                                                                            
                                                                                                              
          IFEND;                                                                                              
          process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[nfv$dir_ord].lock, lock_status);             
                                                                                                              
        ELSE                                                                                                  
          osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task, '', status);                    
                                                                                                              
        IFEND;                                                                                                
        EXIT /end_async_communication/;                                                                       
                                                                                                              
      IFEND;                                                                                                  
      osp$set_status_abnormal (nfc$status_id, nfe$module_not_initialized, '', status);                        
    END /end_async_communication/;                                                                            
                                                                                                              
  PROCEND nfp$end_async_communication;                                                                        
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  utility procedures', EJECT ??                                                             
  ?? NEWTITLE := '  clear_directory_entry', EJECT ??                                                          
  PROCEDURE [INLINE] clear_directory_entry (dir_ordinal: nft$directory_ordinal);                              
  ?? SKIP := 4 ??                                                                                             
    BEGIN {clear_directory_entry}                                                                             
      nfv$segment_directory^[dir_ordinal].task_id := pmc$max_task_id;                                         
      nfv$segment_directory^[dir_ordinal].transfer_symbol := ' ';                                             
      nfv$segment_directory^[dir_ordinal].queue_id := 1;                                                      
      nfv$segment_directory^[dir_ordinal].message_count := 0;                                                 
    END;                                                                                                      
  PROCEND clear_directory_entry;                                                                              
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  connect_to_task', EJECT ??                                                                
  PROCEDURE [INLINE] connect_to_task (task_identifier: pmt$task_id;                                           
    VAR dir_ordinal: nft$directory_ordinal;                                                                   
    VAR queue_id: pmt$queue_connection;                                                                       
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      queue_name: pmt$queue_name,                                                                             
      wait_list: ^ost$i_wait_list,                                                                            
      ready_index: INTEGER,                                                                                   
      retry_count: 0 .. 59,                                                                                   
      lock_status: nft$lock_status;                                                                           
  ?? SKIP := 4 ??                                                                                             
    BEGIN {connect_to_task}                                                                                   
      get_directory_ordinal (task_identifier, dir_ordinal, status);                                           
      IF status.normal THEN                                                                                   
        process_lock (nfc$lock, 60, 1, nfv$segment_directory^[dir_ordinal].lock, lock_status);                
        IF lock_status.condition = osc$sls_locked_by_current_task THEN                                        
                                                                                                              
          IF nfv$segment_directory^[dir_ordinal].task_id = task_identifier THEN                               
            PUSH wait_list: [1 .. 1];                                                                         
            wait_list^[1].activity := osc$i_await_time;                                                       
            wait_list^[1].milliseconds := 1 * nfc$millisecond;                                                
            generate_queue_name (task_identifier, queue_name);                                                
            queue_id := nfv$segment_directory^[dir_ordinal].queue_id;                                         
                                                                                                              
            FOR retry_count := LOWERVALUE(retry_count) TO UPPERVALUE(retry_count) DO                          
              pmp$connect_queue (queue_name, queue_id, status);                                               
              IF (status.normal) OR (status.condition <> pme$unknown_queue_name) THEN                         
                RETURN;                                                                                       
              IFEND;                                                                                          
              osp$i_await_activity_completion (wait_list^, ready_index, nfv$ignore_status);                   
            FOREND;                                                                                           
                                                                                                              
          IFEND;                                                                                              
          process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);             
          osp$set_status_abnormal (nfc$status_id, nfe$task_not_active, '', status);                           
          EXIT connect_to_task;                                                                               
        IFEND;                                                                                                
        osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task, '', status);                      
      IFEND;                                                                                                  
    END;                                                                                                      
  PROCEND connect_to_task;                                                                                    
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  disconnect_from_task', EJECT ??                                                           
  PROCEDURE [INLINE] disconnect_from_task (task_identifier: pmt$task_id;                                      
        dir_ordinal: nft$directory_ordinal;                                                                   
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      lock_status: nft$lock_status,                                                                           
      local_status: ost$status;                                                                               
  ?? SKIP := 4 ??                                                                                             
    BEGIN {disconnect_from_task}                                                                              
                                                                                                              
      process_lock (nfc$examine, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);                
      IF (lock_status.condition = osc$sls_locked_by_current_task) AND                                         
         (nfv$segment_directory^[dir_ordinal].task_id = task_identifier) THEN                                 
                                                                                                              
        pmp$disconnect_queue (nfv$segment_directory^[dir_ordinal].queue_id, local_status);                    
        IF local_status.normal THEN                                                                           
                                                                                                              
          process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);             
          status.normal := TRUE;                                                                              
          RETURN;                                                                                             
                                                                                                              
        IFEND;                                                                                                
                                                                                                              
      ELSE {not locked by current job}                                                                        
                                                                                                              
        osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task, '', local_status);                
                                                                                                              
      IFEND;                                                                                                  
                                                                                                              
      pmp$abort (local_status);                                                                               
    END;                                                                                                      
  PROCEND disconnect_from_task;                                                                               
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  empty_queue', EJECT ??                                                                    
  PROCEDURE empty_queue (VAR status: ost$status);                                                             
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      async_ordinal: nft$directory_ordinal,                                                                   
      async_queue_id: pmt$queue_connection,                                                                   
      data_pointer: ^ARRAY [ * ] OF CELL,                                                                     
      data_size: ^INTEGER,                                                                                    
      lock_status: nft$lock_status,                                                                           
      sender_id: ^pmt$task_id,                                                                                
      ignore_status: ost$status;                                                                              
  ?? SKIP := 4 ??                                                                                             
    BEGIN {empty_queue}                                                                                       
                                                                                                              
      WHILE TRUE DO {get message from queue}                                                                  
        pmp$receive_from_queue (nfv$segment_directory^[nfv$dir_ord].queue_id,                                 
          osc$nowait, nfv$intertask_message, status);                                                         
                                                                                                              
        IF (NOT status.normal) OR (nfv$intertask_message.contents <> pmc$message_value) THEN                  
          EXIT empty_queue;                                                                                   
        IFEND;                                                                                                
                                                                                                              
        RESET nfv$intertask_message_pointer;                                                                  
        NEXT nfv$intertask_buffer_rpointer IN nfv$intertask_message_pointer;                                  
        nfv$intertask_buffer_pointer := #ptr (nfv$intertask_buffer_rpointer^, nfv$segment_heap^);             
                                                                                                              
        RESET nfv$intertask_buffer_pointer;                                                                   
        NEXT sender_id IN nfv$intertask_buffer_pointer;                                                       
        NEXT data_size IN nfv$intertask_buffer_pointer;                                                       
        NEXT data_pointer: [1 .. data_size^] IN nfv$intertask_buffer_pointer;                                 
                                                                                                              
        connect_to_task (sender_id^, async_ordinal, async_queue_id, status);                                  
        IF status.normal THEN {update senders message count and transfer message}                             
                                                                                                              
          IF nfv$segment_directory^[async_ordinal].message_count > 0 THEN                                     
            nfv$segment_directory^[async_ordinal].message_count :=                                            
              nfv$segment_directory^[async_ordinal].message_count - 1;                                        
          ELSE {senders message count not valid}                                                              
            nfv$segment_directory^[async_ordinal].message_count := 0;                                         
          IFEND;                                                                                              
                                                                                                              
          disconnect_from_task (sender_id^, async_ordinal, nfv$ignore_status);                                
                                                                                                              
        IFEND;                                                                                                
        process_lock (nfc$lock, 10, 1, nfv$segment_lock^, lock_status);                                       
        IF lock_status.condition <> osc$sls_locked_by_current_task THEN                                       
          osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                 
            '', status);                                                                                      
          log_status_message (status, ignore_status);                                                         
          RETURN;                                                                                             
        IFEND;                                                                                                
        FREE nfv$intertask_buffer_pointer IN nfv$segment_heap^;                                               
        process_lock (nfc$unlock, 10, 1, nfv$segment_lock^, lock_status);                                     
        IF lock_status.condition <> osc$sls_not_locked THEN                                                   
          osp$set_status_abnormal (nfc$status_id, nfe$locked_by_another_task,                                 
            '', status);                                                                                      
          log_status_message (status, ignore_status);                                                         
        IFEND;                                                                                                
                                                                                                              
      WHILEND;                                                                                                
    END                                                                                                       
  PROCEND empty_queue;                                                                                        
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  generate_queue_name', EJECT ??                                                            
  PROCEDURE [INLINE] generate_queue_name (task_identifier: pmt$task_id;                                       
    VAR queue_name: pmt$queue_name);                                                                          
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      task_id_string: ost$string;                                                                             
  ?? SKIP := 4 ??                                                                                             
    BEGIN {generate_queue_name}                                                                               
      clp$convert_integer_to_string (task_identifier, 10, FALSE, task_id_string, nfv$ignore_status);          
      queue_name := 'nfd$queue_for_task_';                                                                    
      queue_name(20, *) := task_id_string.value;                                                              
    END;                                                                                                      
  PROCEND generate_queue_name;                                                                                
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  get_directory_ordinal', EJECT ??                                                          
  PROCEDURE [INLINE] get_directory_ordinal (task_identifier: pmt$task_id;                                     
    VAR dir_ordinal: nft$directory_ordinal;                                                                   
    VAR status: ost$status);                                                                                  
  ?? SKIP := 4 ??                                                                                             
    BEGIN {get_directory_ordinal}                                                                             
      FOR dir_ordinal := LOWERVALUE(dir_ordinal) TO UPPERVALUE(dir_ordinal) DO                                
        IF nfv$segment_directory^[dir_ordinal].task_id = task_identifier THEN                                 
          status.normal := TRUE;                                                                              
          {task found in directory} RETURN;                                                                   
        IFEND;                                                                                                
      FOREND;                                                                                                 
      osp$set_status_abnormal (nfc$status_id, nfe$task_not_found, '', status);                                
    END;                                                                                                      
  PROCEND get_directory_ordinal;                                                                              
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  initialize_shared_segment', EJECT ??                                                      
  PROCEDURE [INLINE] initialize_shared_segment (shared_segment: amt$local_file_name;                          
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
    BEGIN {initialize_shared_segment}                                                                         
      IF NOT nfv$segment_initialized THEN                                                                     
        pmp$get_task_id (nfv$task_id, nfv$ignore_status);                                                     
        nfv$segment_name := shared_segment;                                                                   
        amp$open (nfv$segment_name, amc$segment, ^nfv$segment_attributes, nfv$segment_id, status);            
        IF status.normal THEN                                                                                 
          amp$get_segment_pointer (nfv$segment_id, amc$sequence_pointer, nfv$segment_pointer, status);        
          IF status.normal THEN                                                                               
            RESET nfv$segment_pointer.sequence_pointer;                                                       
            NEXT nfv$segment_lock IN nfv$segment_pointer.sequence_pointer;                                    
            NEXT nfv$segment_directory IN nfv$segment_pointer.sequence_pointer;                               
            NEXT nfv$segment_heap: [[REP pmc$max_queues_per_job * nfc$max_transfer_size OF CELL]]             
              IN nfv$segment_pointer.sequence_pointer;                                                        
            nfv$segment_initialized := TRUE;                                                                  
            RETURN;                                                                                           
          IFEND;                                                                                              
          amp$close (nfv$segment_id, nfv$ignore_status);                                                      
          amp$return (nfv$segment_name, nfv$ignore_status);                                                   
        IFEND;                                                                                                
      ELSE                                                                                                    
        osp$set_status_abnormal (nfc$status_id, nfe$redundant_initialize_seg, '', status);                    
      IFEND;                                                                                                  
    END;                                                                                                      
  PROCEND initialize_shared_segment;                                                                          
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '  key_for_lock', EJECT ??                                                                     
  FUNCTION [INLINE] key_for_lock (task_identifier: pmt$task_id): INTEGER;                                     
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      key_to_lock: INTEGER,                                                                                   
      key_definition: nft$key_definition;                                                                     
  ?? SKIP := 4 ??                                                                                             
    BEGIN {key_for_lock}                                                                                      
      key_definition.lock_bits := 0;                                                                          
      key_definition.lock_id := task_identifier;                                                              
      #UNCHECKED_CONVERSION (key_definition, key_to_lock);                                                    
      key_for_lock := key_to_lock;                                                                            
    END;                                                                                                      
  FUNCEND key_for_lock;                                                                                       
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '  process_lock', EJECT ??                                                                     
  PROCEDURE process_lock (lock_function: nft$lock_functions;                                                  
        retry_limit: 0 .. 3600 {iterations};                                                                  
        retry_delay: 0 .. 60 {seconds};                                                                       
    VAR lock: INTEGER;                                                                                        
    VAR lock_status: nft$lock_status);                                                                        
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  PROCEDURE:                                                                  }                            
  {    PROCESS_LOCK (LOCK_FUNCTION, RETRY_LIMIT, RETRY_DELAY, LOCK, LOCK_STATUS) }                            
  {                                                                              }                            
  {  PURPOSE:                                                                    }                            
  {    The process_lock procedure performs interlock related functions. These    }                            
  {    functions are used to lock, unlock, and examine the interlocks for        }                            
  {    the shared segment directory and insures that only one task can have      }                            
  {    write access to a directory entry.                                        }                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    The NFC$LOCK function is used to interlock a directory entry for this     }                            
  {    task. If the directory entry is locked by another task, the task will     }                            
  {    wait for the specified delay time and attempt the lock function again     }                            
  {    until it has retied the specified number of times.                        }                            
  {                                                                              }                            
  {    The NFC$UNLOCK function is used to unlock a directory entry that has      }                            
  {    been previously locked by this task.                                      }                            
  {                                                                              }                            
  {    The NFC$EXAMINE function is used to test the lock status. It does         }                            
  {    not perform any locking or unlocking function. The retry delay can be     }                            
  {    used to cause a time delay between repeated nfc$examine calls. The        }                            
  {    retry limit has no meaning when examining locks.                          }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      old_lock_key: INTEGER,                                                                                  
      key_definition: nft$key_definition,                                                                     
      retry_count: INTEGER,                                                                                   
      wait_list: ^ost$i_wait_list,                                                                            
      ready_index: INTEGER,                                                                                   
      cs_status: 0 .. 2;                                                                                      
  ?? EJECT ??                                                                                                 
    BEGIN {process_lock}                                                                                      
                                                                                                              
      IF retry_delay > 0 THEN {build delay interval}                                                          
        PUSH wait_list: [1 .. 1];                                                                             
        wait_list^[1].activity := osc$i_await_time;                                                           
        wait_list^[1].milliseconds := retry_delay * nfc$millisecond;                                          
      ELSE {no wait required}                                                                                 
        wait_list := NIL;                                                                                     
      IFEND;                                                                                                  
                                                                                                              
      FOR retry_count := 0 TO retry_limit DO                                                                  
        CASE lock_function OF                                                                                 
          = nfc$lock =                                                                                        
            REPEAT                                                                                            
              #COMPARE_SWAP (lock, 0, key_for_lock(nfv$task_id), old_lock_key, cs_status);                    
            UNTIL cs_status <> osc$cs_variable_locked;                                                        
            IF (cs_status = osc$cs_successful) OR (key_for_lock(nfv$task_id) = old_lock_key) THEN             
              lock_status.condition := osc$sls_locked_by_current_task;                                        
              RETURN;                                                                                         
            IFEND;                                                                                            
            lock_status.condition := osc$sls_locked_by_another_task;                                          
            #UNCHECKED_CONVERSION (old_lock_key, key_definition);                                             
            lock_status.task_id := key_definition.lock_id;                                                    
                                                                                                              
          = nfc$unlock =                                                                                      
            REPEAT                                                                                            
              #COMPARE_SWAP (lock, key_for_lock(nfv$task_id), 0, old_lock_key, cs_status);                    
            UNTIL cs_status <> osc$cs_variable_locked;                                                        
            IF (cs_status = osc$cs_successful) OR (old_lock_key = 0) THEN                                     
              lock_status.condition := osc$sls_not_locked;                                                    
              RETURN;                                                                                         
            IFEND;                                                                                            
            lock_status.condition := osc$sls_locked_by_another_task;                                          
            #UNCHECKED_CONVERSION (old_lock_key, key_definition);                                             
            lock_status.task_id := key_definition.lock_id;                                                    
                                                                                                              
          = nfc$examine =                                                                                     
            REPEAT                                                                                            
              #COMPARE_SWAP (lock, 0, 0, old_lock_key, cs_status);                                            
            UNTIL cs_status <> osc$cs_variable_locked;                                                        
            IF cs_status = osc$cs_successful THEN                                                             
              lock_status.condition := osc$sls_not_locked;                                                    
            ELSEIF {NOT osc$cs_successful AND} old_lock_key = key_for_lock(nfv$task_id) THEN                  
              lock_status.condition := osc$sls_locked_by_current_task;                                        
            ELSE {NOT osc$cs_successful AND old_lock_key <> key_for_lock(nfv$task_id) THEN}                   
              lock_status.condition := osc$sls_locked_by_another_task;                                        
              #UNCHECKED_CONVERSION (old_lock_key, key_definition);                                           
              lock_status.task_id := key_definition.lock_id;                                                  
            IFEND;                                                                                            
                                                                                                              
        CASEND;                                                                                               
        IF (wait_list <> NIL) AND (retry_count <= retry_limit) THEN                                           
          osp$i_await_activity_completion (wait_list^, ready_index, nfv$ignore_status);                       
        IFEND;                                                                                                
      FOREND;                                                                                                 
    END;                                                                                                      
  PROCEND process_lock;                                                                                       
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  log_status_message', EJECT ??                                                             
  PROCEDURE log_status_message (status_for_log: ost$status;                                                   
    VAR status: ost$status);                                                                                  
    VAR                                                                                                       
      message: ost$status_message,                                                                            
      message_pointer: ^ost$status_message,                                                                   
      msg_line_count: ^ost$status_message_line_count,                                                         
      msg_line_size: ^ ost$status_message_line_size,                                                          
      msg_line_text: ^string (*),                                                                             
      i: 1 .. osc$max_status_message_lines,                                                                   
      ignore_status: ost$status;                                                                              
                                                                                                              
      osp$format_message (status_for_log, osc$full_message_level, 80,                                         
        message, ignore_status);                                                                              
      message_pointer := ^message;                                                                            
      RESET message_pointer;                                                                                  
      NEXT msg_line_count IN message_pointer;                                                                 
      FOR i := 1 to msg_line_count^ DO                                                                        
        NEXT msg_line_size IN message_pointer;                                                                
        NEXT msg_line_text: [msg_line_size^] IN message_pointer;                                              
        pmp$log (msg_line_text^, status);                                                                     
      FOREND;                                                                                                 
    PROCEND log_status_message;                                                                               
                                                                                                              
  ?? OLDTITLE ??                                                                                              
  ?? NEWTITLE := '  unlock_and_clean_up', EJECT ??                                                            
  PROCEDURE unlock_and_clean_up (condition: pmt$condition;                                                    
        condition_information: ^pmt$condition_information;                                                    
        save_area: ^ost$stack_frame_save_area;                                                                
    VAR status: ost$status);                                                                                  
  ?? SKIP := 2 ??                                                                                             
  {******************************************************************************}                            
  {                                                                              }                            
  {  PROCEDURE:                                                                  }                            
  {    UNLOCK_AND_CLEAN_UP (CONDITION, CONDITION_INFORMATION, SAVE_AREA, STATUS) }                            
  {                                                                              }                            
  {  PURPOSE:                                                                    }                            
  {    The unlock_and_clean_up procedure is the condition handler for            }                            
  {    nfm$common_task_communication.                                            }                            
  {                                                                              }                            
  {  DESCRIPTION:                                                                }                            
  {    For segment access, CYBIL run time, or interactive terminate break,       }                            
  {    all directory entries interlocked by this task will be unconditionally    }                            
  {    cleared and NFP$END_ASYNC_COMMUNICATION will be called. On all other      }                            
  {    conditions the interrupted procedure is allowed to complete.              }                            
  {                                                                              }                            
  {******************************************************************************}                            
  ?? SKIP := 2 ??                                                                                             
    VAR                                                                                                       
      dir_ordinal: nft$directory_ordinal,                                                                     
      end_async_communication: BOOLEAN,                                                                       
      ignore_status: ost$status,                                                                              
      local_status: ost$status,                                                                               
      lock_status: nft$lock_status,                                                                           
      queue_name: pmt$queue_name;                                                                             
  ?? SKIP := 4 ??                                                                                             
    BEGIN {unlock_and_clean_up}                                                                               
      pmp$log ('*** NFM$COMMON_TASK_COMMUNICATION Handler:', ignore_status);                                  
      osp$set_status_from_condition ('NF', condition, save_area, local_status, ignore_status);                
      log_status_message (local_status, ignore_status);                                                       
                                                                                                              
      status.normal := TRUE;                                                                                  
                                                                                                              
      CASE condition.selector OF                                                                              
                                                                                                              
        = pmc$user_defined_condition =                                                                        
          end_async_communication := condition.user_condition_name = cye$run_time_condition;                  
                                                                                                              
        = ifc$interactive_condition =                                                                         
          end_async_communication := condition.interactive_condition = ifc$terminate_break;                   
                                                                                                              
      ELSE {on all other conditions}                                                                          
        end_async_communication := TRUE;                                                                      
      CASEND;                                                                                                 
                                                                                                              
      IF NOT end_async_communication THEN                                                                     
        {resume processing} RETURN;                                                                           
      IFEND;                                                                                                  
                                                                                                              
      IF nfv$segment_initialized THEN {clear any locks associated with this task}                             
                                                                                                              
        empty_queue (nfv$ignore_status);                                                                      
        pmp$disconnect_queue (nfv$segment_directory^[nfv$dir_ord].queue_id, nfv$ignore_status);               
        generate_queue_name (nfv$task_id, queue_name);                                                        
        pmp$remove_queue (queue_name, nfv$ignore_status);                                                     
        clear_directory_entry (nfv$dir_ord);                                                                  
                                                                                                              
        FOR dir_ordinal := LOWERVALUE(dir_ordinal) TO UPPERVALUE(dir_ordinal) DO                              
          process_lock (nfc$unlock, 0, 0, nfv$segment_directory^[dir_ordinal].lock, lock_status);             
        FOREND;                                                                                               
                                                                                                              
        amp$close (nfv$segment_id, nfv$ignore_status);                                                        
        amp$return (nfv$segment_name, nfv$ignore_status);                                                     
        nfv$segment_initialized := FALSE;                                                                     
                                                                                                              
      IFEND;                                                                                                  
      pmp$continue_to_cause (pmc$execute_standard_procedure, status);                                         
    END;                                                                                                      
                                                                                                              
  PROCEND unlock_and_clean_up;                                                                                
?? OLDTITLE ??                                                                                                
?? OLDTITLE ??                                                                                                
MODEND nfm$common_task_communication;                                                                         
