?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Interactive Facility: Interfaces to emulate session' ??
MODULE iim$xt_xterm_interfaces;

{ PURPOSE:
{   This module provides interfaces to support X terminals.
{
{ DESIGN:
{   The Network Access Methods session layer is replaced by routines
{   in this module.  This module emulates the session layer for
{   communication with X terminals.
{   See Internal Design Specification DCS A9218.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??

?? PUSH (LISTEXT := ON) ??
*copyc ame$device_class_validation
*copyc ame$improper_file_id
*copyc amt$call_block
*copyc amt$fap_layer_number
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc amt$working_storage_length
*copyc bat$task_file_table
*copyc clc$standard_file_names
*copyc clt$parameter_list
*copyc clt$parameter_list_text
*copyc clt$parameter_list_text_size
*copyc fmt$system_file_label
*copyc fst$file_reference
*copyc ift$terminal_attributes
*copyc iit$vt_input_header
*copyc iit$vt_input_information
*copyc iic$xt_compiling_for_trace
*copyc iic$xt_job_catalog_name
*copyc iic$xt_max_message_length
*copyc iic$xt_status_catalog_name
*copyc iic$xt_xterm_catalog_name
*copyc iit$xt_message_control_block
*copyc iit$xt_message_header
*copyc iit$xt_message_file_reference
*copyc iit$xt_trace_options
*copyc iit$xt_xterm_status
*copyc jmt$timesharing_signal
*copyc jmt$system_job_parameters
*copyc nae$application_interfaces
*copyc nae$internal_interactive_appl
*copyc nat$await_data_available
*copyc nat$change_attributes
*copyc nat$data_length
*copyc nat$get_attributes
*copyc nat$connection_state
*copyc nat$se_receive_data_req
*copyc nat$se_send_data_req
*copyc nat$se_synchronize_req
*copyc nat$data_fragments
*copyc nat$wait_time
*copyc osc$timesharing_terminal_file
*copyc ost$activity_status
*copyc ost$caller_identifier
*copyc ost$status
*copyc ost$string
*copyc ost$user_identification
*copyc oss$job_paged_literal
*copyc osc$xterm_application_name
?? POP ??

*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$set_file_instance_abnormal
*copyc bap$validate_file_identifier
*copyc clp$convert_string_to_file
*copyc clp$convert_str_to_path_handle
*copyc clp$count_list_elements
*copyc clp$evaluate_sub_parameters
*copyc clp$define_initial_application
*copyc clp$get_date_string
*copyc clp$get_system_file_id
*copyc clp$get_time_string
*copyc clp$get_variable
*copyc clp$get_variable_value
*copyc clp$get_work_area
*copyc clp$include_file
*copyc clp$set_working_catalog
*copyc clp$trimmed_string_size
*copyc clp$update_connected_files
*copyc pfp$purge
*copyc pmp$get_account_project
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#current_sequence_position
*copyc i#move
*copyc iip$xt_create_network_file
*copyc jmp$is_xterm_job
*copyc jmp$logout
*copyc jmp$set_job_termination_status
*copyc jmp$submit_job
*copyc pfp$convert_string_to_fs_path
*copyc pfp$purge
*copyc pmp$execute
*copyc pmp$get_global_task_id
*copyc pmp$get_job_monitor_gtid
*copyc pmp$get_job_names
*copyc pmp$get_unique_name
*copyc pmp$wait
*copyc qfp$set_interactive_jrd_jad
*copyc qfp$set_terminal_name
*copyc rmp$request_terminal
*copyc osp$clear_job_signature_lock
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$get_status_condition_string
*copyc osp$i_await_activity_completion
*copyc osp$initialize_sig_lock
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc osp$test_sig_lock
*copyc pfp$define_catalog
*copyc pmp$continue_to_cause
*copyc pmp$get_executing_task_gtid
*copyc pmp$log
*copyc pmp$ready_task
*copyc pmp$send_signal
*copyc pmp$terminate

*copyc iiv$connection_desc_ptr
*copyc iiv$interactive_terminated
*copyc iiv$xt_xterm_control_block
*copyc iiv$xt_xterm_downline
*copyc iiv$xt_xterm_task_output
*copyc iiv$xt_xterm_upline
*copyc jmv$connection_acquired
*copyc jmv$executing_within_system_job
*copyc jmv$job_attributes
*copyc osv$task_private_heap
*copyc osv$task_shared_heap


?? TITLE := 'define_xterm_catalog', EJECT ??

  PROCEDURE define_xterm_catalog
    (VAR status: ost$status);

    VAR
      path: array [1 .. 3] of pft$name;

    path [pfc$family_name_index] := osc$null_name;
    path [pfc$master_catalog_name_index] := osc$null_name;
    path [pfc$subcatalog_name_index] := iic$xt_xterm_catalog_name;
    pfp$define_catalog (path, status);
    IF NOT status.normal AND (status.condition = pfe$name_already_subcatalog) THEN
      status.normal := TRUE;
    IFEND;

  PROCEND define_xterm_catalog;

?? TITLE := '[XDCL, #GATE] iip$xt_check_upline', EJECT ??

?? OLDTITLE, EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_check_upline
    (    file_identifier: amt$file_identifier;
     VAR activity_complete: boolean;
     VAR status: ost$status);

    VAR
      get_p: ^SEQ ( * ),
      global_task_id: ost$global_task_id,
      put_p: ^SEQ ( * ),
      sequence_p: ^SEQ ( * ),
      xt_message_control_block_p: ^iit$xt_message_control_block;

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

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        iip$xt_unlock_upline_messages (ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND condition_handler;

    status.normal := TRUE;
    activity_complete := FALSE;
    sequence_p := iiv$xt_xterm_upline.segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT xt_message_control_block_p IN sequence_p;
    get_p := #PTR (xt_message_control_block_p^.get_p, sequence_p^);
    put_p := #PTR (xt_message_control_block_p^.put_p, sequence_p^);

    IF ((i#current_sequence_position (put_p) > i#current_sequence_position (get_p)) AND
          (xt_message_control_block_p^.terminate_option = iic$xt_terminate_record)) THEN
      activity_complete := TRUE;
      ?IF iic$xt_compiling_for_trace THEN
        iip$xt_write_trace (' Exit iip$xt_check_upline - activity complete upline');
      ?IFEND;
    ELSE { Activity is not complete.
      IF iiv$xt_xterm_control_block.status.complete THEN

{ Xterm task has completed.  Terminate job.

        pmp$get_executing_task_gtid (global_task_id);
        send_disconnect_signal (global_task_id);
      IFEND;

      osp$establish_condition_handler (^condition_handler, TRUE);

{ Xterm task and user task may modify upline messages.

      iip$xt_lock_upline_messages ({ignore status} status);
      IF iiv$xt_xterm_control_block.upline_state = iic$xt_inactive THEN

{ When xterm task sends some data on upline, ready this task.

        pmp$get_executing_task_gtid (global_task_id);
        iiv$xt_xterm_control_block.upline_global_task_id := global_task_id;
        iiv$xt_xterm_control_block.upline_state := iic$xt_wait_for_data;
      IFEND;
      iip$xt_unlock_upline_messages ({ignore status} status);
      osp$disestablish_cond_handler;

{ User or job monitor task is waiting for xterm task to complete some work so
{ ready xterm task.

      IF iiv$xt_xterm_control_block.xterm_state >= iic$execute_xterm_task THEN
        pmp$ready_task (iiv$xt_xterm_control_block.xterm_global_task_id, status);
        IF NOT status.normal THEN
          pmp$get_executing_task_gtid (global_task_id);
          send_disconnect_signal (global_task_id);
        IFEND;
      IFEND;
    IFEND;

  PROCEND iip$xt_check_upline;

?? TITLE := '[XDCL, #GATE] iip$xt_close_file', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_close_file
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    VAR
      file_instance: ^bat$task_file_entry,
      file_is_valid: boolean;

    status.normal := TRUE;
    bap$validate_file_identifier (file_identifier, file_instance, file_is_valid);
    IF NOT file_is_valid THEN
      osp$set_status_condition (ame$improper_file_id, status);
      RETURN;
    IFEND;

    IF file_instance^.eoi_message <> NIL THEN
      FREE file_instance^.eoi_message IN osv$task_private_heap^;
    IFEND;

  PROCEND iip$xt_close_file;

?? TITLE := '[XDCL, #GATE] iip$xt_create_message_file', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_create_message_file
    (    file_reference: fst$file_reference;
     VAR file_identifier: amt$file_identifier;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      file_cycle_attribute: array [1 .. 1] of fst$file_cycle_attribute,
      get_p: ^SEQ ( * ),
      length: integer,
      message_control_block_p: ^iit$xt_message_control_block,
      remaining_sequence_length: integer,
      sequence_p: ^SEQ ( * );

    status.normal := TRUE;

{ Create segment used to pass information to xterm task.

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    file_cycle_attribute [1].selector := fsc$ring_attributes;
    file_cycle_attribute [1].ring_attributes.r1 := 4;
    file_cycle_attribute [1].ring_attributes.r2 := 4;
    file_cycle_attribute [1].ring_attributes.r3 := 13;
    fsp$open_file (file_reference, amc$segment, {attachment options=} ^attachment_option,
          {default creation attributes=} ^file_cycle_attribute, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    sequence_p := segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT message_control_block_p IN sequence_p;
    message_control_block_p^.count := 0;
    message_control_block_p^.global_task_id_defined := FALSE;
    message_control_block_p^.record_position := iic$xt_end_of_record;
    message_control_block_p^.status := iic$xt_file_created;
    message_control_block_p^.terminate_option := iic$xt_terminate_record;
    remaining_sequence_length := #SIZE (sequence_p^) - i#current_sequence_position (sequence_p);
    NEXT get_p: [[REP remaining_sequence_length OF cell]] IN sequence_p;
    RESET get_p;
    message_control_block_p^.get_p := #REL (get_p, sequence_p^);
    message_control_block_p^.put_p := message_control_block_p^.get_p;

  PROCEND iip$xt_create_message_file;

?? TITLE := '[XDCL, #GATE] iip$xt_create_xterm_files', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_create_xterm_files
    (VAR status: ost$status);

    VAR
      length: integer,
      message_file_name: iit$xt_message_file_reference,
      null_attribute: [STATIC, READ, oss$job_paged_literal] array
            [1 .. 1] of ift$connection_attribute := [[ifc$null_connection_attribute]],
      unique_name: ost$name;

    iip$xt_create_network_file (status);
    IF NOT status.normal THEN
      ?IF iic$xt_compiling_for_trace THEN
        iip$xt_write_trace_status (' fmp$create_network_file failed', status);
      ?IFEND;
      RETURN;
    IFEND;

{ Create downline file for sending messages to xterm task.

    iiv$xt_xterm_control_block.downline_file_reference := '$local.';
    pmp$get_unique_name (unique_name, {ignore} status);
    iiv$xt_xterm_control_block.downline_file_reference (8, * ) := unique_name;
    iip$xt_create_message_file (iiv$xt_xterm_control_block.downline_file_reference,
          iiv$xt_xterm_downline.file_identifier, iiv$xt_xterm_downline.segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    iiv$xt_xterm_downline.opened := TRUE;
    osp$initialize_sig_lock (iiv$xt_xterm_control_block.downline_lock);

{ Create upline file for xterm task to send to operating system.

    iiv$xt_xterm_control_block.upline_file_reference := '$local.';
    pmp$get_unique_name (unique_name, {ignore} status);
    iiv$xt_xterm_control_block.upline_file_reference (8, * ) := unique_name;
    iip$xt_create_message_file (iiv$xt_xterm_control_block.upline_file_reference,
          iiv$xt_xterm_upline.file_identifier, iiv$xt_xterm_upline.segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    iiv$xt_xterm_upline.opened := TRUE;
    osp$initialize_sig_lock (iiv$xt_xterm_control_block.upline_lock);

    qfp$set_terminal_name (osc$null_name);

{ Request terminal for standard job files.

    rmp$request_terminal (clc$job_command_input, NIL, null_attribute, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rmp$request_terminal (clc$job_input, NIL, null_attribute, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rmp$request_terminal (clc$job_output, NIL, null_attribute, status);

  PROCEND iip$xt_create_xterm_files;

?? TITLE := '[XDCL, #GATE] iip$xt_execute_xterm_command', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_execute_xterm_command
    (VAR status: ost$status);

    CONST
      xterm_status_wait_time = 2*1000, {2 seconds.
      xterm_wait_time = 1000;

    VAR
      activity_status_p: ^ost$activity_status,
      attachment_option: array [1 .. 3] of fst$attachment_option,
      file_identifier: amt$file_identifier,
      file_reference: string ({$user.} 6 + {xterm catalog name} 31 + {.} 1 +
            {status catalog name} 31 + {.} 1 + {system_supplied_name} 31),
      file_reference_length: integer,
      file_status: ost$status,
      i_activity: array [1 .. 2] of ost$i_activity,
      ready_index: integer,
      segment_pointer: amt$segment_pointer,
      sequence_p: ^SEQ ( * ),
      system_supplied_name: jmt$system_supplied_name,
      times: 1 .. 5,
      user_supplied_name: jmt$user_supplied_name,
      xterm_status_p: ^iit$xt_xterm_status;

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        iip$xt_unlock_upline_messages (ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND condition_handler;

    status.normal := TRUE;
    i_activity [1].activity := osc$i_await_time;
    i_activity [1].milliseconds := xterm_wait_time;
    i_activity [2].activity := osc$i_await_unspecified_event;
    osp$establish_condition_handler (^condition_handler, TRUE);

{ Wait for xterm task to send an upline message indicating that xterm is
{ ready to start executing commands. The terminal user may specify the
{ initial command through the xterm -e option.

    WHILE ((iiv$xt_xterm_control_block.xterm_state < iic$execute_initial_command) AND status.normal) DO
      pmp$ready_task (iiv$xt_xterm_control_block.xterm_global_task_id, status);
      IF status.normal THEN
        osp$i_await_activity_completion (i_activity, ready_index, status);
      IFEND;
      IF status.normal THEN
        iip$xt_lock_upline_messages ({ignore} status);
        process_upline_command;
        iip$xt_unlock_upline_messages ({ignore} status);
        status.normal := TRUE;
      IFEND;
    WHILEND;

    osp$disestablish_cond_handler;

{ Tell xterm origin job xterm has finished startup.  The xterm job communicates with
{ the origin job via a segment access file.

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [3].selector := fsc$create_file;
    attachment_option [3].create_file := FALSE;
    pmp$get_job_names (user_supplied_name, system_supplied_name, file_status);
    IF NOT file_status.normal THEN
      RETURN;
    IFEND;
    STRINGREP (file_reference, file_reference_length, '$USER.',iic$xt_xterm_catalog_name,
          '.', iic$xt_status_catalog_name, '.', system_supplied_name);

{ Job starting xterm creates a $USER.$XTERM.$STATUS.system_supplied_name file.
{ Wait some time for this file to appear.  A number of factors may prevent the
{ creation of the file.  Continue if the file does not exist after a
{ period of time.

   /wait_for_status_file/
    FOR times := LOWERVALUE (times) TO UPPERVALUE (times) DO
      fsp$open_file (file_reference (1, file_reference_length), amc$segment,
            {attachment options=} ^attachment_option,
            {default creation attributes=} NIL, {mandated creation attributes=} NIL,
            {attribute validation=} NIL, {attribute override=} NIL, file_identifier, file_status);
      IF file_status.normal THEN
        EXIT /wait_for_status_file/;
      IFEND;
      IF ((file_status.condition = pfe$unknown_nth_subcatalog) OR
            (file_status.condition = pfe$unknown_permanent_file)) THEN
        pmp$wait (xterm_status_wait_time, xterm_status_wait_time);
      ELSE
        EXIT /wait_for_status_file/;
      IFEND;
    FOREND /wait_for_status_file/;

    IF NOT file_status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, file_status);
    IF NOT file_status.normal THEN
      fsp$close_file (file_identifier, {ignore} file_status);
      RETURN;
    IFEND;

{ Set activity status complete and ready task of the job submitting xterm.
{ This causes the job submitting xterm to come out of wait and process
{ any errors recorded in the $XTERM.$JOBS.SYSTEM_SUPPLIED_NAME file.

    sequence_p := segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT xterm_status_p IN sequence_p;
    xterm_status_p^.activity_status.complete := TRUE;
    xterm_status_p^.activity_status.status := status;
    pmp$ready_task (xterm_status_p^.global_task_id, {ignore} file_status);
    fsp$close_file (file_identifier, {ignore} file_status);

  PROCEND iip$xt_execute_xterm_command;

?? TITLE := '[XDCL, #GATE] iip$xt_get_terminal_attributes', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_get_terminal_attributes
    (    file_name: amt$local_file_name;
     VAR terminal_attributes: ift$terminal_attributes;
     VAR status: ost$status);

    VAR
      attribute_index: integer;

    status.normal := TRUE;

{ Provide default attributes for C to start up a program.

    FOR attribute_index := LOWERBOUND (terminal_attributes) TO UPPERBOUND (terminal_attributes) DO
      CASE terminal_attributes [attribute_index].key OF

      = ifc$backspace_character =
        terminal_attributes [attribute_index].backspace_character := $CHAR (8);

{Backspace

      = ifc$cancel_line_character =
        terminal_attributes [attribute_index].cancel_line_character := $CHAR (24); {Cancel}

      = ifc$character_flow_control =
        terminal_attributes [attribute_index].character_flow_control := TRUE;

      = ifc$echoplex =
        terminal_attributes [attribute_index].echoplex := FALSE;

      = ifc$hold_page =
        terminal_attributes [attribute_index].hold_page := TRUE;

      = ifc$parity =
        terminal_attributes [attribute_index].parity := ifc$no_parity;

      ELSE
      CASEND;

    FOREND;

  PROCEND iip$xt_get_terminal_attributes;


?? TITLE := 'iip$xt_fetch_attributes', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_fetch_attributes
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    VAR
      attribute_index: integer,
      file_is_valid: boolean,
      file_instance: ^bat$task_file_entry;

    status.normal := TRUE;
    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_fetch_attributes');
    ?IFEND;

    bap$validate_file_identifier (file_identifier, file_instance, file_is_valid);
    IF NOT file_is_valid THEN
      osp$set_status_condition (ame$improper_file_id, status);
      RETURN;
    IFEND;

    IF call_block.fetch_attributes <> NIL THEN

    /attribute_loop/
      FOR attribute_index := LOWERBOUND (call_block.fetch_attributes^)
            TO UPPERBOUND (call_block.fetch_attributes^) DO
        CASE call_block.fetch_attributes^ [attribute_index].kind OF
        = nac$client_identity =

        = nac$connect_data =
          call_block.fetch_attributes^ [attribute_index].connect_data_length := 0;

        = nac$connection_state =

        = nac$data_transfer_timeout =
          call_block.fetch_attributes^ [attribute_index].data_transfer_timeout :=
                file_instance^.data_transfer_timeout;
        = nac$eoi_message =
          IF file_instance^.eoi_message <> NIL THEN
            call_block.fetch_attributes^ [attribute_index].eoi_message := file_instance^.eoi_message^;
          ELSE

{call_block.fetch_attributes^ [attribute_index].eoi_message := nav$eoi_message;

          IFEND;
        = nac$eoi_message_enabled =
          call_block.fetch_attributes^ [attribute_index].eoi_message_enabled :=
                file_instance^.eoi_message_enabled;
        = nac$eoi_peer_termination =
          call_block.fetch_attributes^ [attribute_index].eoi_peer_termination :=
                file_instance^.eoi_peer_termination;
        = nac$local_address =
        = nac$null_attribute =
        = nac$optimum_transfer_unit_incr =
        = nac$optimum_transfer_unit_size =
        = nac$peer_accounting_information =
          call_block.fetch_attributes^ [attribute_index].peer_accounting_info_length := 0;
        = nac$peer_address =
        = nac$peer_connect_data =
          call_block.fetch_attributes^ [attribute_index].peer_connect_data_length := 0;
        = nac$peer_termination_data =
          call_block.fetch_attributes^ [attribute_index].peer_termination_data_length := 0;
        = nac$protocol =
        = nac$receive_wait_swapout =
        = nac$termination_data =
          call_block.fetch_attributes^ [attribute_index].termination_data_length := 0;
        = nac$termination_reason =
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$unknown_attribute, ' on FETCH_ATTRIBUTES ', status);
        CASEND;
        IF NOT status.normal THEN
          EXIT /attribute_loop/;
        IFEND;
      FOREND /attribute_loop/;
    IFEND;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_fetch_attributes');
    ?IFEND;

  PROCEND iip$xt_fetch_attributes;

?? TITLE := '[XDCL, #GATE] iip$xt_initialize_xterm', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_initialize_xterm
    (VAR status: ost$status);

{ PROCEDURE initialize_xterm (
{   options, o: string 0..256 = $optional
{   trace: (BY_NAME) list of key
{       pc, dm, um
{     keyend = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 4] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 3] of clt$keyword_specification,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 3, 19, 14, 57, 59, 302],
    clc$command, 4, 3, 0, 0, 0, 0, 3, ''], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OPTIONS                        ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['TRACE                          ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 134,
  clc$optional_parameter, 0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, 256, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [118, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [3], [
      ['DM                             ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['PC                             ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['UM                             ', clc$nominal_entry, clc$normal_usage_entry, 3]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$options = 1,
      p$trace = 2,
      p$status = 3;

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

    CONST
      user_xterm_prolog = '$USER.$XTERM.PROLOG';

    VAR
      access_creation_selections: [STATIC, READ, oss$job_paged_literal] array [1 .. 1] of
            fst$file_cycle_attribute := [[fsc$file_contents_and_processor, amc$list, osc$null_name]],
      access_selections: [STATIC, READ, oss$job_paged_literal] array
            [1 .. 1] of fst$attachment_option := [[fsc$access_and_share_modes,
            [fsc$specific_access_modes, [fsc$read, fsc$append, fsc$modify]], [fsc$required_share_modes]]],
      caller_identifier: ost$caller_identifier,
      connection_id: nat$connection_id,
      data_value_p: ^clt$data_value,
      evaluated_file_reference: fst$evaluated_file_reference,
      file: clt$file,
      ignore_status: ost$status,
      list: clt$list_size,
      list_size: clt$list_size,
      network_file_name: ost$name,
      next_data_value_p: ^clt$data_value,
      null_parameters: string (40),
      object_files_p: ^pmt$object_file_list,
      parameters: string (31),
      parameters_p: ^record
        size: clt$parameter_list_text_size,
        value: clt$parameter_list_text,
      recend,
      program_parameters_p: ^pmt$program_parameters,
      program_attributes_p: ^pmt$program_attributes,
      program_descriptor_p: ^SEQ ( * ),
      task_id: pmt$task_id,
      task_status: pmt$task_status,
      term_conn_attributes: array [1 .. 7] of ift$connection_attribute,
      terminal_attributes: [STATIC, READ, oss$job_paged_literal] array [1 .. 7] of
            ift$connection_attribute := [[ifc$input_editing_mode, ifc$normal_edit], [ifc$input_timeout, TRUE],
            [ifc$input_timeout_length, 0], [ifc$input_timeout_purge, TRUE],
            [ifc$partial_char_forwarding, FALSE], [ifc$prompt_string, [1, ',']], * ],
      terminal_file_name: ost$name,
      work_area_p_p: ^^clt$work_area;

{ Process xterm parameters.

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

    clp$evaluate_sub_parameters (jmv$job_attributes.system_job_parameters.system_job_parameter, #SEQ (pdt),
          work_area_p_p^, ^pvt, status);
    IF NOT status.normal THEN
      RETURN
    IFEND;

    iiv$xt_xterm_control_block.trace_set := $iit$xt_trace_set [];
    IF pvt [p$trace].specified THEN
      list_size := clp$count_list_elements (pvt [p$trace].value);
      next_data_value_p := pvt [p$trace].value;

    /get_next_key/
      FOR list := 1 TO list_size DO
        IF next_data_value_p^.element_value^.keyword_value = 'PC' THEN
          iiv$xt_xterm_control_block.trace_set := iiv$xt_xterm_control_block.trace_set +
                $iit$xt_trace_set [iic$xt_trace_procedures];
        ELSEIF next_data_value_p^.element_value^.keyword_value = 'UPLINE_MESSAGES' THEN
          iiv$xt_xterm_control_block.trace_set := iiv$xt_xterm_control_block.trace_set +
                $iit$xt_trace_set [iic$xt_trace_upline_messages];
        ELSEIF next_data_value_p^.element_value^.keyword_value = 'UM' THEN
          iiv$xt_xterm_control_block.trace_set := iiv$xt_xterm_control_block.trace_set +
                $iit$xt_trace_set [iic$xt_trace_upline_messages];
        ELSEIF next_data_value_p^.element_value^.keyword_value = 'DOWNLINE_MESSAGES' THEN
          iiv$xt_xterm_control_block.trace_set := iiv$xt_xterm_control_block.trace_set +
                $iit$xt_trace_set [iic$xt_trace_downline_messages];
        ELSEIF next_data_value_p^.element_value^.keyword_value = 'DM' THEN
          iiv$xt_xterm_control_block.trace_set := iiv$xt_xterm_control_block.trace_set +
                $iit$xt_trace_set [iic$xt_trace_downline_messages];
        IFEND;
        next_data_value_p := next_data_value_p^.link;
      FOREND /get_next_key/;
    IFEND;

{ Process commands that must execute before starting xterm task.

    clp$include_file (user_xterm_prolog, '', osc$null_name, status);
    IF NOT status.normal THEN
      status.normal := TRUE;
    IFEND;
    iiv$xt_xterm_control_block.xterm_state := iic$ran_prolog;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (jmv$job_attributes.system_job_parameters.system_job_parameter);
    ?IFEND;

{ Start xterm task.

    PUSH program_descriptor_p: [[REP (#SIZE (pmt$program_attributes) + #SIZE (amt$local_file_name)) OF cell]];
    RESET program_descriptor_p;
    NEXT program_attributes_p IN program_descriptor_p;
    program_attributes_p^.contents := $pmt$prog_description_contents
          [pmc$object_file_list_specified, pmc$preset_specified];
    program_attributes_p^.number_of_modules := 0;
    program_attributes_p^.number_of_libraries := 0;
    program_attributes_p^.number_of_object_files := 1;
    program_attributes_p^.preset := pmc$initialize_to_zero;
    NEXT object_files_p: [1 .. 1] IN program_descriptor_p;

    clp$get_variable_value ('XWF$XTERM_LIBRARY', data_value_p, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

    clp$convert_string_to_file (data_value_p^.file_value^, file, ignore_status);
    object_files_p^ [1] := file.local_file_name;
    IF pvt [p$options].specified THEN
      PUSH parameters_p: [STRLENGTH (pvt [p$options].value^.string_value^)];
      parameters_p^.size := STRLENGTH (pvt [p$options].value^.string_value^);
      parameters_p^.value := pvt [p$options].value^.string_value^;
    ELSE
      PUSH parameters_p: [0];
      parameters_p^.size := 0;
      parameters_p^.value := '';
    IFEND;

{ The xterm task expects to run with in $USER catalog.

    clp$set_working_catalog ('$USER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Call execute xterm');
    ?IFEND;

    pmp$execute (program_descriptor_p^, #SEQ (parameters_p^) ^, osc$nowait,
          iiv$xt_xterm_control_block.task.id, iiv$xt_xterm_control_block.status, status);
    clp$set_working_catalog ('$LOCAL', ignore_status);
    IF NOT status.normal THEN
      ?IF iic$xt_compiling_for_trace THEN
        iip$xt_write_trace_status (' Xterm execute failed', status);
      ?IFEND;
      RETURN;
    IFEND;

    iiv$xt_xterm_control_block.xterm_state := iic$execute_xterm_task;
    iiv$xt_xterm_control_block.task.exists := TRUE;
    pmp$get_global_task_id (iiv$xt_xterm_control_block.task.id,
          iiv$xt_xterm_control_block.xterm_global_task_id, {ignore} status);

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_initialize_xterm');
    ?IFEND;

  PROCEND iip$xt_initialize_xterm;

?? TITLE := '[XDCL, #GATE] iip$xt_is_xterm_file', EJECT ??

  FUNCTION [XDCL, #GATE] iip$xt_is_xterm_file
    (    system_file_label_p: ^fmt$system_file_label): boolean;

    iip$xt_is_xterm_file := jmp$is_xterm_job () AND
         (system_file_label_p^.descriptive_label.application_info_source = amc$local_file_information) AND
         (system_file_label_p^.descriptive_label.application_info = osc$timesharing_terminal_file);

  FUNCEND iip$xt_is_xterm_file;

?? TITLE := '[XDCL, #GATE] iip$xt_lock_downline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_lock_downline_messages
    (VAR status: ost$status);

    status.normal := TRUE;
    osp$set_job_signature_lock (iiv$xt_xterm_control_block.downline_lock);

  PROCEND iip$xt_lock_downline_messages;

?? TITLE := '[XDCL, #GATE] iip$xt_lock_upline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_lock_upline_messages
    (VAR status: ost$status);

    status.normal := TRUE;
    osp$set_job_signature_lock (iiv$xt_xterm_control_block.upline_lock);

  PROCEND iip$xt_lock_upline_messages;

?? TITLE := '[XDCL, #GATE] iip$xt_open_file', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_open_file
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_instance: ^bat$task_file_entry,
      file_is_valid: boolean;

    status.normal := TRUE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_open_file');
    ?IFEND;

    bap$validate_file_identifier (file_identifier, file_instance, file_is_valid);
    IF NOT file_is_valid THEN
      osp$set_status_condition (ame$improper_file_id, status);
      RETURN;
    IFEND;

    file_instance^.sender_active := FALSE;
    file_instance^.receiver_active := FALSE;
    file_instance^.eoi_message := NIL;
    file_instance^.eoi_message_enabled := FALSE;
    file_instance^.data_transfer_timeout := 60000;
    file_instance^.eoi_peer_termination := FALSE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_open_file');
    ?IFEND;

  PROCEND iip$xt_open_file;

?? TITLE := '[XDCL, #GATE] iip$xt_open_downline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_open_downline_messages
    (VAR file_identifier: amt$file_identifier;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    iip$xt_open_message_file (iiv$xt_xterm_control_block.downline_file_reference, file_identifier,
          segment_pointer, status);

  PROCEND iip$xt_open_downline_messages;

?? TITLE := 'iip$xt_open_message_file', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_open_message_file
    (    file_reference: fst$file_reference;
     VAR file_identifier: amt$file_identifier;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      file_cycle_attribute: array [1 .. 1] of fst$file_cycle_attribute;

    status.normal := TRUE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_open_message_file');
    ?IFEND;

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];

    file_cycle_attribute [1].selector := fsc$ring_attributes;
    file_cycle_attribute [1].ring_attributes.r1 := 4;
    file_cycle_attribute [1].ring_attributes.r2 := 4;
    file_cycle_attribute [1].ring_attributes.r3 := 13;

    fsp$open_file (file_reference, amc$segment, {attachment options=} ^attachment_option,
          {default creation attributes=} ^file_cycle_attribute, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, file_identifier, status);
    IF NOT status.normal THEN
      ?IF iic$xt_compiling_for_trace THEN
        iip$xt_write_trace_status (' iip$xt_open_message_file', status);
      ?IFEND;
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_open_message_file');
    ?IFEND;

  PROCEND iip$xt_open_message_file;

?? TITLE := '[XDCL, #GATE] iip$xt_open_upline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_open_upline_messages
    (VAR file_identifier: amt$file_identifier;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    iip$xt_open_message_file (iiv$xt_xterm_control_block.upline_file_reference, file_identifier,
          segment_pointer, status);

  PROCEND iip$xt_open_upline_messages;


?? TITLE := '[XDCL, #GATE] iip$xt_ready_task', EJECT ??



  PROCEDURE [XDCL, #GATE] iip$xt_ready_task
    (VAR status: ost$status);

    VAR
      global_task_id: ost$global_task_id;

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

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        iip$xt_unlock_upline_messages (ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    osp$establish_condition_handler (^condition_handler, TRUE);

{ Xterm task and user task may modify upline messages.

    iip$xt_lock_upline_messages ({ignore status} status);
    IF iiv$xt_xterm_control_block.upline_state = iic$xt_wait_for_data THEN
      pmp$ready_task (iiv$xt_xterm_control_block.upline_global_task_id, status);
      iiv$xt_xterm_control_block.upline_state := iic$xt_inactive;
    IFEND;
    iip$xt_unlock_upline_messages ({ignore status} status);
    status.normal := TRUE;
    osp$disestablish_cond_handler;

  PROCEND iip$xt_ready_task;

?? TITLE := '[XDCL, #GATE] iip$xt_receive_data', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_receive_data
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
         start_time: integer;
     VAR request_started: boolean;
     VAR wait_time: nat$wait_time;
     VAR activity_status: ^ost$activity_status;
     VAR status: ost$status);

    VAR
      command_line_p: ^clt$command_line,
      data_fragments_p: ^nat$data_fragments,
      data_length: integer,
      data_p: ^SEQ ( * ),
      get_p: ^SEQ ( * ),
      put_p: ^SEQ ( * ),
      message_length: integer,
      sequence_p: ^SEQ ( * ),
      vt_input_header_p: ^iit$vt_input_header,
      xt_message_header_p: ^iit$xt_message_header,
      xt_message_control_block_p: ^iit$xt_message_control_block;

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        iip$xt_unlock_downline_messages (ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND condition_handler;

    PROCEDURE move_data_fragments;

      VAR
        current_data_offset: integer,
        current_fragment_capacity: nat$data_length,
        data_cell_p: ^cell,
        data_offset: integer,
        data_ring: integer,
        data_segment: integer,
        data_start: integer,

{ This declaration exists solely to develop the address for the i#move which
{ moves data from
{ the container to the user's address space.

        fragment_array_p: ^array [1 .. 0ffffff(16)] of cell,
        fragment: nat$data_length,
        fragment_data_start: integer,
        fragment_index: integer,
        fragment_length: integer,
        remaining_data: integer;

      status.normal := TRUE;
      fragment_length := 0;
      data_length := 0;
      data_ring := #RING (data_p);
      data_segment := #SEGMENT (data_p);
      data_offset := #OFFSET (data_p);
      data_cell_p := #ADDRESS (data_ring, data_segment, data_offset);

    /get_total_data_area_length/
      FOR fragment_index := 1 TO UPPERBOUND (data_fragments_p^) DO
        IF (data_fragments_p^ [fragment_index].length > 0) AND
              (data_fragments_p^ [fragment_index].address <> NIL) THEN
          IF fragment_length = 0 THEN
            fragment := fragment_index; { First non empty fragment.
            current_fragment_capacity := data_fragments_p^ [fragment_index].length;
          IFEND;
          fragment_length := fragment_length + data_fragments_p^ [fragment_index].length;
        IFEND;
      FOREND /get_total_data_area_length/;

      IF message_length <= fragment_length THEN
        IF message_length > 0 THEN

{ The whole message is contained in one buffer.  It fits into the first
{ fragment.

          IF current_fragment_capacity >= message_length THEN
            data_length := message_length;
            fragment_array_p := data_fragments_p^ [fragment].address;
            i#move (data_cell_p, ^fragment_array_p^ [1], message_length);
          ELSE
            data_start := 0;
            fragment_data_start := 0;
            remaining_data := message_length;

          /flush_message/
            WHILE data_length < message_length DO

{ Find next non empty fragment if current is empty.

              WHILE current_fragment_capacity = 0 DO
                fragment := fragment + 1;
                IF (data_fragments_p^ [fragment].length > 0) AND (data_fragments_p^ [fragment].address <>
                      NIL) THEN
                  current_fragment_capacity := data_fragments_p^ [fragment].length;
                  fragment_data_start := 0;
                IFEND;
              WHILEND;

              fragment_array_p := data_fragments_p^ [fragment].address;

{ Fill the current fragment.

              IF remaining_data >= current_fragment_capacity THEN
                current_data_offset := data_offset + data_start;
                data_cell_p := #ADDRESS (data_ring, data_segment, current_data_offset);
                i#move (data_cell_p, ^fragment_array_p^ [1 + fragment_data_start], current_fragment_capacity);
                data_length := data_length + current_fragment_capacity;
                remaining_data := remaining_data - current_fragment_capacity;
                data_start := data_start + current_fragment_capacity;
                current_fragment_capacity := 0;

              ELSE { Partially fill current fragment with remainder of current

{ container.

                current_data_offset := data_offset + data_start;
                fragment_array_p := data_fragments_p^ [fragment].address;
                data_cell_p := #ADDRESS (data_ring, data_segment, current_data_offset);
                i#move (data_cell_p, ^fragment_array_p^ [1 + fragment_data_start], remaining_data);
                data_length := data_length + remaining_data;
                current_fragment_capacity := current_fragment_capacity - remaining_data;
                fragment_data_start := fragment_data_start + remaining_data;
                remaining_data := 0;
              IFEND;
            WHILEND /flush_message/;
          IFEND;
        IFEND;
      ELSE { Data area too small.

{ osp$set_status_condition (nae$data_area_too_small, status);

      IFEND;
    PROCEND move_data_fragments;

    status.normal := TRUE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_receive_data');
    ?IFEND;

    activity_status^.status.normal := TRUE;
    activity_status^.complete := FALSE;
    request_started := FALSE;
    osp$establish_condition_handler (^condition_handler, TRUE);

{ Xterm task and user task may modify upline messages.

    iip$xt_lock_upline_messages ({ignore} status);
    status.normal := TRUE;
    IF iiv$xt_xterm_control_block.xterm_state < iic$execute_initial_command THEN
      process_upline_command;
    IFEND;
    sequence_p := iiv$xt_xterm_upline.segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT xt_message_control_block_p IN sequence_p;
    get_p := #PTR (xt_message_control_block_p^.get_p, sequence_p^);
    put_p := #PTR (xt_message_control_block_p^.put_p, sequence_p^);
    IF ((i#current_sequence_position (put_p) > i#current_sequence_position (get_p)) AND
          (xt_message_control_block_p^.terminate_option = iic$xt_terminate_record)) THEN
      NEXT xt_message_header_p IN get_p;
      message_length := xt_message_header_p^.xt_message_size;
      NEXT data_p: [[REP message_length OF cell]] IN get_p;
      xt_message_control_block_p^.get_p := #REL (get_p, sequence_p^);

      IF call_block.operation = nac$se_receive_data_req THEN
        data_fragments_p := call_block.se_receive_data_req.buffer;
        move_data_fragments;
        call_block.se_receive_data_req.peer_operation^.kind := nac$se_send_data;
        call_block.se_receive_data_req.peer_operation^.end_of_message := TRUE;
        call_block.se_receive_data_req.peer_operation^.qualified_data := FALSE;
        call_block.se_receive_data_req.peer_operation^.data_length := data_length;
        request_started := TRUE;
        activity_status^.complete := TRUE;
      ELSE
        ?IF iic$xt_compiling_for_trace THEN
          iip$xt_write_trace (' Unexpected iip$xt_receive_data call block operation');
        ?IFEND;
      IFEND;
    IFEND;

    iip$xt_unlock_upline_messages ({ignore} status);
    status.normal := TRUE;
    osp$disestablish_cond_handler;

  PROCEND iip$xt_receive_data;

?? TITLE := '[XDCL, #GATE] iip$xt_redirect_xterm_output', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_redirect_xterm_output
    (    working_storage_area: ^cell;
         working_storage_length: amt$working_storage_length;
     VAR status: ost$status);

    VAR
      format_effector: char,
      working_storage_array_pointer: ^array [0 .. iic$max_record_length] of char;

?? NEWTITLE := 'write_xterm_output', EJECT ??

    PROCEDURE write_xterm_output;

      CONST
        close_message = ':  fatal IO error 104';

      VAR
        character_index: 0 .. iic$xt_max_message_length,
        date_string: ost$string,
        edited_string: string (iic$xt_max_message_length),
        edited_length: 0 .. iic$xt_max_message_length,
        fba: amt$file_byte_address,
        file_identifier: amt$file_identifier,
        time_string: ost$string,
        working_length: integer,
        working_storage_p: ^string ( * ),
        working_string: string (iic$xt_max_message_length);

      working_storage_p := ^iiv$xt_xterm_task_output.text_p^ (1, iiv$xt_xterm_task_output.position);
      edited_length := 1;
      edited_string (1) := ' ';

{ If the terminal user uses the close menu, xterm drops with a fatal IO error 104.
{ This error means xterm attempted output on a socket that is no longer open.
{ If this error occurs, shutdown should be considered normal.
{ Do not write anything to the trace file.

      FOR character_index := 1 TO STRLENGTH (working_storage_p^) DO
        edited_length := edited_length + 1;
        edited_string (edited_length, 1) := working_storage_p^ (character_index, 1);
        IF working_storage_p^ (character_index, 1) = ':' THEN
          IF STRLENGTH (working_storage_p^ (character_index, * )) >= STRLENGTH (close_message) THEN
            IF working_storage_p^ (character_index, STRLENGTH (close_message)) = close_message THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      FOREND;

      open_trace_file (file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$get_date_string (date_string, {ignore} status);
      clp$get_time_string (time_string, {ignore} status);

{ If you can the format of this output, you must also change iic$xt_message_offset.

      STRINGREP (working_string, working_length, ' ', date_string.value (1, date_string.size), ' ',
            time_string.value (1, time_string.size), ' ', edited_string (1, edited_length));
      amp$put_next (file_identifier, ^working_string, working_length, fba, {ignore} status);
      fsp$close_file (file_identifier, {ignore} status);
      status.normal := TRUE;
    PROCEND write_xterm_output;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

{ Check format effectors to determine when to write data to output.

    working_storage_array_pointer := working_storage_area;

{handle output data as character array.

    i#move (working_storage_area, ^format_effector, 1);

    CASE format_effector OF

{ This format effector continues a record.

    = ',' =

      IF iiv$xt_xterm_task_output.text_p = NIL THEN
        ALLOCATE iiv$xt_xterm_task_output.text_p IN osv$task_private_heap^;
        iiv$xt_xterm_task_output.position := 0;
      IFEND;

      IF working_storage_length > 1 THEN
        i#move (#LOC (working_storage_array_pointer^ [1]), ^iiv$xt_xterm_task_output.
              text_p^ (iiv$xt_xterm_task_output.position + 1), working_storage_length - 1);
        iiv$xt_xterm_task_output.position := iiv$xt_xterm_task_output.position + working_storage_length - 1;
      IFEND;

{ The format effector ends the record.

    = '.', '/' =
      IF iiv$xt_xterm_task_output.text_p = NIL THEN
        ALLOCATE iiv$xt_xterm_task_output.text_p IN osv$task_private_heap^;
        iiv$xt_xterm_task_output.position := 0;
      IFEND;

      IF working_storage_length > 1 THEN
        i#move (#LOC (working_storage_array_pointer^ [1]), ^iiv$xt_xterm_task_output.
              text_p^ (iiv$xt_xterm_task_output.position + 1), working_storage_length - 1);
        iiv$xt_xterm_task_output.position := iiv$xt_xterm_task_output.position + working_storage_length - 1;
      IFEND;

      IF iiv$xt_xterm_task_output.position > 0 THEN
        write_xterm_output;
      IFEND;

      FREE iiv$xt_xterm_task_output.text_p IN osv$task_private_heap^;
      iiv$xt_xterm_task_output.position := 0;

{ These format effectors start a record.

    ELSE
      IF iiv$xt_xterm_task_output.text_p <> NIL THEN
        write_xterm_output;
      ELSE
        ALLOCATE iiv$xt_xterm_task_output.text_p IN osv$task_private_heap^;
        iiv$xt_xterm_task_output.position := 0;
      IFEND;
      IF working_storage_length > 1 THEN
        i#move (#LOC (working_storage_array_pointer^ [1]), iiv$xt_xterm_task_output.text_p,
              working_storage_length - 1);
        iiv$xt_xterm_task_output.position := working_storage_length - 1;
      IFEND;
    CASEND;

  PROCEND iip$xt_redirect_xterm_output;

?? TITLE := '[XDCL, #GATE] iip$xt_route', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_route
    (    user_id: ost$user_identification;
         user_supplied_name: jmt$user_supplied_name;
         system_job_parameters: jmt$system_job_parameters;
     VAR system_supplied_name: jmt$system_supplied_name;
     VAR status: ost$status);

    VAR
      account_name: avt$account_name,
      job_submission_options_p: ^jmt$job_submission_options,
      project_name: avt$project_name;

    VAR
      data_value_p: ^clt$data_value;

    status.normal := TRUE;
    pmp$get_account_project (account_name, project_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH job_submission_options_p: [1 .. 10];
    IF user_supplied_name <> osc$null_name THEN
      job_submission_options_p^ [1].key := jmc$user_job_name;
      job_submission_options_p^ [1].user_job_name := user_supplied_name;
    ELSE
      job_submission_options_p^ [1].key := jmc$null_attribute;
    IFEND;
    job_submission_options_p^ [2].key := jmc$system_job_parameters;
    PUSH job_submission_options_p^ [2].system_job_parameters;
    job_submission_options_p^ [2].system_job_parameters^ := system_job_parameters;
    job_submission_options_p^ [3].key := jmc$origin_application_name;
    job_submission_options_p^ [3].origin_application_name := osc$xterm_application_name;
    job_submission_options_p^ [4].key := jmc$login_command_supplied;
    job_submission_options_p^ [4].login_command_supplied := FALSE;
    job_submission_options_p^ [5].key := jmc$immediate_init_candidate;
    job_submission_options_p^ [5].immediate_init_candidate := TRUE;
    job_submission_options_p^ [6].key := jmc$login_family;
    job_submission_options_p^ [6].login_family := user_id.family;
    job_submission_options_p^ [7].key := jmc$login_user;
    job_submission_options_p^ [7].login_user := user_id.user;

    clp$get_variable_value ('XWV$XTERM_JOB_CLASS', data_value_p, status);
    IF NOT status.normal THEN
      job_submission_options_p^ [8].key := jmc$null_attribute;
    ELSE
      job_submission_options_p^ [8].key := jmc$job_class;
      job_submission_options_p^ [8].job_class := data_value_p^.name_value;
    IFEND;
    job_submission_options_p^ [9].key := jmc$login_account;
    job_submission_options_p^ [9].login_account := account_name;
    job_submission_options_p^ [10].key := jmc$login_project;
    job_submission_options_p^ [10].login_project := project_name;
    jmp$submit_job (clc$null_file, job_submission_options_p, system_supplied_name, status);

  PROCEND iip$xt_route;

?? TITLE := '[XDCL, #GATE] iip$xt_send_data', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_send_data
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
         start_time: integer;
     VAR request_started: boolean;
     VAR wait_time: nat$wait_time;
     VAR activity_status: ^ost$activity_status;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      current_time: integer,
      data: array [1 .. 1] of nat$data_fragment,
      data_area: ^nat$data_fragments,
      description_upperbound: integer,
      file_instance: ^bat$task_file_entry,
      file_is_valid: boolean,
      global_task_id: ost$global_task_id,
      ignore_status: ost$status;

    PROCEDURE move_data_fragments
      (    term_option: amt$term_option;
           data_fragments: nat$data_fragments;
       VAR status: ost$status);

      VAR
        data_p: ^SEQ ( * ),
        data_fragment_count: nat$data_fragment_count,
        get_p: ^SEQ ( * ),
        ignore_status: ost$status,
        message_size: integer,
        put_p: ^SEQ ( * ),
        sequence_p: ^SEQ ( * ),
        xt_message_control_block_p: ^iit$xt_message_control_block,
        xt_message_header_p: ^iit$xt_message_header;

      VAR
        trace_length: integer,
        trace_string: string (80);

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

        VAR
          ignore_status: ost$status;

        IF condition.selector = pmc$block_exit_processing THEN
          iip$xt_unlock_downline_messages (ignore_status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        IFEND;
      PROCEND condition_handler;

      PROCEDURE copy_fragments;

        FOR data_fragment_count := 1 TO UPPERBOUND (data_fragments) DO
          message_size := message_size + data_fragments [data_fragment_count].length;
          NEXT data_p: [[REP data_fragments [data_fragment_count].length OF cell]] IN put_p;
          i#move (data_fragments [data_fragment_count].address, data_p,
                data_fragments [data_fragment_count].length);
        FOREND;
      PROCEND copy_fragments;

      status.normal := TRUE;
      ?IF iic$xt_compiling_for_trace THEN
        iip$xt_write_trace (' Begin iip$xt_send_data');
      ?IFEND;

      osp$establish_condition_handler (^condition_handler, TRUE);
      iip$xt_lock_downline_messages ({ignore} status);
      status.normal := TRUE;
      sequence_p := iiv$xt_xterm_downline.segment_pointer.sequence_pointer;
      RESET sequence_p;
      NEXT xt_message_control_block_p IN sequence_p;
      put_p := #PTR (xt_message_control_block_p^.put_p, sequence_p^);

      CASE term_option OF

      = amc$start =
        NEXT xt_message_header_p IN put_p;
        xt_message_control_block_p^.put_message_header_p := #REL (xt_message_header_p, sequence_p^);
        message_size := 0;
        copy_fragments;
        xt_message_header_p^.xt_message_type := iic$xt_vtp_message_type;
        xt_message_header_p^.xt_message_size := message_size;
        xt_message_control_block_p^.terminate_option := iic$xt_start_record;

      = amc$continue =
        xt_message_header_p := #PTR (xt_message_control_block_p^.put_message_header_p, sequence_p^);
        message_size := xt_message_header_p^.xt_message_size;
        copy_fragments;
        xt_message_header_p^.xt_message_type := iic$xt_vtp_message_type;
        xt_message_header_p^.xt_message_size := message_size;
        xt_message_control_block_p^.terminate_option := iic$xt_continue_record;

      ELSE { amc$terminate
        IF (xt_message_control_block_p^.terminate_option = iic$xt_terminate_record) THEN
          NEXT xt_message_header_p IN put_p;
          xt_message_control_block_p^.put_p := #REL (put_p, sequence_p^);
          xt_message_control_block_p^.put_message_header_p := #REL (xt_message_header_p, sequence_p^);
          message_size := 0;
          copy_fragments;
          xt_message_header_p^.xt_message_type := iic$xt_vtp_message_type;
          xt_message_header_p^.xt_message_size := message_size;
          xt_message_control_block_p^.terminate_option := iic$xt_terminate_record;
        ELSE
          xt_message_header_p := #PTR (xt_message_control_block_p^.put_message_header_p, sequence_p^);
          message_size := xt_message_header_p^.xt_message_size;
          copy_fragments;
          xt_message_header_p^.xt_message_size := message_size;
          xt_message_control_block_p^.terminate_option := iic$xt_terminate_record;
        IFEND;

        xt_message_control_block_p^.put_p := #REL (put_p, sequence_p^);
        iiv$xt_xterm_control_block.downline_state := iic$xt_wait_for_data;
        iip$xt_unlock_downline_messages ({ignore} status);
        status.normal := TRUE;
        osp$disestablish_cond_handler;
        IF iiv$xt_xterm_control_block.xterm_state >= iic$execute_xterm_task THEN
          pmp$ready_task (iiv$xt_xterm_control_block.xterm_global_task_id, status);
          IF NOT status.normal THEN
            send_disconnect_signal (global_task_id);
          IFEND;
        IFEND;
      CASEND;

    PROCEND move_data_fragments;

    PROCEDURE send_xterm_output
      (    data_fragments: nat$data_fragments;
       VAR status: ost$status);

      VAR
        data_fragment_count: nat$data_fragment_count,
        output_position: integer,
        vt_output_information: iit$vt_output_information,
        position: integer,
        xterm_string: string (1000);

      status.normal := TRUE;
      i#move (data_fragments [1].address, ^vt_output_information, #SIZE (vt_output_information));
      IF vt_output_information.message_type <> iic$vt_output_data_message THEN
        RETURN;
      IFEND;

    /move_data/
      FOR data_fragment_count := 2 TO UPPERBOUND (data_fragments) DO
        i#move (data_fragments [data_fragment_count].address, ^xterm_string,
              data_fragments [data_fragment_count].length);
        iip$xt_write_trace (xterm_string (1, data_fragments [data_fragment_count].length));
      FOREND /move_data/;

    PROCEND send_xterm_output;

    status.normal := TRUE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_send_data');
    ?IFEND;

    activity_status^.status.normal := TRUE;
    activity_status^.complete := TRUE;
    request_started := TRUE;
    IF call_block.operation = nac$se_send_data_req THEN
      data_area := call_block.se_send_data_req.data;
    ELSE
      IF call_block.operation = amc$put_next_req THEN
        data [1].length := call_block.putn.working_storage_length;
        data [1].address := call_block.putn.working_storage_area;
        call_block.putn.byte_address^ := 0;
      ELSE
        data [1].length := call_block.putp.working_storage_length;
        data [1].address := call_block.putp.working_storage_area;
        call_block.putp.byte_address^ := 0;
      IFEND;
      data_area := ^data;
    IFEND;

    pmp$get_executing_task_gtid (global_task_id);
    IF (iiv$xt_xterm_control_block.task.exists AND (global_task_id =
          iiv$xt_xterm_control_block.xterm_global_task_id)) THEN
      send_xterm_output (data_area^, status);
      RETURN;
    IFEND;

    IF iiv$xt_xterm_control_block.status.complete THEN

{ Xterm task has completed.  Do not send anything to xterm task.

        send_disconnect_signal (global_task_id);
      RETURN;
    IFEND;

    IF call_block.operation = nac$se_send_data_req THEN
      IF call_block.se_send_data_req.end_of_message THEN
        move_data_fragments (amc$terminate, data_area^, status);
      ELSE
        move_data_fragments (amc$continue, data_area^, status);
      IFEND;

    ELSEIF (call_block.operation = amc$put_partial_req) THEN
      move_data_fragments (call_block.putp.term_option, data_area^, status);
    ELSE
      move_data_fragments (amc$terminate, data_area^, status);
    IFEND;

  PROCEND iip$xt_send_data;

?? TITLE := '[XDCL, #GATE] iip$xt_send_signal', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_send_signal
    (    interrupt_character: char;
     VAR status: ost$status);

    CONST
      pause_break_character = '1',
      terminate_break_character = '2';

    VAR
      timesharing_signal: jmt$timesharing_signal;

    status.normal := TRUE;
    timesharing_signal.signal_id := jmc$timesharing_signal_id;
    CASE interrupt_character OF

    = pause_break_character, terminate_break_character =
      timesharing_signal.signal_contents.signal_kind := jmc$timesharing_synchronize;
      timesharing_signal.signal_contents.synchronize (1) := interrupt_character;

    ELSE
      timesharing_signal.signal_contents.signal_kind := jmc$timesharing_interrupt;
      timesharing_signal.signal_contents.interrupt (1) := interrupt_character;
    CASEND;
    pmp$send_signal (iiv$job_monitor_task_id, timesharing_signal.signal, status);

  PROCEND iip$xt_send_signal;


?? TITLE := '[XDCL, #GATE] iip$xt_stop_xterm', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_stop_xterm
    (VAR status: ost$status);

    VAR
      condition_string: ost$string;

    status.normal := TRUE;
    IF iiv$xt_xterm_control_block.task.exists THEN
      IF iiv$xt_xterm_control_block.status.complete THEN
        iiv$xt_xterm_control_block.xterm_state := iic$terminate_xterm_task;
      IFEND;
      iiv$xt_xterm_control_block.task.exists := FALSE;
    IFEND;

  PROCEND iip$xt_stop_xterm;

?? TITLE := '[XDCL, #GATE] iip$xt_store_attributes', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_store_attributes
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    VAR
      attribute_index: integer,
      error_string: string (iic$xt_max_message_length),
      file_instance: ^bat$task_file_entry,
      file_is_valid: boolean,
      length: integer;

    status.normal := TRUE;
    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_store_attributes');
    ?IFEND;

    bap$validate_file_identifier (file_identifier, file_instance, file_is_valid);
    IF NOT file_is_valid THEN
      osp$set_status_condition (ame$improper_file_id, status);
      RETURN;
    IFEND;

    IF call_block.store_attributes <> NIL THEN
      FOR attribute_index := LOWERBOUND (call_block.store_attributes^)
            TO UPPERBOUND (call_block.store_attributes^) DO
        CASE call_block.store_attributes^ [attribute_index].kind OF
        = nac$connect_data =
        = nac$data_transfer_timeout =
          file_instance^.data_transfer_timeout := call_block.store_attributes^ [attribute_index].
                data_transfer_timeout;
        = nac$eoi_message =
          IF call_block.store_attributes^ [attribute_index].eoi_message.size <= 31 {nac$maximum_eoi_size} THEN
            IF file_instance^.eoi_message = NIL THEN
              ALLOCATE file_instance^.eoi_message IN osv$task_private_heap^;
            IFEND;
            file_instance^.eoi_message^ := call_block.store_attributes^ [attribute_index].eoi_message;
          ELSE
            osp$set_status_abnormal (nac$status_id, nae$invalid_eoi_message_size,
                  '31' {nac$maximum_eoi_size} , status);
          IFEND;
        = nac$eoi_message_enabled =
          file_instance^.eoi_message_enabled := call_block.store_attributes^ [attribute_index].
                eoi_message_enabled;
        = nac$eoi_peer_termination =
          file_instance^.eoi_peer_termination := call_block.store_attributes^ [attribute_index].
                eoi_peer_termination;
        = nac$null_attribute =
        = nac$receive_wait_swapout =
        = nac$termination_data =
        ELSE
          osp$set_status_abnormal (nac$status_id, nae$unknown_attribute, ' on STORE ATTRIBUTES ', status);
        CASEND;
      FOREND;
    IFEND;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_store_attributes');
    ?IFEND;

  PROCEND iip$xt_store_attributes;

?? TITLE := 'iip$xt_synchronize', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_synchronize
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    VAR
      downline_locked: boolean,
      get_p: ^SEQ ( * ),
      message_control_block_p: ^iit$xt_message_control_block,
      remaining_sequence_length: integer,
      sequence_p: ^SEQ ( * ),
      upline_locked: boolean;

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        IF downline_locked THEN
          iip$xt_unlock_downline_messages (ignore_status);
        IFEND;
        IF upline_locked THEN
          iip$xt_unlock_upline_messages (ignore_status);
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
      IFEND;
    PROCEND condition_handler;

    status.normal := TRUE;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Begin iip$xt_synchronize');
    ?IFEND;

    downline_locked := FALSE;
    #SPOIL (downline_locked);
    upline_locked := FALSE;
    #SPOIL (upline_locked);
    osp$establish_condition_handler (^condition_handler, TRUE);
    IF NOT iiv$xt_xterm_control_block.status.complete THEN
      iip$xt_lock_downline_messages ({ignore} status);
      status.normal := TRUE;
      downline_locked := TRUE;
      #SPOIL (downline_locked);
      sequence_p := iiv$xt_xterm_downline.segment_pointer.sequence_pointer;
      RESET sequence_p;
      NEXT message_control_block_p IN sequence_p;
      message_control_block_p^.record_position := iic$xt_end_of_record;
      message_control_block_p^.terminate_option := iic$xt_terminate_record;
      remaining_sequence_length := #SIZE (sequence_p^) - i#current_sequence_position (sequence_p);
      NEXT get_p: [[REP remaining_sequence_length OF cell]] IN sequence_p;
      RESET get_p;
      message_control_block_p^.get_p := #REL (get_p, sequence_p^);
      message_control_block_p^.put_p := message_control_block_p^.get_p;
      iip$xt_unlock_downline_messages ({ignore} status);
      status.normal := TRUE;
      downline_locked := FALSE;
      #SPOIL (downline_locked);
    IFEND;

{ Xterm and user task my modify upline messages.

    iip$xt_lock_upline_messages ({ignore} status);
    status.normal := TRUE;
    upline_locked := TRUE;
    #SPOIL (upline_locked);
    sequence_p := iiv$xt_xterm_upline.segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT message_control_block_p IN sequence_p;
    message_control_block_p^.record_position := iic$xt_end_of_record;
    message_control_block_p^.terminate_option := iic$xt_terminate_record;
    remaining_sequence_length := #SIZE (sequence_p^) - i#current_sequence_position (sequence_p);
    NEXT get_p: [[REP remaining_sequence_length OF cell]] IN sequence_p;
    RESET get_p;
    message_control_block_p^.get_p := #REL (get_p, sequence_p^);
    message_control_block_p^.put_p := message_control_block_p^.get_p;
    iip$xt_unlock_upline_messages ({ignore} status);
    status.normal := TRUE;
    upline_locked := FALSE;
    #SPOIL (upline_locked);
    osp$disestablish_cond_handler;

    ?IF iic$xt_compiling_for_trace THEN
      iip$xt_write_trace (' Exit iip$xt_synchronize');
    ?IFEND;

  PROCEND iip$xt_synchronize;

?? TITLE := '[XDCL, #GATE] iip$xt_synchronize_confirm', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_synchronize_confirm
    (    file_identifier: amt$file_identifier;
         layer: amt$fap_layer_number;
         call_block: amt$call_block;
     VAR status: ost$status);

    status.normal := TRUE;

{ For xterm there is nothing to do.

  PROCEND iip$xt_synchronize_confirm;

?? TITLE := '[XDCL, #GATE] iip$xt_unlock_downline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_unlock_downline_messages
    (VAR status: ost$status);

    VAR
      signature_lock_status: ost$signature_lock_status;

    status.normal := TRUE;
    osp$test_sig_lock (iiv$xt_xterm_control_block.downline_lock, signature_lock_status);
    IF signature_lock_status = osc$sls_locked_by_current_task THEN
      osp$clear_job_signature_lock (iiv$xt_xterm_control_block.downline_lock);
    IFEND;

  PROCEND iip$xt_unlock_downline_messages;

?? TITLE := '[XDCL, #GATE] iip$xt_unlock_upline_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_unlock_upline_messages
    (VAR status: ost$status);

    VAR
      signature_lock_status: ost$signature_lock_status;

    status.normal := TRUE;
    osp$test_sig_lock (iiv$xt_xterm_control_block.upline_lock, signature_lock_status);
    IF signature_lock_status = osc$sls_locked_by_current_task THEN
      osp$clear_job_signature_lock (iiv$xt_xterm_control_block.upline_lock);
    IFEND;

  PROCEND iip$xt_unlock_upline_messages;

?? TITLE := '[XDCL, #GATE] iip$xt_wait_for_xterm', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_wait_for_xterm
    (    system_supplied_name: jmt$system_supplied_name;
     VAR examine_job_file: boolean;
     VAR status: ost$status);

  CONST
    xterm_wait_time = 30*1000; {30 seconds.

  VAR
    attachment_option: array [1 .. 2] of fst$attachment_option,
    file_identifier: amt$file_identifier,
    file_reference: string ({$user.} 6 + {xterm catalog} 31 + {.} 1 +
            {status catalog} 31 + {.} 1 + {system_supplied_name} 31),
    file_reference_length: integer,
    global_task_id: ost$global_task_id,
    i_activity: array [1 .. 2] of ost$i_activity,
    ignore_status: ost$status,
    ready_index: integer,
    segment_pointer: amt$segment_pointer,
    sequence_p: ^SEQ (*),
    xterm_status_p: ^iit$xt_xterm_status;

?? OLDTITLE ??
?? NEWTITLE := 'clean_up', EJECT ??
   PROCEDURE clean_up;

     VAR
       cycle_selector: pft$cycle_selector,
       file_path: array [1 .. 5] of pft$name;

     fsp$close_file (file_identifier, ignore_status);
     file_path [pfc$family_name_index] := osc$null_name;
     file_path [pfc$master_catalog_name_index] := osc$null_name;
     file_path [pfc$subcatalog_name_index] := iic$xt_xterm_catalog_name;
     file_path [4] := iic$xt_status_catalog_name;
     file_path [5] := system_supplied_name;
     cycle_selector.cycle_option :=  pfc$highest_cycle;
     pfp$purge (file_path, cycle_selector, osc$null_name, ignore_status);
   PROCEND clean_up;

?? OLDTITLE, EJECT ??

{ Create segment access file for communicating with the xterm job.
{ The job submitting xterm executes this code.   The xterm job will wait
{ a certain period of time for this file to be created.

    attachment_option [1].selector := fsc$access_and_share_modes;
    attachment_option [1].access_modes.selector := fsc$specific_access_modes;
    attachment_option [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [1].share_modes.selector := fsc$specific_share_modes;
    attachment_option [1].share_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    attachment_option [2].selector := fsc$open_share_modes;
    attachment_option [2].open_share_modes := $fst$file_access_options
          [fsc$read, fsc$append, fsc$shorten, fsc$modify];
    STRINGREP (file_reference, file_reference_length, '$USER.',iic$xt_xterm_catalog_name,
          '.', iic$xt_status_catalog_name, '.', system_supplied_name);
    fsp$open_file (file_reference (1, file_reference_length), amc$segment,
          {attachment options=} ^attachment_option,
          {default creation attributes=} NIL, {mandated creation attributes=} NIL,
          {attribute validation=} NIL, {attribute override=} NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      clean_up;
      RETURN;
    IFEND;

{ Pass the global task id to the xterm job.  When the xterm job has completed initialization
{ it readies the task of the job submitting xterm.  The job submitting xterm then examines
{ the $USER.$JOBS.SYSTEM_SUPPLIED_NAME file for errors.

    pmp$get_executing_task_gtid (global_task_id);
    sequence_p := segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT xterm_status_p IN sequence_p;
    xterm_status_p^.activity_status.complete := FALSE;
    xterm_status_p^.activity_status.status.normal := FALSE;
    xterm_status_p^.global_task_id := global_task_id;

{ Wait for xterm job to write a status.

    i_activity [1].activity := osc$i_await_time;
    i_activity [1].milliseconds := xterm_wait_time;
    i_activity [2].activity := nac$i_await_activity_status;
    i_activity [2].activity_status := ^xterm_status_p^.activity_status;
    osp$i_await_activity_completion (i_activity, ready_index, status);
    examine_job_file :=  ((ready_index = 1) OR
          (NOT xterm_status_p^.activity_status.status.normal));
    clean_up;

  PROCEND iip$xt_wait_for_xterm;

?? TITLE := '[XDCL, #GATE] iip$xt_write_trace', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_write_trace
    (    working_storage_area: string ( * ));

    VAR
      date_string: ost$string,
      fba: amt$file_byte_address,
      file_identifier: amt$file_identifier,
      global_task_id: ost$global_task_id,
      status: ost$status,
      time_string: ost$string,
      working_length: integer,
      working_string: string (iic$xt_max_message_length);

    IF NOT selected_trace_option (iic$xt_trace_procedures) THEN
      RETURN;
    IFEND;

    open_trace_file (file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_date_string (date_string, {ignore} status);
    clp$get_time_string (time_string, {ignore} status);
    pmp$get_executing_task_gtid (global_task_id);
    STRINGREP (working_string, working_length, ' ', date_string.value (1, date_string.size), ' ',
          time_string.value (1, time_string.size), ' task = ', global_task_id.index, global_task_id.seqno,
          ' ', working_storage_area);
    amp$put_next (file_identifier, ^working_string, working_length, fba, {ignore} status);
    fsp$close_file (file_identifier, {ignore} status);
    status.normal := TRUE;

  PROCEND iip$xt_write_trace;

?? TITLE := '[XDCL, #GATE] iip$xt_write_trace_status', EJECT ??

  PROCEDURE [XDCL, #GATE] iip$xt_write_trace_status
    (    working_storage_area: string ( * );
         trace_status: ost$status);

    VAR
      condition_string: ost$string,
      fba: amt$file_byte_address,
      file_identifier: amt$file_identifier,
      global_task_id: ost$global_task_id,
      status: ost$status,
      time_string: ost$string,
      working_length: integer,
      working_string: string (iic$xt_max_message_length);

    IF NOT selected_trace_option (iic$xt_trace_procedures) THEN
      RETURN;
    IFEND;

    open_trace_file (file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_time_string (time_string, {ignore} status);
    pmp$get_executing_task_gtid (global_task_id);
    osp$get_status_condition_string (trace_status.condition, condition_string, {ignore} status);

    STRINGREP (working_string, working_length, ' ', time_string.value (1, time_string.size), ' task = ',
          global_task_id.index, global_task_id.seqno, ' ', working_storage_area
          (1, STRLENGTH (working_storage_area)), ' ', condition_string.value (1, condition_string.size));
    amp$put_next (file_identifier, ^working_string, working_length, fba, {ignore} status);
    fsp$close_file (file_identifier, {ignore} status);

  PROCEND iip$xt_write_trace_status;

?? TITLE := 'open_trace_file', EJECT ??

  PROCEDURE open_trace_file
    (VAR file_identifier: amt$file_identifier;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      file_cycle_attribute: array [1 .. 2] of fst$file_cycle_attribute,
      file_reference: string ({$user.} 6 + {xterm catalog} 31 + {.} 1 +
           {job catalog} 31 + {.} 1 + {system_supplied_name} 31),
      file_reference_length: integer,
      path: array [1 .. 4] of pft$name,
      system_supplied_name: jmt$system_supplied_name,
      user_supplied_name: jmt$user_supplied_name;

    define_xterm_catalog (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    path [pfc$family_name_index] := osc$null_name;
    path [pfc$master_catalog_name_index] := osc$null_name;
    path [pfc$subcatalog_name_index] := iic$xt_xterm_catalog_name;
    path [4] := iic$xt_job_catalog_name;
    pfp$define_catalog (path, status);
    IF NOT status.normal AND (status.condition = pfe$name_already_subcatalog) THEN
      status.normal := TRUE;
    ELSE
      RETURN;
    IFEND;

    attachment_option [1].selector := fsc$open_position;
    attachment_option [1].open_position := amc$open_at_eoi;
    attachment_option [2].selector := fsc$access_and_share_modes;
    attachment_option [2].access_modes.selector := fsc$specific_access_modes;
    attachment_option [2].access_modes.value := $fst$file_access_options [fsc$append];
    attachment_option [2].share_modes.selector := fsc$specific_share_modes;
    attachment_option [2].share_modes.value := $fst$file_access_options [fsc$read];
    file_cycle_attribute [1].selector := fsc$ring_attributes;
    file_cycle_attribute [1].ring_attributes.r1 := 11;
    file_cycle_attribute [1].ring_attributes.r2 := 11;
    file_cycle_attribute [1].ring_attributes.r3 := 11;
    file_cycle_attribute [2].selector := fsc$file_contents_and_processor;
    file_cycle_attribute [2].file_contents := amc$legible;
    file_cycle_attribute [2].file_processor := osc$null_name;
    pmp$get_job_names (user_supplied_name, system_supplied_name, {ignore} status);
    STRINGREP (file_reference, file_reference_length, '$USER.',iic$xt_xterm_catalog_name,
          '.', iic$xt_job_catalog_name,'.', system_supplied_name);
    fsp$open_file (file_reference (1, file_reference_length), amc$record, ^attachment_option,
          ^file_cycle_attribute, NIL, NIL, NIL, file_identifier, status);
  PROCEND open_trace_file;

?? TITLE := 'process_upline_command', EJECT ??
  PROCEDURE process_upline_command;

    VAR
      command_line_p: ^clt$command_line,
      data_p: ^SEQ ( * ),
      get_p: ^SEQ ( * ),
      ignore_status: ost$status,
      put_p: ^SEQ ( * ),
      message_length: integer,
      sequence_p: ^SEQ ( * ),
      vt_input_header_p: ^iit$vt_input_header,
      xt_message_header_p: ^iit$xt_message_header,
      xt_message_control_block_p: ^iit$xt_message_control_block;

    sequence_p := iiv$xt_xterm_upline.segment_pointer.sequence_pointer;
    RESET sequence_p;
    NEXT xt_message_control_block_p IN sequence_p;
    get_p := #PTR (xt_message_control_block_p^.get_p, sequence_p^);
    put_p := #PTR (xt_message_control_block_p^.put_p, sequence_p^);
    IF ((i#current_sequence_position (put_p) > i#current_sequence_position (get_p)) AND
          (xt_message_control_block_p^.terminate_option = iic$xt_terminate_record)) THEN
      NEXT xt_message_header_p IN get_p;
      message_length := xt_message_header_p^.xt_message_size;
      NEXT data_p: [[REP message_length OF cell]] IN get_p;
      RESET data_p;
      NEXT vt_input_header_p IN data_p;
      IF vt_input_header_p^.message_type = iic$vt_execute_xterm_command THEN
        xt_message_control_block_p^.get_p := #REL (get_p, sequence_p^);
        iiv$xt_xterm_control_block.xterm_state := iic$execute_initial_command;
        IF message_length > #SIZE (iit$vt_input_header) THEN
          NEXT command_line_p: [message_length - #SIZE (iit$vt_input_header)] IN data_p;
          clp$define_initial_application (command_line_p, FALSE {logout_upon_termination},ignore_status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND process_upline_command;


?? TITLE := 'selected_trace_option', EJECT ??
  FUNCTION [INLINE] selected_trace_option
    (    trace_option: iit$xt_trace_options): boolean;

    selected_trace_option := FALSE;

    IF NOT jmp$is_xterm_job () THEN
      RETURN;
    IFEND;

    selected_trace_option := (trace_option IN iiv$xt_xterm_control_block.trace_set);

  FUNCEND selected_trace_option;

?? TITLE := '  SEND_DISCONNECT_SIGNAL', EJECT ??

  PROCEDURE send_disconnect_signal
    (    task_id: ost$global_task_id);

    VAR
      local_status: ost$status,
      timesharing_signal: jmt$timesharing_signal;

    timesharing_signal.signal_id := jmc$timesharing_signal_id;
    timesharing_signal.signal_contents.signal_kind := jmc$timesharing_disconnect;
    timesharing_signal.signal_contents.disconnect.disconnect_reason := jmc$ts_line_disconnect;
    pmp$send_signal (task_id, timesharing_signal.signal, local_status);

  PROCEND send_disconnect_signal;

MODEND iim$xt_xterm_interfaces;
