?? RIGHT := 110 ??
?? TITLE := 'NFM$STATUS_AND_CONTROL_FACILITY' ??
MODULE nfm$status_and_control_facility;

{  PURPOSE:
{    This module contains the procedures and functions that collectively
{    implement the host application known as SCF/VE.  This application runs
{    in all NOS/VE systems supporting batch output.
{
{    SCF/VE performs the following functions:
{
{     - interfaces with queue file manager to obtain all output files that
{       are new, modified or terminated
{
{     - processes file control commands and informs SCFS/VE of the
{       availability of output files
{
{     - initiates BTF/VE which is the task responsible for the transfer of
{       an output file from the host to the device

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc nae$application_interfaces
*copyc nfc$wait_list_limit
*copyc nfe$exception_condition_codes
*copyc nft$application_file_descriptor
*copyc nft$available_file
*copyc nft$btf_task
*copyc nft$btfs_di_title
*copyc nft$byte_array
*copyc nft$control_facility
*copyc nft$copies
*copyc nft$destination
*copyc nft$device_attributes
*copyc nft$device_type
*copyc nft$file_assignment_response
*copyc nft$file_size
*copyc nft$file_vertical_print_density
*copyc nft$intertask_message
*copyc nft$io_station_usage
*copyc nft$linked_list_entry
*copyc nft$message_kind
*copyc nft$message_sequence
*copyc nft$network_address
*copyc nft$output_data_mode
*copyc nft$file_transfer_state
*copyc nft$page_format
*copyc nft$page_length
*copyc nft$page_width
*copyc nft$parameter_value_length
*copyc nft$priority
*copyc nft$scfs_client_identifier
*copyc nft$scf_pdt
*copyc nft$vfu_load_procedure
*copyc nft$wait_activity_list
*copyc osc$dual_state_interactive
*copyc osc$timesharing
*copyc osc$xterm_application_name
*copyc osd$integer_limits
*copyc ost$status
*copyc osv$lower_to_upper
*copyc pmd$local_queues
?? POP ??
*copyc amp$return
*copyc bap$validate_file_identifier
*copyc clp$create_environment_variable
*copyc clp$delete_variable
*copyc clp$get_value
*copyc clp$log_comment
*copyc clp$scan_parameter_list
*copyc fsp$close_file
*copyc fsp$open_file
*copyc jmp$acquire_modified_output
*copyc jmp$acquire_new_output
*copyc jmp$modified_output_exists
*copyc jmp$get_attribute_defaults
*copyc jmp$new_output_exists
*copyc jmp$register_output_application
*copyc jmp$set_output_completed
*copyc jmp$set_output_initiated
*copyc jmp$terminate_acquired_output
*copyc jmp$terminated_output_exists
*copyc nap$await_data_available
*copyc nap$await_server_response
*copyc nap$begin_directory_search
*copyc nap$end_directory_search
*copyc nap$display_message
*copyc nap$get_attributes
*copyc nap$get_title_translation
*copyc nap$request_connection
*copyc nap$se_receive_data
*copyc nap$se_send_data
*copyc nap$supported_protocol_stacks
*copyc nfp$add_to_wait_lists
*copyc nfp$btfs_di_match
*copyc nfp$crack_terqo_msg
*copyc nfp$crack_file_assignment_msg
*copyc nfp$create_appl_def_segment_var
*copyc nfp$delete_btf_task
*copyc nfp$end_async_communication
*copyc nfp$establish_cf_connection
*copyc nfp$get_async_task_message
*copyc nfp$get_btfs_di_address
*copyc nfp$get_connection_data
*copyc nfp$get_parameter_value_length
*copyc nfp$network_addresses_match
*copyc nfp$put_parameter_value_length
*copyc ofp$receive_operator_response
*copyc nfp$remove_from_wait_lists
*copyc nfp$send_add_file_available
*copyc nfp$send_btf_ve_status
*copyc nfp$send_delete_file_available
*copyc nfp$send_file_assignment_resp
*copyc nfp$send_message_on_connection
*copyc nfp$send_modify_file_available
*copyc nfp$send_terqo_response_msg
*copyc nfp$start_btf_ve_task
*copyc ofp$send_operator_message
*copyc osp$append_status_parameter
*copyc osp$i_await_activity_completion
*copyc osp$set_status_abnormal
*copyc pmp$establish_condition_handler
*copyc pmp$get_unique_name
*copyc pmp$log
*copyc pmp$terminate_task_without_wait
*copyc pmp$wait
?? OLDTITLE, EJECT ??

  CONST
    automatic_station_value = 'AUTOMATIC',
    start_of_scfs_title = 'SCF[SA]$',
    start_of_scfs_title_length = 8;


  VAR
    client_name: nat$application_name := 'OSA$STATUS_CONTROL_FAC_CLIENT',
    destination_list: ^nft$destination := NIL,
    local_status: ost$status,  {TEMP}
    nfv$wait_activity_list: ^nft$wait_activity_list := NIL,
    wait_activity_list_seq: ^SEQ ( * ),
    wait_list_seq: ^SEQ ( * );

*copyc nfs$appl_def_segment_variables
*copyc nfv$appl_def_segment_variables
?? NEWTITLE := '  acquire_all_output_files', EJECT ??

{  PURPOSE:
{    This procedure obtains all output from queue file manager.
{    It obtains all new output, output submitted via print_file,
{    all modified output, output changed via change_output_attributes,
{    and all terminated output, output terminated via terminate_output.
{    SCF/VE then sends a message to notify SCFS of the status of the new,
{    changed, or terminated output.

  PROCEDURE acquire_all_output_files (VAR message: ^nft$message_sequence;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR destination_list: ^nft$destination;
    VAR status: ost$status);

?? NEWTITLE := '    add_to_file_list', EJECT ??

{}
{  PURPOSE:
{    This procedure adds the specified output descriptor to the destinations
{    file list.
{}

    PROCEDURE add_to_file_list (descriptor: jmt$output_descriptor;
      VAR destination: nft$destination);

      VAR
        current_file,
        new_file: ^nft$available_file;


      ALLOCATE new_file;
      new_file^.file_kind := nfc$output_file;
      new_file^.output_descriptor := descriptor;
      new_file^.transfer_initiated := FALSE;
      new_file^.transfer_state := nfc$eligible_for_transfer;
      new_file^.control_facility := NIL;
      new_file^.btf_task := NIL;
      new_file^.link := NIL;

      current_file := destination.file_list;

      IF current_file = NIL THEN
        destination.file_list := new_file;
        new_file^.back_link := NIL;
      ELSE

      /find_end_of_file_list/
        WHILE current_file^.link <> NIL DO
          current_file := current_file^.link;
        WHILEND /find_end_of_file_list/;

        current_file^.link := new_file;
        new_file^.back_link := current_file;
      IFEND;

    PROCEND add_to_file_list;
?? TITLE := '    get_default_station_name', EJECT ??

{}
{  PURPOSE:
{    This procedure gets the system wide default for the station name and places
{    that value into the descriptor.
{}

    PROCEDURE get_default_station_name (
          originating_application_name: ost$name;
      VAR station: ost$name);

      VAR
        default_attributes: ^jmt$default_attribute_results,
        local_status: ost$status;

      PUSH default_attributes: [1..1];
      default_attributes^[1].key := jmc$station;

      IF (originating_application_name = osc$timesharing) OR
           (originating_application_name = osc$dual_state_interactive) OR
           (originating_application_name = osc$xterm_application_name) THEN
        jmp$get_attribute_defaults (jmc$interactive_connected, default_attributes, local_status);
      ELSE
        jmp$get_attribute_defaults (jmc$batch, default_attributes, local_status);
      IFEND;
      IF local_status.normal THEN
        station := default_attributes^[1].station;
      IFEND;

    PROCEND get_default_station_name;
?? TITLE := '    get_modified_output', EJECT ??

  {}
  {  PURPOSE:
  {    Obtain all output from queue file manager that has been modified.
  {    Each control facility with the destination specified by the output
  {    file will be notified of the changes in the output file.  If the
  {    modifications change the destination for the output file, each of the
  {    control facilities with the previous output file values will be informed
  {    to delete the file and the file will be sent to each control facility
  {    with the new destination.
  {}

    PROCEDURE get_modified_output (destination_usage: jmt$destination_usage;
      VAR message: ^nft$message_sequence;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR destination_list: ^nft$destination;
      VAR status: ost$status);

      VAR
        application_file: nft$application_file_descriptor,
        control_facility_entry: ^nft$linked_list_entry,
        current_file: ^nft$available_file,
        descriptor_found: boolean,
        destination: ^nft$destination,
        destination_found: boolean,
        local_status: ost$status,
        modified_application_file: nft$application_file_descriptor,
        modified_descriptor: jmt$output_descriptor,
        next_control_facility_entry: ^nft$linked_list_entry,
        old_descriptor: jmt$output_descriptor;

?? NEWTITLE := '      change_file_destination', EJECT ??

{}
{  PURPOSE:
{    This procedure is called when the user has made modifications that
{    affect where the output file will print.  The output file is removed
{    from the old destination list, put into the new destination list and
{    a delete file availability message is sent to all control facilities with
{    the old version of the output file.  The new version of the file is then
{    sent to each control facility with the new destination.
{}
      PROCEDURE change_file_destination (VAR message: ^nft$message_sequence;
            old_descriptor: jmt$output_descriptor;
            new_descriptor: jmt$output_descriptor;
        VAR wait_list: ^ost$i_wait_list;
        VAR wait_activity_list: ^nft$wait_activity_list;
        VAR destination_list: ^nft$destination;
        VAR status: ost$status);

        VAR
          new_destination: ^nft$destination,
          new_destination_found: boolean,
          old_destination: ^nft$destination,
          old_destination_found: boolean;


        status.normal := TRUE;

        find_destination (old_descriptor.station, destination_list, old_destination_found,
              old_destination);
        find_destination (new_descriptor.station, destination_list, new_destination_found,
              new_destination);

{  Remove the file from the old destination list and notify control facilities.

        IF old_destination_found THEN
          remove_file_from_list (old_descriptor.system_file_name, old_destination^);

{  Send a delete file available message to each of the control facilities }
{  with the old destination. }

          send_delete_file_to_ctrl_facs (old_destination^.control_facility_list,
                FALSE, old_descriptor, destination_list, wait_list, wait_activity_list,
                message,  status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

{ If the new destination is currently not known, get the control facilities that }
{ have a destination by that name. }

        IF NOT new_destination_found THEN
          get_destination_and_cntrl_fac (new_descriptor.station, wait_list, wait_activity_list,
                destination_list, new_destination, message, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.
                condition = nae$unknown_application)) THEN
            RETURN;
          IFEND;
        IFEND;
        add_to_file_list (new_descriptor, new_destination^);

{ Send a message indicating a file is available for printing to each control  }
{ facility with the new destination.  }

        send_add_file_to_ctrl_facs (new_destination^.control_facility_list,
              new_descriptor, nfc$eligible_for_transfer, destination_list, wait_list, wait_activity_list,
              message,  status);

      PROCEND change_file_destination;
?? TITLE := '      destination_changed', EJECT ??

{}
{  PURPOSE:
{    This function determines if the modifications made to the output file
{    have changed where the file may print (the files destination).
{}
      FUNCTION destination_changed (descriptor: jmt$output_descriptor;
            modified_descriptor: jmt$output_descriptor): boolean;


        destination_changed :=

        (descriptor.station <> modified_descriptor.station) OR

        (descriptor.output_destination_family <> modified_descriptor.output_destination_family) OR

        (descriptor.station_operator <> modified_descriptor.station_operator);

      FUNCEND destination_changed;
?? OLDTITLE, EJECT ??

      status.normal := TRUE;

      application_file.file_kind := nfc$output_file;
      modified_application_file.file_kind := nfc$output_file;

{ Get all output from queue manager that has been changed.

    /acquire_modified_output/
      WHILE jmp$modified_output_exists (destination_usage) DO

        jmp$acquire_modified_output (destination_usage, modified_descriptor, status);
        IF status.normal THEN

{  This code is required because of the differences in page_width between NOS/VE and
{  CDCNET BTF/DI.  This will change the NOS/VE page width that is outside the range
{  of CDCNET BTF/DI allowable values to within that range.

          IF modified_descriptor.page_width < nfc$minimum_page_width THEN
            modified_descriptor.page_width := nfc$minimum_page_width;
          ELSEIF modified_descriptor.page_width > nfc$maximum_page_width THEN
            modified_descriptor.page_width := nfc$maximum_page_width;
          IFEND;
          IF (modified_descriptor.station = automatic_station_value) THEN
            get_default_station_name (modified_descriptor.originating_application_name,
                  modified_descriptor.station);
          IFEND;
          find_file_and_descriptor (modified_descriptor.system_file_name, destination_list,
                current_file, descriptor_found);
          IF descriptor_found THEN
            old_descriptor := current_file^.output_descriptor;
            current_file^.output_descriptor := modified_descriptor;
            IF NOT destination_changed (old_descriptor, current_file^.output_descriptor) THEN
              find_destination (current_file^.output_descriptor.station, destination_list, destination_found,
                    destination);
              IF destination_found THEN

{  Notify each control facility with that destination that a file has been modified.

                application_file.output_descriptor := old_descriptor;
                modified_application_file.output_descriptor := current_file^.output_descriptor;

                control_facility_entry := destination^.control_facility_list;

              /search_control_facility_list/
                WHILE control_facility_entry <> NIL DO

                  nfp$send_modify_file_available (modified_application_file, application_file,
                        control_facility_entry^.control_facility^.connection_id, message, status);
                  next_control_facility_entry := control_facility_entry^.link;
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.
                        condition = nae$unknown_application)) THEN
                    RETURN;
                  ELSEIF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
                        (status.condition <> nfe$invalid_descriptor_value)) THEN
                    remove_control_facility (destination_list, control_facility_entry^.control_facility,
                          wait_list, wait_activity_list, status);
                    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.
                          condition = nae$unknown_application)) THEN
                      RETURN;
                    IFEND;
                  IFEND;
                  control_facility_entry := next_control_facility_entry;
                WHILEND /search_control_facility_list/;

              IFEND;
            ELSE

{ Notify control facilities that currently have the file to delete the file, }
{ and notify the control facilities with the new destination that there is   }
{ a file available for printing.  }

              change_file_destination (message, old_descriptor, current_file^.output_descriptor, wait_list,
                    wait_activity_list, destination_list, status);
              IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                    nae$unknown_application)) THEN
                RETURN;
              IFEND;
            IFEND;
          IFEND;
        ELSE
          pmp$log ('**** SCF - abnormal status returned on jmp$acquire_modified_output', local_status);
          nap$display_message (status);
          RETURN;
        IFEND;

      WHILEND /acquire_modified_output/;

    PROCEND get_modified_output;
?? TITLE := '    get_new_output', EJECT ??

{}
{  PURPOSE:
{    Obtain all output from queue file manager that the user has just
{    sent to print.  Each control facility with the destination specified by
{    the output file will be notified that there is an output file that is
{    available to print.
{}

    PROCEDURE get_new_output (destination_usage: jmt$destination_usage;
      VAR message: ^nft$message_sequence;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR destination_list: ^nft$destination;
      VAR status: ost$status);

      VAR
        descriptor: jmt$output_descriptor,
        descriptor_found: boolean,
        destination: ^nft$destination,
        local_status: ost$status;


      status.normal := TRUE;
      destination := NIL;

{ Get all new output from queue manager.

    /acquire_new_output/
      WHILE jmp$new_output_exists (destination_usage) DO

        jmp$acquire_new_output (destination_usage, descriptor, status);
        IF status.normal THEN

{  This code is required because of the differences in page_width between NOS/VE and
{  CDCNET BTF/DI.  This will change the NOS/VE page width that is outside the range
{  of CDCNET BTF/DI allowable values to within that range.

          IF descriptor.page_width < nfc$minimum_page_width THEN
            descriptor.page_width := nfc$minimum_page_width;
          ELSEIF descriptor.page_width > nfc$maximum_page_width THEN
            descriptor.page_width := nfc$maximum_page_width;
          IFEND;
          IF (descriptor.station = automatic_station_value) THEN
            get_default_station_name (descriptor.originating_application_name, descriptor.station);
          IFEND;
          get_destination_and_cntrl_fac (descriptor.station, wait_list, wait_activity_list,
                destination_list, destination, message, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.
                condition = nae$unknown_application)) THEN
            RETURN;
          IFEND;
          add_to_file_list (descriptor, destination^);

{  Send a message indicating a file is available to print to each control facility with that destination.

          send_add_file_to_ctrl_facs (destination^.control_facility_list,
                descriptor, nfc$eligible_for_transfer, destination_list, wait_list, wait_activity_list,
                message, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          IFEND;
        ELSE
          pmp$log ('**** SCF - abnormal status returned on jmp$acquire_new_output', local_status);
          nap$display_message (status);
          RETURN;
        IFEND;
      WHILEND /acquire_new_output/;

    PROCEND get_new_output;
?? TITLE := '    get_terminated_output', EJECT ??

{}
{  PURPOSE:
{    Obtain all output from queue file manager that has been terminated.
{    Each control facility with the destination specified by the output
{    file will be notified that the file should be deleted.  If the file
{    has already begun printing, the file transfer will not be terminated.
{}

    PROCEDURE get_terminated_output (destination_usage: jmt$destination_usage;
      VAR message: ^nft$message_sequence;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR destination_list: ^nft$destination;
      VAR status: ost$status);

      VAR
        application_file: nft$application_file_descriptor,
        current_file: ^nft$available_file,
        descriptor: jmt$output_descriptor,
        descriptor_found: boolean,
        destination: ^nft$destination,
        destination_found: boolean,
        ignore_status: ost$status,
        system_file_name: jmt$system_supplied_name;


      status.normal := TRUE;

{ Get all output from queue manager that has been terminated.

    /acquire_terminated_output/
      WHILE jmp$terminated_output_exists (destination_usage) DO

        jmp$terminate_acquired_output (destination_usage, system_file_name, status);
        IF status.normal THEN
          find_file_and_descriptor (system_file_name, destination_list, current_file, descriptor_found);
          IF descriptor_found THEN
            descriptor := current_file^.output_descriptor;
            find_destination (descriptor.station, destination_list, destination_found, destination);
            IF destination_found THEN
              remove_file_from_list (system_file_name, destination^);
              IF current_file^.control_facility <> NIL THEN

                application_file.file_kind := nfc$output_file;
                application_file.output_descriptor := current_file^.output_descriptor;
                nfp$send_delete_file_available (application_file, {held} FALSE, {requeued} FALSE,
                      current_file^.control_facility^.connection_id, message, status);
                IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
                        (status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility (destination_list, current_file^.control_facility, wait_list,
                        wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR
                       (status.condition = nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                IFEND;

{ If file is being processed by a BTF task, terminate that task.

                IF (current_file^.btf_task <> NIL) THEN
                  pmp$log ('**** SCF:  BTF terminated because file was terminated.', ignore_status);
                  pmp$terminate_task_without_wait (current_file^.btf_task^.id, ignore_status);
                IFEND;

{  Notify each control facility with that destination that the output
{  has been terminated.

              ELSE
                send_delete_file_to_ctrl_facs (destination^.control_facility_list,
                      FALSE, descriptor, destination_list, wait_list, wait_activity_list,
                      message,  status);
              IFEND;
            IFEND;
          IFEND;
        ELSE
          pmp$log ('**** SCF - abnormal status returned on jmp$terminate_acquired_output', ignore_status);
          nap$display_message (status);
          RETURN;
        IFEND;

      WHILEND /acquire_terminated_output/;

    PROCEND get_terminated_output;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

{ Get terminated output.

    get_terminated_output (jmc$public_usage, message, wait_list, wait_activity_list,
          destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

    get_terminated_output (jmc$private_usage, message, wait_list, wait_activity_list,
          destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

{ Get modified output.

    get_modified_output (jmc$public_usage, message, wait_list, wait_activity_list, destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

    get_modified_output (jmc$private_usage, message, wait_list, wait_activity_list, destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

{ Get new output.

    get_new_output (jmc$public_usage, message, wait_list, wait_activity_list, destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

    get_new_output (jmc$private_usage, message, wait_list, wait_activity_list, destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

  PROCEND acquire_all_output_files;
?? TITLE := '  add_await_title_translation', EJECT ??

{}
{  PURPOSE:
{    This procedure requests the translation of a title and adds
{    the title translation request to the wait lists.
{}

  PROCEDURE add_await_title_translation (VAR destination: nft$destination;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR status: ost$status);

    VAR
      activity: nft$wait_activity,
      recurrent_search: boolean,
      title: ^nat$title_pattern;


    status.normal := TRUE;

    PUSH title: [start_of_scfs_title_length + osc$max_name_size];
    title^ (1, start_of_scfs_title_length) := start_of_scfs_title;
    title^ (1 + start_of_scfs_title_length, * ) := destination.name;

{  If a recurrent search is requested, distributed translations will continue }
{  to be examined and SCF will be notified of any new titles having the  }
{  specified characteristics. }

    recurrent_search := TRUE;
    nap$begin_directory_search (title^, client_name, recurrent_search, destination.title_search_id, status);
    IF status.normal THEN
      destination.translation_time_stamp := #FREE_RUNNING_CLOCK (0);
      activity.kind := nfc$title_translation_request;
      activity.dest := ^destination;
      nfp$add_to_wait_lists (activity, wait_list, wait_activity_list,
            wait_list_seq, wait_activity_list_seq);
      nfv$wait_activity_list := wait_activity_list;
    IFEND;

  PROCEND add_await_title_translation;
?? TITLE := '  add_cf_to_control_fac_list', EJECT ??

{}
{  PURPOSE:
{    Add the control facility entry to the control facility list.  The
{    control facility list contains entries that are doubly linked together
{    with each entry pointing to a control facility.
{}

    PROCEDURE add_cf_to_control_fac_list (VAR control_facility: ^nft$control_facility;
      VAR control_facility_list: ^nft$linked_list_entry);

      VAR
        current_cf_entry: ^nft$linked_list_entry;

      IF control_facility_list = NIL THEN
        add_linked_list_entry(control_facility_list, nfc$control_facility);
        control_facility_list^.control_facility := control_facility;
      ELSE
        current_cf_entry := control_facility_list;

      /find_last_link/
        WHILE current_cf_entry^.link <> NIL DO
          current_cf_entry := current_cf_entry^.link;
        WHILEND /find_last_link/;

        add_linked_list_entry(current_cf_entry, nfc$control_facility);
        current_cf_entry^.control_facility := control_facility;
      IFEND;

    PROCEND add_cf_to_control_fac_list;
?? TITLE := '  add_control_facility_to_lists', EJECT ??

{}
{  PURPOSE:
{    Add the control facility to the wait lists.  Adding the control facility
{    to the wait lists allows SCF/VE to be notified of data on the connection
{    with the control facility.
{}

  PROCEDURE add_control_facility_to_lists (name: ost$name;
        connection_file_name: ost$name;
        connection_id: amt$file_identifier;
        service_address: nat$network_address;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR control_facility: ^nft$control_facility);

    VAR
      activity: nft$wait_activity;


    ALLOCATE control_facility;

    control_facility^.name := name;
    control_facility^.connection_file_name := connection_file_name;
    control_facility^.connection_id := connection_id;
    control_facility^.service_addr := service_address;

    activity.kind := nfc$control_facility_connection;
    activity.cf := control_facility;
    nfp$add_to_wait_lists (activity, wait_list, wait_activity_list,
          wait_list_seq, wait_activity_list_seq);
    nfv$wait_activity_list := wait_activity_list;

  PROCEND add_control_facility_to_lists;
?? TITLE := '  add_destination_to_list', EJECT ??

{}
{  PURPOSE:
{    A list of all the destinations known to this SCF/VE are kept in one list.
{    This procedure adds a new destination to that list.
{}

  PROCEDURE add_destination_to_list (name: ost$name;
    VAR first_destination: ^nft$destination;
    VAR destination: ^nft$destination);

    VAR
      current_destination: ^nft$destination;


    ALLOCATE destination;

    IF first_destination = NIL THEN
      first_destination := destination;
    ELSE
      current_destination := first_destination;

    /find_last_link/
      WHILE current_destination^.link <> NIL DO
        current_destination := current_destination^.link;
      WHILEND /find_last_link/;

      current_destination^.link := destination;
    IFEND;

    destination^.name := name;
    destination^.file_list := NIL;
    destination^.control_facility_list := NIL;
    destination^.link := NIL;
    destination^.translation_time_stamp := 0;

  PROCEND add_destination_to_list;
?? TITLE := '  add_linked_list_entry', EJECT ??

{}
{  PURPOSE:
{    This procedure adds a linked list entry of the specified kind to the end
{    of the list.
{  NOTE:
{    Current_link MUST point to the last entry in the linked list.
{}

  PROCEDURE add_linked_list_entry (VAR current_link: ^nft$linked_list_entry;
        link_kind: nft$link_kind);


    VAR
      new_link: ^nft$linked_list_entry;

    ALLOCATE new_link;

    IF current_link <> NIL THEN
      current_link^.link := new_link;
    IFEND;

    new_link^.back_link := current_link;
    current_link := new_link;
    current_link^.link := NIL;
    current_link^.kind := link_kind;

    CASE current_link^.kind OF
    = nfc$control_facility =
      current_link^.control_facility := NIL;
    CASEND;

  PROCEND add_linked_list_entry;
?? TITLE := '  cf_in_dest_control_fac_list', EJECT ??

    FUNCTION cf_in_dest_control_fac_list (control_facility: ^nft$control_facility;
          control_facility_list: ^nft$linked_list_entry): boolean;

      VAR
        control_facility_entry: ^nft$linked_list_entry,
        cf_found: boolean;

      cf_found := FALSE;
      control_facility_entry := control_facility_list;

    /search_for_cf_with_service_addr/
      WHILE (control_facility_entry <> NIL) AND (NOT cf_found) DO
        IF control_facility_entry^.control_facility <> NIL THEN
          IF nfp$network_addresses_match (control_facility_entry^.control_facility^.service_addr,
                control_facility^.service_addr) THEN
            cf_found := (control_facility_entry^.control_facility^.name = control_facility^.name);
          IFEND;
        IFEND;
        control_facility_entry := control_facility_entry^.link;
      WHILEND /search_for_cf_with_service_addr/;

      cf_in_dest_control_fac_list := cf_found;

    FUNCEND cf_in_dest_control_fac_list;
?? TITLE := '  check_for_btf_task_completion', EJECT ??

{}
{  PURPOSE:
{    For each BTF/VE task known to SCF/VE, if there is a message from the
{    task indicating the transfer is complete, or that the file should be
{    requeued, notify queue file manager that the transfer is complete,
{    notify the control facility that the file should be deleted, and delete
{    the file from the destinations file list.
{}
{  NOTE:
{    If the operator specified that the file should be held in the station queue,
{    there is currently no indication to the user that the file is in that
{    state.
{}

  PROCEDURE check_for_btf_task_completion
    (VAR message: ^nft$message_sequence;
         btf_task_index: integer;
     VAR outstanding_operator_messages: ost$non_negative_integers;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_activity_list: ^nft$wait_activity_list;
     VAR destination_list: ^nft$destination;
     VAR status: ost$status);

    VAR
      application_file: nft$application_file_descriptor,
      btf_task: ^nft$btf_task,
      destination: ^nft$destination,
      current_file: ^nft$available_file,
      ignore_status: ost$status,
      output_complete: boolean,
      remove_task: boolean,
      task_status: nft$intertask_message,
      task_status_size: nft$intertask_transfer_size,
      transfer_count: nft$intertask_transfer_size;

?? NEWTITLE := '    requeue_files_to_destination', EJECT ??

    PROCEDURE requeue_files_to_destination
      (    btf_task: ^nft$btf_task;
           destination_list: ^nft$destination;
       VAR wait_list: ^ost$i_wait_list;
       VAR wait_activity_list: ^nft$wait_activity_list;
       VAR message: ^nft$message_sequence;
       VAR status: ost$status);

      VAR
        application_file: nft$application_file_descriptor,
        current_file: ^nft$available_file,
        destination: ^nft$destination,
        ignore_status: ost$status;

      status.normal := TRUE;
      application_file.file_kind := nfc$output_file;

      destination := destination_list;

    /search_destination_list/
      WHILE destination <> NIL DO

        current_file := destination^.file_list;

      /search_file_list/
        WHILE current_file <> NIL DO

          IF current_file^.transfer_initiated AND
                (current_file^.btf_task <> NIL) THEN
            IF (current_file^.btf_task^.io_station = btf_task^.io_station) AND
               (current_file^.btf_task^.device = btf_task^.device) AND
               (current_file^.btf_task^.id = btf_task^.id) AND
               nfp$btfs_di_match (current_file^.btf_task^.btfs_di_title,
               current_file^.btf_task^.network_addr, btf_task^.btfs_di_title,
               btf_task^.network_addr)
                  THEN
              IF current_file^.control_facility <> NIL THEN

                application_file.output_descriptor := current_file^.output_descriptor;
                nfp$send_delete_file_available (application_file, {held} FALSE, {requeued} FALSE,
                      current_file^.control_facility^.connection_id, message, status);
                IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
                        (status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility (destination_list, current_file^.control_facility, wait_list,
                        wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR
                       (status.condition = nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                IFEND;
              IFEND;
              jmp$set_output_completed (current_file^.output_descriptor.output_destination_usage,
                    current_file^.output_descriptor.system_file_name, FALSE, ignore_status);
              remove_file_from_list (current_file^.output_descriptor.system_file_name, destination^);
            IFEND;
          IFEND;
          current_file := current_file^.link;
        WHILEND /search_file_list/;
        destination := destination^.link;

      WHILEND /search_destination_list/;
    PROCEND requeue_files_to_destination;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    task_status_size := #SIZE (nft$intertask_message);
    btf_task := wait_activity_list^ [btf_task_index].btf_task_list;

  /check_btf_tasks_for_messages/
    WHILE btf_task <> NIL DO
      nfp$get_async_task_message (btf_task^.id, ^task_status, task_status_size, 0, transfer_count, status);
      IF NOT status.normal THEN
        nfp$delete_btf_task (btf_task_index, wait_activity_list, btf_task);
      ELSEIF (status.normal) AND (transfer_count > 0) THEN
        CASE task_status.kind OF

        = nfc$btf_file_transfer_status =

          nfp$delete_btf_task (btf_task_index, wait_activity_list, btf_task);

          IF (NOT task_status.btf_task_status.normal) AND
                ((task_status.btf_task_status.condition = nae$application_inactive) OR
                (task_status.btf_task_status.condition = nae$unknown_application)) THEN
            status := task_status.btf_task_status;
            RETURN;
          IFEND;

          find_file_in_list (task_status.btf_system_file_name, destination_list, current_file, destination);
          IF current_file <> NIL THEN

            current_file^.output_descriptor.copies_printed := task_status.copies_printed;
            output_complete := task_status.btf_transfer_status = nfc$transfer_complete_drop_file;

            IF task_status.filter_aborted THEN
              ofp$send_operator_message ('BATCH OUTPUT FILTER ABORTED - SEE SYSTEM LOG FOR DETAILS.',
                    ofc$system_operator, TRUE, ignore_status);
              outstanding_operator_messages := outstanding_operator_messages + 1;
            IFEND;

            CASE task_status.btf_transfer_status OF
            = nfc$operator_hold_file =
              current_file^.transfer_state := nfc$hold_transfer;

            = nfc$transfer_complete_drop_file, nfc$transfer_failed_re_q_file =

{ Notify queue file manager if the file transfer is complete and
{ notify the control facility that assigned the file to a device that the
{ file should be deleted from the station queue.

              current_file^.transfer_initiated := FALSE;
              jmp$set_output_completed (current_file^.output_descriptor.output_destination_usage,
                    current_file^.output_descriptor.system_file_name, output_complete, ignore_status);

              IF current_file^.control_facility <> NIL THEN
                application_file.file_kind := nfc$output_file;
                application_file.output_descriptor := current_file^.output_descriptor;

                nfp$send_delete_file_available (application_file, {held} FALSE,
                      {requeued} (NOT output_complete), current_file^.control_facility^.connection_id,
                      message, status);
                IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
                        (status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility (destination_list, current_file^.control_facility, wait_list,
                        wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition =
                        nae$application_inactive) OR (status.condition
                        =  nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                IFEND;
              IFEND;
              remove_file_from_list (task_status.btf_system_file_name, destination^);

            = nfc$filter_hold_file =
              current_file^.transfer_state := nfc$hold_transfer;

              IF current_file^.control_facility <> NIL THEN
                application_file.file_kind := nfc$output_file;
                application_file.output_descriptor := current_file^.output_descriptor;

                nfp$send_delete_file_available (application_file, {held} TRUE, {requeued} FALSE,
                      current_file^.control_facility^.connection_id, message, status);
                IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
                      (status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility (destination_list, current_file^.control_facility, wait_list,
                        wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR
                        (status.condition = nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                IFEND;
              IFEND;
            ELSE
              ;
            CASEND;
          IFEND;

        = nfc$abnormal_child_task_abort =
          requeue_files_to_destination( btf_task, destination_list, wait_list,
                wait_activity_list, message, status);
          nfp$delete_btf_task (btf_task_index, wait_activity_list, btf_task);
        ELSE
        CASEND;
      ELSE
        btf_task := btf_task^.link;
      IFEND;
    WHILEND /check_btf_tasks_for_messages/;

  PROCEND check_for_btf_task_completion;
?? TITLE := '  check_unknown_destination', EJECT ??

{  PURPOSE:
{    A title translation was received for a previous translation request
{    on a destination name, indicating the location of a control facility that
{    that has that destination.  The control facility list for the destination
{    is updated and if there are files in the destinations file list that
{    are not currently printing, an add file availability message will be
{    sent to those control facilities that weren't in the previous list of
{    known control facilities.

  PROCEDURE check_unknown_destination
    (VAR message: ^nft$message_sequence;
         activity_index: integer;
         destination_list: ^nft$destination;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_activity_list: ^nft$wait_activity_list;
     VAR status: ost$status);

    VAR
      application_file: nft$application_file_descriptor,
      control_facility_entry: ^nft$linked_list_entry,
      control_facility_list: ^nft$linked_list_entry,
      current_file: ^nft$available_file,
      destination: ^nft$destination,
      local_status: ost$status,
      next_control_facility_entry: ^nft$linked_list_entry;
?? EJECT ??

    status.normal := TRUE;
    application_file.file_kind := nfc$output_file;

{  A title translation was received for the destination.  Get the destination
{  and get a current list of the control facilities that have that destination.

    destination := wait_activity_list^ [activity_index].dest;
    get_control_facility (activity_index, wait_list, wait_activity_list, destination^, control_facility_list,
          message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF control_facility_list <> NIL THEN
      control_facility_entry := control_facility_list;

    /search_control_facility_list/
      WHILE control_facility_entry <> NIL DO

{  If there are entries in the control facility list that are not in the
{  current control facility list for that destination, add them into the list.

        next_control_facility_entry := control_facility_entry^.link;
        IF NOT cf_in_dest_control_fac_list (control_facility_entry^.control_facility,
              destination^.control_facility_list) THEN
          add_cf_to_control_fac_list (control_facility_entry^.control_facility,
                destination^.control_facility_list);

{  Check each file in the destination file list.  If the file is
{  not printing, send a message to the additional control facility indicating
{  that there is a file that is a candidate for printing.

          current_file := destination^.file_list;
          IF current_file <> NIL THEN

          /search_output_file_list/
            REPEAT
              IF (NOT current_file^.transfer_initiated) OR (current_file^.transfer_initiated AND
                    (current_file^.transfer_state = nfc$hold_transfer)) THEN
                application_file.output_descriptor := current_file^.output_descriptor;
                nfp$send_add_file_available (application_file,  current_file^.transfer_state,
                      control_facility_entry^.control_facility^.connection_id, message, local_status);
                IF NOT local_status.normal AND ((local_status.condition <> nae$no_data_available) AND
                        (local_status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility (destination_list, control_facility_entry^.control_facility,
                        wait_list, wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.
                        condition = nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                  control_facility_entry := next_control_facility_entry;
                  CYCLE /search_control_facility_list/;
                IFEND;
              IFEND;
              current_file := current_file^.link;
            UNTIL (current_file = NIL);

          IFEND;
        IFEND;
        control_facility_entry := next_control_facility_entry;
      WHILEND /search_control_facility_list/;
    IFEND;

  PROCEND check_unknown_destination;
?? TITLE := '  delete_destination_message', EJECT ??

{}
{  PURPOSE:
{    This procedure is executed when a delete destination message is received
{    from a control facility indicating an I/O station or alias has been
{    deleted from the control facility.  The control facility will be removed
{    from the destinations control facility list and further output files
{    will not be sent to that control facility until the destination returns.
{}

  PROCEDURE delete_destination_message (VAR message: ^nft$message_sequence;
        destination_list: ^nft$destination;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR msg_length: integer;
    VAR status: ost$status);

*copy nft$delete_destination_msg

    VAR
      control_facility_entry: ^nft$linked_list_entry,
      control_facility_found_in_list: boolean,
      control_facility_name: ost$name,
      destination: ^nft$destination,
      destination_found: boolean,
      destination_name: ost$name;

?? NEWTITLE := '    crack_delete_destination_msg', EJECT ??

    PROCEDURE crack_delete_destination_msg (VAR message: ^nft$message_sequence;
      VAR msg_length: integer;
      VAR destination_name: ost$name;
      VAR control_facility_name: ost$name;
      VAR status: ost$status);

      VAR
        ascii_string: ^string ( * <= osc$max_name_size),
        byte_array: ^nft$byte_array,
        parameter: ^nft$delete_destination_param,
        value_length: integer;


      status.normal := TRUE;
      NEXT parameter IN message;

    /parse_protocol_message/
      WHILE (parameter^.param <> nfc$null_parameter) AND (msg_length > 0) DO
        msg_length := msg_length - 1;
        IF parameter^.length_indicated THEN
          nfp$get_parameter_value_length (message, msg_length, value_length, status);
          msg_length := msg_length - value_length;
        ELSE
          value_length := 1;
          msg_length := msg_length - 1;
        IFEND;

        CASE parameter^.param OF
        = nfc$destination_name =
          NEXT ascii_string: [value_length] IN message;
          destination_name := ascii_string^;

        = nfc$control_facility_name =
          NEXT ascii_string: [value_length] IN message;
          control_facility_name := ascii_string^;

        ELSE
{         ERROR ----   Ignore parameter value.
          NEXT byte_array: [1 .. value_length] IN message;

        CASEND;
        NEXT parameter IN message;
      WHILEND /parse_protocol_message/;

    PROCEND crack_delete_destination_msg;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    crack_delete_destination_msg (message, msg_length, destination_name, control_facility_name,
          status);

    find_destination (destination_name, destination_list, destination_found, destination);

    IF destination_found  THEN
      control_facility_found_in_list := FALSE;
      control_facility_entry := destination^.control_facility_list;

    /search_control_facility_list/
      WHILE (control_facility_entry <> NIL) AND (NOT control_facility_found_in_list) DO
        IF control_facility_entry^.control_facility <> NIL THEN

{  A control facility name must be unique within the catenet, so the name is
{  enough to identify which control facility entry to delete from the
{  destinations list of control facilities.

          IF control_facility_name = control_facility_entry^.control_facility^.name THEN
            remove_linked_list_entry(control_facility_entry, destination^.control_facility_list);
            control_facility_found_in_list := TRUE;
            EXIT /search_control_facility_list/
          IFEND;
        IFEND;
        control_facility_entry := control_facility_entry^.link;
      WHILEND /search_control_facility_list/;

    IFEND;

  PROCEND delete_destination_message;
?? TITLE := '  file_assignment_message', EJECT ??

{  PURPOSE:
{    This procedure processes a file assignment message that was sent from
{    a control facility indicating an output file has been assigned to an
{    output device.  In the message is a list of the output file attributes
{    known to the control facility.   If this list of attributes matches
{    the current attributes known to SCF/VE, if another control facility
{    has not already assigned the output file to a device, or if the user
{    has not just recently modified or terminated the output file, a response
{    is sent to the control facility indicating the message was accepted.
{    Otherwise a response is sent indicating the message was rejected.
{
{  NOTE:
{    The checking of the output file attributes is done to cover the case
{    where the output file was sent to multiple control facilities, and the
{    user may have modified the output file.  There is no indication
{    if the control facilities file assignment is in response to the initial
{    file availability message, to an initial modification or to a second
{    modification.  The checking of the attributes ensures that the
{    control facility has the most recent information about the output file.

  PROCEDURE file_assignment_message
    (    connection_id: amt$file_identifier;
         first_destination: ^nft$destination;
         debug_async_task: pmt$debug_mode;
         public_queue_file_password: jmt$queue_file_password;
         private_queue_file_password: jmt$queue_file_password;
     VAR message: ^nft$message_sequence;
     VAR wait_list: ^ost$i_wait_list;
     VAR wait_activity_list: ^nft$wait_activity_list;
     VAR msg_length: integer;
     VAR status: ost$status);

*copyc nft$file_assignment_msg

    VAR
      application_file: nft$application_file_descriptor,
      btfs_di_network_address: nat$network_address,
      btfs_di_xns_address: nft$network_address,
      btfs_di_title: nft$btfs_di_title,
      btf_task: ^nft$btf_task,
      control_facility: ^nft$control_facility,
      control_facility_entry: ^nft$linked_list_entry,
      current_file: ^nft$available_file,
      descriptor_found: boolean,
      destination: ^nft$destination,
      destination_found: boolean,
      device_attributes: nft$device_attributes,
      device_attributes_variable: ost$name,
      device_name: ost$name,
      device_type: nft$device_type,
      ignore_status: ost$status,
      io_station_name: ost$name,
      last_parameter_sent: nft$file_assignment_params,
      message_response: nft$file_assignment_response,
      next_control_facility_entry: ^nft$linked_list_entry,
      protocol_stacks: nat$protocol_stack_integer,
      remote_system_protocol: nft$ntf_remote_system_protocol,
      remote_system_type: nft$ntf_remote_system_type,
      route_back_position: nft$ntf_route_back_position,
      scfs_values_match_descriptor: boolean,
      system_file_name: jmt$system_supplied_name;

?? NEWTITLE := 'create_device_attributes_var', EJECT ??

{ PURPOSE:
{   This procedure creates an SCL variable with the device attributes of the
{   assigned device.  This SCL variable is used by the $device_attributes
{   function which is used by batch output filters.
{
{ DESIGN:
{   A read-only, job-scope SCL variable of type RECORD is created and
{   initialized.
{
{ NOTES:
{   If SCFS has not provided device_attribute parameters on the file
{   assignment message (because it is an old SCFS) then the variable will
{   contain fields with uninitialized values.  DEVICE_NAME and STATION will
{   always be OK because SCFS has always sent these values.


    PROCEDURE create_device_attributes_var
      (    device_name: ost$name;
           device_type: nft$device_type;
           device_attributes: nft$device_attributes;
           io_station_name: ost$name;
       VAR variable_name: ost$name;
       VAR status: ost$status);

{ TYPE
{   device_attributes: record
{     banner_highlight_field: key
{         comment_banner, routing_banner, site_banner, user_file_name, user_name
{       keyend = $optional
{     banner_page_count: integer 0..3 = $optional
{     carriage_control_support: key
{         post_print, pre_and_post_print, pre_print
{       keyend = $optional
{     code_set: key
{         ascii, ascii_48, ascii_64, ascii_95, ascii_128, ascii_256, bcd, ebcdic, site_defined
{       keyend = $optional
{     device_alias_1: any of
{         key
{           none
{         keyend
{         name
{       anyend = $optional
{     device_alias_2: any of
{         key
{           none
{         keyend
{         name
{       anyend = $optional
{     device_alias_3: any of
{         key
{           none
{         keyend
{         name
{       anyend = $optional
{     device_name: name = $optional
{     device_type: key
{         console, plotter, printer, punch, reader
{       keyend = $optional
{     external_characteristics_1: string 0..6 = $optional
{     external_characteristics_2: string 0..6 = $optional
{     external_characteristics_3: string 0..6 = $optional
{     external_characteristics_4: string 0..6 = $optional
{     file_acknowledgement: boolean = $optional
{     forms_code_1: string 0..6 = $optional
{     forms_code_2: string 0..6 = $optional
{     forms_code_3: string 0..6 = $optional
{     forms_code_4: string 0..6 = $optional
{     forms_size: real 0.5..31.0 = $optional
{     maximum_file_size: integer 0..4294967295 = $optional
{     page_width: integer 10..255 = $optional
{     station: name = $optional
{     terminal_model: any of
{         key
{           none
{         keyend
{         name
{       anyend = $optional
{     tip_type: key
{         async, auto, bisync_3270, bisync_njef, hasp, internal, mode4, ntf, sna_3270, telnet
{         remote_term_emulator, uri, user1, user2, user3, user4, x25_async, xpc
{       keyend = $optional
{     transmission_block_size: integer 0..65535 = $optional
{     undefined_fe_action: key
{         discard_print_line, print_after_spacing, print_before_spacing
{       keyend = $optional
{     unsupported_fe_action: key
{         discard_print_line, print_after_spacing, print_before_spacing
{       keyend = $optional
{     vertical_print_density: key
{         eight_any, eight_only, six_any, six_only
{       keyend = $optional
{     vfu_load_option: key
{         changeable_by_operator, changeable_by_user, loaded_at_initialization, not_present_or_loadable
{       keyend = $optional
{     vfu_load_procedure: any of
{         key
{           none
{         keyend
{         name
{       anyend = $optional
{   recend
{ TYPEND

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

  VAR
    type_specification : [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      name: string (17),
      qualifier: clt$record_type_qualifier,
      field_spec_1: clt$field_specification,
      element_type_spec_1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 5] of clt$keyword_specification,
      recend,
      field_spec_2: clt$field_specification,
      element_type_spec_2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      field_spec_3: clt$field_specification,
      element_type_spec_3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
      recend,
      field_spec_4: clt$field_specification,
      element_type_spec_4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 9] of clt$keyword_specification,
      recend,
      field_spec_5: clt$field_specification,
      element_type_spec_5: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      field_spec_6: clt$field_specification,
      element_type_spec_6: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      field_spec_7: clt$field_specification,
      element_type_spec_7: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      field_spec_8: clt$field_specification,
      element_type_spec_8: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_9: clt$field_specification,
      element_type_spec_9: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 5] of clt$keyword_specification,
      recend,
      field_spec_10: clt$field_specification,
      element_type_spec_10: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_11: clt$field_specification,
      element_type_spec_11: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_12: clt$field_specification,
      element_type_spec_12: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_13: clt$field_specification,
      element_type_spec_13: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_14: clt$field_specification,
      element_type_spec_14: record
        header: clt$type_specification_header,
      recend,
      field_spec_15: clt$field_specification,
      element_type_spec_15: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_16: clt$field_specification,
      element_type_spec_16: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_17: clt$field_specification,
      element_type_spec_17: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_18: clt$field_specification,
      element_type_spec_18: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      field_spec_19: clt$field_specification,
      element_type_spec_19: record
        header: clt$type_specification_header,
        qualifier: clt$real_type_qualifier,
      recend,
      field_spec_20: clt$field_specification,
      element_type_spec_20: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      field_spec_21: clt$field_specification,
      element_type_spec_21: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      field_spec_22: clt$field_specification,
      element_type_spec_22: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_23: clt$field_specification,
      element_type_spec_23: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      field_spec_24: clt$field_specification,
      element_type_spec_24: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 18] of clt$keyword_specification,
      recend,
      field_spec_25: clt$field_specification,
      element_type_spec_25: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      field_spec_26: clt$field_specification,
      element_type_spec_26: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
      recend,
      field_spec_27: clt$field_specification,
      element_type_spec_27: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
      recend,
      field_spec_28: clt$field_specification,
      element_type_spec_28: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      field_spec_29: clt$field_specification,
      element_type_spec_29: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      field_spec_30: clt$field_specification,
      element_type_spec_30: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
    recend := [
      [1, 17, clc$record_type], 'DEVICE_ATTRIBUTES', [30],
      ['BANNER_HIGHLIGHT_FIELD         ', clc$optional_field, 192], [[1, 0, clc$keyword_type], [5], [
        ['COMMENT_BANNER                 ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['ROUTING_BANNER                 ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['SITE_BANNER                    ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['USER_FILE_NAME                 ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['USER_NAME                      ', clc$nominal_entry, clc$normal_usage_entry, 5]]
        ],
      ['BANNER_PAGE_COUNT              ', clc$optional_field, 20], [[1, 0, clc$integer_type], [0, 3, 10]],
      ['CARRIAGE_CONTROL_SUPPORT       ', clc$optional_field, 118], [[1, 0, clc$keyword_type], [3], [
        ['POST_PRINT                     ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['PRE_AND_POST_PRINT             ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['PRE_PRINT                      ', clc$nominal_entry, clc$normal_usage_entry, 3]]
        ],
      ['CODE_SET                       ', clc$optional_field, 340], [[1, 0, clc$keyword_type], [9], [
        ['ASCII                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['ASCII_128                      ', clc$nominal_entry, clc$normal_usage_entry, 5],
        ['ASCII_256                      ', clc$nominal_entry, clc$normal_usage_entry, 6],
        ['ASCII_48                       ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['ASCII_64                       ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['ASCII_95                       ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['BCD                            ', clc$nominal_entry, clc$normal_usage_entry, 7],
        ['EBCDIC                         ', clc$nominal_entry, clc$normal_usage_entry, 8],
        ['SITE_DEFINED                   ', clc$nominal_entry, clc$normal_usage_entry, 9]]
        ],
      ['DEVICE_ALIAS_1                 ', clc$optional_field, 69], [[1, 0, clc$union_type], [[
        clc$keyword_type, clc$name_type],
        FALSE, 2],
        44, [[1, 0, clc$keyword_type], [1], [
          ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
          ],
        5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
        ],
      ['DEVICE_ALIAS_2                 ', clc$optional_field, 69], [[1, 0, clc$union_type], [[
        clc$keyword_type, clc$name_type],
        FALSE, 2],
        44, [[1, 0, clc$keyword_type], [1], [
          ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
          ],
        5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
        ],
      ['DEVICE_ALIAS_3                 ', clc$optional_field, 69], [[1, 0, clc$union_type], [[
        clc$keyword_type, clc$name_type],
        FALSE, 2],
        44, [[1, 0, clc$keyword_type], [1], [
          ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
          ],
        5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
        ],
      ['DEVICE_NAME                    ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['DEVICE_TYPE                    ', clc$optional_field, 192], [[1, 0, clc$keyword_type], [5], [
        ['CONSOLE                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['PLOTTER                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['PRINTER                        ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['PUNCH                          ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['READER                         ', clc$nominal_entry, clc$normal_usage_entry, 5]]
        ],
      ['EXTERNAL_CHARACTERISTICS_1     ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['EXTERNAL_CHARACTERISTICS_2     ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['EXTERNAL_CHARACTERISTICS_3     ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['EXTERNAL_CHARACTERISTICS_4     ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['FILE_ACKNOWLEDGEMENT           ', clc$optional_field, 3], [[1, 0, clc$boolean_type]],
      ['FORMS_CODE_1                   ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['FORMS_CODE_2                   ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['FORMS_CODE_3                   ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['FORMS_CODE_4                   ', clc$optional_field, 8], [[1, 0, clc$string_type], [0, 6, FALSE]],
      ['FORMS_SIZE                     ', clc$optional_field, 35], [[1, 0, clc$real_type],
        [[{0.5} 3, [[4000(16), 800000000000(16)], [4000(16), 0(16)]]],
        [{31.0} 3, [[4005(16), 0F80000000000(16)], [4005(16), 0(16)]]]]
        ],
      ['MAXIMUM_FILE_SIZE              ', clc$optional_field, 20], [[1, 0, clc$integer_type], [0, 4294967295
  , 10]],
      ['PAGE_WIDTH                     ', clc$optional_field, 20], [[1, 0, clc$integer_type], [10, 255, 10]],
      ['STATION                        ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['TERMINAL_MODEL                 ', clc$optional_field, 69], [[1, 0, clc$union_type], [[
        clc$keyword_type, clc$name_type],
        FALSE, 2],
        44, [[1, 0, clc$keyword_type], [1], [
          ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
          ],
        5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
        ],
      ['TIP_TYPE                       ', clc$optional_field, 673], [[1, 0, clc$keyword_type], [18], [
        ['ASYNC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['AUTO                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['BISYNC_3270                    ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['BISYNC_NJEF                    ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['HASP                           ', clc$nominal_entry, clc$normal_usage_entry, 5],
        ['INTERNAL                       ', clc$nominal_entry, clc$normal_usage_entry, 6],
        ['MODE4                          ', clc$nominal_entry, clc$normal_usage_entry, 7],
        ['NTF                            ', clc$nominal_entry, clc$normal_usage_entry, 8],
        ['REMOTE_TERM_EMULATOR           ', clc$nominal_entry, clc$normal_usage_entry, 11],
        ['SNA_3270                       ', clc$nominal_entry, clc$normal_usage_entry, 9],
        ['TELNET                         ', clc$nominal_entry, clc$normal_usage_entry, 10],
        ['URI                            ', clc$nominal_entry, clc$normal_usage_entry, 12],
        ['USER1                          ', clc$nominal_entry, clc$normal_usage_entry, 13],
        ['USER2                          ', clc$nominal_entry, clc$normal_usage_entry, 14],
        ['USER3                          ', clc$nominal_entry, clc$normal_usage_entry, 15],
        ['USER4                          ', clc$nominal_entry, clc$normal_usage_entry, 16],
        ['X25_ASYNC                      ', clc$nominal_entry, clc$normal_usage_entry, 17],
        ['XPC                            ', clc$nominal_entry, clc$normal_usage_entry, 18]]
        ],
      ['TRANSMISSION_BLOCK_SIZE        ', clc$optional_field, 20], [[1, 0, clc$integer_type], [0, 65535, 10]
  ],
      ['UNDEFINED_FE_ACTION            ', clc$optional_field, 118], [[1, 0, clc$keyword_type], [3], [
        ['DISCARD_PRINT_LINE             ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['PRINT_AFTER_SPACING            ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['PRINT_BEFORE_SPACING           ', clc$nominal_entry, clc$normal_usage_entry, 3]]
        ],
      ['UNSUPPORTED_FE_ACTION          ', clc$optional_field, 118], [[1, 0, clc$keyword_type], [3], [
        ['DISCARD_PRINT_LINE             ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['PRINT_AFTER_SPACING            ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['PRINT_BEFORE_SPACING           ', clc$nominal_entry, clc$normal_usage_entry, 3]]
        ],
      ['VERTICAL_PRINT_DENSITY         ', clc$optional_field, 155], [[1, 0, clc$keyword_type], [4], [
        ['EIGHT_ANY                      ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['EIGHT_ONLY                     ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['SIX_ANY                        ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['SIX_ONLY                       ', clc$nominal_entry, clc$normal_usage_entry, 4]]
        ],
      ['VFU_LOAD_OPTION                ', clc$optional_field, 155], [[1, 0, clc$keyword_type], [4], [
        ['CHANGEABLE_BY_OPERATOR         ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['CHANGEABLE_BY_USER             ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['LOADED_AT_INITIALIZATION       ', clc$nominal_entry, clc$normal_usage_entry, 3],
        ['NOT_PRESENT_OR_LOADABLE        ', clc$nominal_entry, clc$normal_usage_entry, 4]]
        ],
      ['VFU_LOAD_PROCEDURE             ', clc$optional_field, 69], [[1, 0, clc$union_type], [[
        clc$keyword_type, clc$name_type],
        FALSE, 2],
        44, [[1, 0, clc$keyword_type], [1], [
          ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
          ],
        5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
        ]
      ];

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

      CONST
        a$banner_highlight_field = 1,
        a$banner_page_count = 2,
        a$carriage_control_support = 3,
        a$code_set = 4,
        a$device_alias_1 = 5,
        a$device_alias_2 = 6,
        a$device_alias_3 = 7,
        a$device_name = 8,
        a$device_type = 9,
        a$external_characteristics_1 = 10,
        a$external_characteristics_2 = 11,
        a$external_characteristics_3 = 12,
        a$external_characteristics_4 = 13,
        a$file_acknowledgement = 14,
        a$forms_code_1 = 15,
        a$forms_code_2 = 16,
        a$forms_code_3 = 17,
        a$forms_code_4 = 18,
        a$forms_size = 19,
        a$maximum_file_size = 20,
        a$page_width = 21,
        a$station = 22,
        a$terminal_model = 23,
        a$tip_type = 24,
        a$transmission_block_size = 25,
        a$undefined_fe_action = 26,
        a$unsupported_fe_action = 27,
        a$vertical_print_density = 28,
        a$vfu_load_option = 29,
        a$vfu_load_procedure = 30,
        max_field_value = 30;

      VAR
        preset: clt$data_value;

      pmp$get_unique_name (variable_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      variable_name (1, 1) := 'V';

      preset.kind := clc$record;
      PUSH preset.field_values: [1 .. max_field_value];

      preset.field_values^ [a$banner_highlight_field].name := 'BANNER_HIGHLIGHT_FIELD';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$banner_highlight_field].value;
        preset.field_values^ [a$banner_highlight_field].value^.kind := clc$keyword;
        CASE device_attributes.banner_highlight_field OF
        = nfc$comment_banner =
          preset.field_values^ [a$banner_highlight_field].value^.keyword_value := 'COMMENT_BANNER';
        = nfc$routing_banner =
          preset.field_values^ [a$banner_highlight_field].value^.keyword_value := 'ROUTING_BANNER';
        = nfc$site_banner =
          preset.field_values^ [a$banner_highlight_field].value^.keyword_value := 'SITE_BANNER';
        = nfc$user_file_name =
          preset.field_values^ [a$banner_highlight_field].value^.keyword_value := 'USER_FILE_NAME';
        = nfc$user_name =
          preset.field_values^ [a$banner_highlight_field].value^.keyword_value := 'USER_NAME';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$banner_highlight_field',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$banner_highlight_field].value := NIL;
      IFEND;

      preset.field_values^ [a$banner_page_count].name := 'BANNER_PAGE_COUNT';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$banner_page_count].value;
        preset.field_values^ [a$banner_page_count].value^.kind := clc$integer;
        preset.field_values^ [a$banner_page_count].value^.integer_value.radix_specified := FALSE;
        preset.field_values^ [a$banner_page_count].value^.integer_value.radix := 10;
        preset.field_values^ [a$banner_page_count].value^.integer_value.value :=
              device_attributes.banner_page_count;
      ELSE
        preset.field_values^ [a$banner_page_count].value := NIL;
      IFEND;

      preset.field_values^ [a$carriage_control_support].name := 'CARRIAGE_CONTROL_SUPPORT';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$carriage_control_support].value;
        preset.field_values^ [a$carriage_control_support].value^.kind := clc$keyword;
        CASE device_attributes.carriage_control_support OF
        = nfc$post_print =
          preset.field_values^ [a$carriage_control_support].value^.keyword_value := 'POST_PRINT';
        = nfc$pre_and_post_print =
          preset.field_values^ [a$carriage_control_support].value^.keyword_value := 'PRE_AND_POST_PRINT';
        = nfc$pre_print =
          preset.field_values^ [a$carriage_control_support].value^.keyword_value := 'PRE_PRINT';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$carriage_control_support',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$carriage_control_support].value := NIL;
      IFEND;

      preset.field_values^ [a$code_set].name := 'CODE_SET';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$code_set].value;
        preset.field_values^ [a$code_set].value^.kind := clc$keyword;
        CASE device_attributes.code_set OF
        = nfc$ascii =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII';
        = nfc$ascii_48 =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII_48';
        = nfc$ascii_64 =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII_64';
        = nfc$ascii_95 =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII_95';
        = nfc$ascii_128 =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII_128';
        = nfc$ascii_256 =
          preset.field_values^ [a$code_set].value^.keyword_value := 'ASCII_256';
        = nfc$bcd =
          preset.field_values^ [a$code_set].value^.keyword_value := 'BCD';
        = nfc$ebcdic =
          preset.field_values^ [a$code_set].value^.keyword_value := 'EBCDIC';
        = nfc$site_defined =
          preset.field_values^ [a$code_set].value^.keyword_value := 'SITE_DEFINED';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$code_set', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$code_set].value := NIL;
      IFEND;

      preset.field_values^ [a$device_alias_1].name := 'DEVICE_ALIAS_1';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$device_alias_1].value;
        IF device_attributes.device_alias_1 <> osc$null_name THEN
          preset.field_values^ [a$device_alias_1].value^.kind := clc$name;
          preset.field_values^ [a$device_alias_1].value^.name_value := device_attributes.device_alias_1;
        ELSE
          preset.field_values^ [a$device_alias_1].value^.kind := clc$keyword;
          preset.field_values^ [a$device_alias_1].value^.keyword_value := 'NONE';
        IFEND;
      ELSE
        preset.field_values^ [a$device_alias_1].value := NIL;
      IFEND;

      preset.field_values^ [a$device_alias_2].name := 'DEVICE_ALIAS_2';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$device_alias_2].value;
        IF device_attributes.device_alias_2 <> osc$null_name THEN
          preset.field_values^ [a$device_alias_2].value^.kind := clc$name;
          preset.field_values^ [a$device_alias_2].value^.name_value := device_attributes.device_alias_2;
        ELSE
          preset.field_values^ [a$device_alias_2].value^.kind := clc$keyword;
          preset.field_values^ [a$device_alias_2].value^.keyword_value := 'NONE';
        IFEND;
      ELSE
        preset.field_values^ [a$device_alias_2].value := NIL;
      IFEND;

      preset.field_values^ [a$device_alias_3].name := 'DEVICE_ALIAS_3';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$device_alias_3].value;
        IF device_attributes.device_alias_3 <> osc$null_name THEN
          preset.field_values^ [a$device_alias_3].value^.kind := clc$name;
          preset.field_values^ [a$device_alias_3].value^.name_value := device_attributes.device_alias_3;
        ELSE
          preset.field_values^ [a$device_alias_3].value^.kind := clc$keyword;
          preset.field_values^ [a$device_alias_3].value^.keyword_value := 'NONE';
        IFEND;
      ELSE
        preset.field_values^ [a$device_alias_3].value := NIL;
      IFEND;

      preset.field_values^ [a$device_name].name := 'DEVICE_NAME';
      PUSH preset.field_values^ [a$device_name].value;
      preset.field_values^ [a$device_name].value^.kind := clc$name;
      preset.field_values^ [a$device_name].value^.name_value := device_name;

      preset.field_values^ [a$device_type].name := 'DEVICE_TYPE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$device_type].value;
        preset.field_values^ [a$device_type].value^.kind := clc$keyword;
        CASE device_type OF
        = nfc$console =
          preset.field_values^ [a$device_type].value^.keyword_value := 'CONSOLE';
        = nfc$plotter =
          preset.field_values^ [a$device_type].value^.keyword_value := 'PLOTTER';
        = nfc$printer =
          preset.field_values^ [a$device_type].value^.keyword_value := 'PRINTER';
        = nfc$punch =
          preset.field_values^ [a$device_type].value^.keyword_value := 'PUNCH';
        = nfc$reader =
          preset.field_values^ [a$device_type].value^.keyword_value := 'READER';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$device_type', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$device_type].value := NIL;
      IFEND;

      preset.field_values^ [a$external_characteristics_1].name := 'EXTERNAL_CHARACTERISTICS_1';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$external_characteristics_1].value;
        preset.field_values^ [a$external_characteristics_1].value^.kind := clc$string;
        preset.field_values^ [a$external_characteristics_1].value^.string_value :=
              ^device_attributes.external_characteristics_1;
      ELSE
        preset.field_values^ [a$external_characteristics_1].value := NIL;
      IFEND;

      preset.field_values^ [a$external_characteristics_2].name := 'EXTERNAL_CHARACTERISTICS_2';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$external_characteristics_2].value;
        preset.field_values^ [a$external_characteristics_2].value^.kind := clc$string;
        preset.field_values^ [a$external_characteristics_2].value^.string_value :=
              ^device_attributes.external_characteristics_2;
      ELSE
        preset.field_values^ [a$external_characteristics_2].value := NIL;
      IFEND;

      preset.field_values^ [a$external_characteristics_3].name := 'EXTERNAL_CHARACTERISTICS_3';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$external_characteristics_3].value;
        preset.field_values^ [a$external_characteristics_3].value^.kind := clc$string;
        preset.field_values^ [a$external_characteristics_3].value^.string_value :=
              ^device_attributes.external_characteristics_3;
      ELSE
        preset.field_values^ [a$external_characteristics_3].value := NIL;
      IFEND;

      preset.field_values^ [a$external_characteristics_4].name := 'EXTERNAL_CHARACTERISTICS_4';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$external_characteristics_4].value;
        preset.field_values^ [a$external_characteristics_4].value^.kind := clc$string;
        preset.field_values^ [a$external_characteristics_4].value^.string_value :=
              ^device_attributes.external_characteristics_4;
      ELSE
        preset.field_values^ [a$external_characteristics_4].value := NIL;
      IFEND;

      preset.field_values^ [a$file_acknowledgement].name := 'FILE_ACKNOWLEDGEMENT';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$file_acknowledgement].value;
        preset.field_values^ [a$file_acknowledgement].value^.kind := clc$boolean;
        preset.field_values^ [a$file_acknowledgement].value^.boolean_value.kind := clc$true_false_boolean;
        preset.field_values^ [a$file_acknowledgement].value^.boolean_value.value :=
              device_attributes.file_acknowledgement;
      ELSE
        preset.field_values^ [a$file_acknowledgement].value := NIL;
      IFEND;

      preset.field_values^ [a$forms_code_1].name := 'FORMS_CODE_1';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$forms_code_1].value;
        preset.field_values^ [a$forms_code_1].value^.kind := clc$string;
        preset.field_values^ [a$forms_code_1].value^.string_value := ^device_attributes.forms_code_1;
      ELSE
        preset.field_values^ [a$forms_code_1].value := NIL;
      IFEND;

      preset.field_values^ [a$forms_code_2].name := 'FORMS_CODE_2';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$forms_code_2].value;
        preset.field_values^ [a$forms_code_2].value^.kind := clc$string;
        preset.field_values^ [a$forms_code_2].value^.string_value := ^device_attributes.forms_code_2;
      ELSE
        preset.field_values^ [a$forms_code_2].value := NIL;
      IFEND;

      preset.field_values^ [a$forms_code_3].name := 'FORMS_CODE_3';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$forms_code_3].value;
        preset.field_values^ [a$forms_code_3].value^.kind := clc$string;
        preset.field_values^ [a$forms_code_3].value^.string_value := ^device_attributes.forms_code_3;
      ELSE
        preset.field_values^ [a$forms_code_3].value := NIL;
      IFEND;

      preset.field_values^ [a$forms_code_4].name := 'FORMS_CODE_4';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$forms_code_4].value;
        preset.field_values^ [a$forms_code_4].value^.kind := clc$string;
        preset.field_values^ [a$forms_code_4].value^.string_value := ^device_attributes.forms_code_4;
      ELSE
        preset.field_values^ [a$forms_code_4].value := NIL;
      IFEND;

  { Special note about FORMS_SIZE:  the value provided by SCFS is in half-inches.
  { We divide this value by 2 to provide inches.

      preset.field_values^ [a$forms_size].name := 'FORMS_SIZE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$forms_size].value;
        preset.field_values^ [a$forms_size].value^.kind := clc$real;
        preset.field_values^ [a$forms_size].value^.real_value.value :=
              $LONGREAL (device_attributes.forms_size) / 2.0D+0;
        preset.field_values^ [a$forms_size].value^.real_value.number_of_digits := 3;
      ELSE
        preset.field_values^ [a$forms_size].value := NIL;
      IFEND;

      preset.field_values^ [a$maximum_file_size].name := 'MAXIMUM_FILE_SIZE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$maximum_file_size].value;
        preset.field_values^ [a$maximum_file_size].value^.kind := clc$integer;
        preset.field_values^ [a$maximum_file_size].value^.integer_value.radix_specified := FALSE;
        preset.field_values^ [a$maximum_file_size].value^.integer_value.radix := 10;
        preset.field_values^ [a$maximum_file_size].value^.integer_value.value :=
              device_attributes.maximum_file_size;
      ELSE
        preset.field_values^ [a$maximum_file_size].value := NIL;
      IFEND;

      preset.field_values^ [a$page_width].name := 'PAGE_WIDTH';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$page_width].value;
        preset.field_values^ [a$page_width].value^.kind := clc$integer;
        preset.field_values^ [a$page_width].value^.integer_value.radix_specified := FALSE;
        preset.field_values^ [a$page_width].value^.integer_value.radix := 10;
        preset.field_values^ [a$page_width].value^.integer_value.value := device_attributes.page_width;
      ELSE
        preset.field_values^ [a$page_width].value := NIL;
      IFEND;

      preset.field_values^ [a$station].name := 'STATION';
      PUSH preset.field_values^ [a$station].value;
      preset.field_values^ [a$station].value^.kind := clc$name;
      preset.field_values^ [a$station].value^.name_value := io_station_name;

      preset.field_values^ [a$terminal_model].name := 'TERMINAL_MODEL';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$terminal_model].value;
        IF device_attributes.terminal_model <> osc$null_name THEN
          preset.field_values^ [a$terminal_model].value^.kind := clc$name;
          preset.field_values^ [a$terminal_model].value^.name_value := device_attributes.terminal_model;
        ELSE
          preset.field_values^ [a$terminal_model].value^.kind := clc$keyword;
          preset.field_values^ [a$terminal_model].value^.keyword_value := 'NONE';
        IFEND;
      ELSE
        preset.field_values^ [a$terminal_model].value := NIL;
      IFEND;

      preset.field_values^ [a$tip_type].name := 'TIP_TYPE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$tip_type].value;
        preset.field_values^ [a$tip_type].value^.kind := clc$keyword;
        CASE device_attributes.tip_type OF
        = nfc$async_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'ASYNC';
        = nfc$auto_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'AUTO';
        = nfc$bisync_3270_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'BISYNC_3270';
        = nfc$bisync_njef_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'BISYNC_NJEF';
        = nfc$hasp_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'HASP';
        = nfc$internal_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'INTERNAL';
        = nfc$mode4_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'MODE4';
        = nfc$ntf_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'NTF';
        = nfc$sna_3270_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'SNA_3270';
        = nfc$telnet_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'TELNET';
        = nfc$remote_term_emulator_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'REMOTE_TERM_EMULATOR';
        = nfc$uri_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'URI';
        = nfc$user1_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'USER1';
        = nfc$user2_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'USER2';
        = nfc$user3_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'USER3';
        = nfc$user4_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'USER4';
        = nfc$x25_async_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'X25_ASYNC';
        = nfc$xpc_tip =
          preset.field_values^ [a$tip_type].value^.keyword_value := 'XPC';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$tip_type', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$tip_type].value := NIL;
      IFEND;

      preset.field_values^ [a$transmission_block_size].name := 'TRANSMISSION_BLOCK_SIZE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$transmission_block_size].value;
        preset.field_values^ [a$transmission_block_size].value^.kind := clc$integer;
        preset.field_values^ [a$transmission_block_size].value^.integer_value.radix_specified := FALSE;
        preset.field_values^ [a$transmission_block_size].value^.integer_value.radix := 10;
        preset.field_values^ [a$transmission_block_size].value^.integer_value.value :=
              device_attributes.transmission_block_size;
      ELSE
        preset.field_values^ [a$transmission_block_size].value := NIL;
      IFEND;

      preset.field_values^ [a$undefined_fe_action].name := 'UNDEFINED_FE_ACTION';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$undefined_fe_action].value;
        preset.field_values^ [a$undefined_fe_action].value^.kind := clc$keyword;
        CASE device_attributes.undefined_fe_action OF
        = nfc$discard_print_line =
          preset.field_values^ [a$undefined_fe_action].value^.keyword_value := 'DISCARD_PRINT_LINE';
        = nfc$print_after_spacing =
          preset.field_values^ [a$undefined_fe_action].value^.keyword_value := 'PRINT_AFTER_SPACING';
        = nfc$print_before_spacing =
          preset.field_values^ [a$undefined_fe_action].value^.keyword_value := 'PRINT_BEFORE_SPACING';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$undefined_fe_action',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$undefined_fe_action].value := NIL;
      IFEND;

      preset.field_values^ [a$unsupported_fe_action].name := 'UNSUPPORTED_FE_ACTION';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$unsupported_fe_action].value;
        preset.field_values^ [a$unsupported_fe_action].value^.kind := clc$keyword;
        CASE device_attributes.unsupported_fe_action OF
        = nfc$discard_print_line =
          preset.field_values^ [a$unsupported_fe_action].value^.keyword_value := 'DISCARD_PRINT_LINE';
        = nfc$print_after_spacing =
          preset.field_values^ [a$unsupported_fe_action].value^.keyword_value := 'PRINT_AFTER_SPACING';
        = nfc$print_before_spacing =
          preset.field_values^ [a$unsupported_fe_action].value^.keyword_value := 'PRINT_BEFORE_SPACING';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$unsupported_fe_action',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$unsupported_fe_action].value := NIL;
      IFEND;

      preset.field_values^ [a$vertical_print_density].name := 'VERTICAL_PRINT_DENSITY';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$vertical_print_density].value;
        preset.field_values^ [a$vertical_print_density].value^.kind := clc$keyword;
        CASE device_attributes.vertical_print_density OF
        = nfc$eight_any =
          preset.field_values^ [a$vertical_print_density].value^.keyword_value := 'EIGHT_ANY';
        = nfc$eight_only =
          preset.field_values^ [a$vertical_print_density].value^.keyword_value := 'EIGHT_ONLY';
        = nfc$six_any =
          preset.field_values^ [a$vertical_print_density].value^.keyword_value := 'SIX_ANY';
        = nfc$six_only =
          preset.field_values^ [a$vertical_print_density].value^.keyword_value := 'SIX_ONLY';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$vertical_print_density',
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$vertical_print_density].value := NIL;
      IFEND;

      preset.field_values^ [a$vfu_load_option].name := 'VFU_LOAD_OPTION';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$vfu_load_option].value;
        preset.field_values^ [a$vfu_load_option].value^.kind := clc$keyword;
        CASE device_attributes.vfu_load_option OF
        = nfc$vfu_changeable_by_operator =
          preset.field_values^ [a$vfu_load_option].value^.keyword_value := 'CHANGEABLE_BY_OPERATOR';
        = nfc$vfu_changeable_by_user =
          preset.field_values^ [a$vfu_load_option].value^.keyword_value := 'CHANGEABLE_BY_USER';
        = nfc$vfu_loaded_at_init =
          preset.field_values^ [a$vfu_load_option].value^.keyword_value := 'LOADED_AT_INITIALIZATION';
        = nfc$vfu_not_present_or_load =
          preset.field_values^ [a$vfu_load_option].value^.keyword_value := 'NOT_PRESENT_OR_LOADABLE';
        ELSE
          osp$set_status_abnormal (nfc$status_id, nfe$invalid_parameter_value, 'nfc$vfu_load_option', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, 'device_attributes in FILE_ASSIGNMENT',
                status);
          RETURN;
        CASEND;
      ELSE
        preset.field_values^ [a$vfu_load_option].value := NIL;
      IFEND;

      preset.field_values^ [a$vfu_load_procedure].name := 'VFU_LOAD_PROCEDURE';
      IF device_attributes.attributes_received THEN
        PUSH preset.field_values^ [a$vfu_load_procedure].value;
        IF device_attributes.vfu_load_procedure <> osc$null_name THEN
          preset.field_values^ [a$vfu_load_procedure].value^.kind := clc$name;
          preset.field_values^ [a$vfu_load_procedure].value^.name_value :=
                device_attributes.vfu_load_procedure;
        ELSE
          preset.field_values^ [a$vfu_load_procedure].value^.kind := clc$keyword;
          preset.field_values^ [a$vfu_load_procedure].value^.keyword_value := 'NONE';
        IFEND;
      ELSE
        preset.field_values^ [a$vfu_load_procedure].value := NIL;
      IFEND;

      clp$create_environment_variable (variable_name, clc$job_scope, clc$read_only,
            clc$immediate_evaluation, #SEQ (type_specification), ^preset, status);

    PROCEND create_device_attributes_var;

?? OLDTITLE ??
?? NEWTITLE := '    descriptor_values_match' , EJECT ??

{}
{  PURPOSE:
{    This procedure compares SCFS's values for the output file with SCF'S values for
{    the file.  If the values sent by SCFS match those of the descriptor, then SCFS
{    has the most recent output file information.  If the values sent by SCFS
{    do not match the descriptor, there are outstanding modifies to be processed.
{}

    FUNCTION descriptor_values_match (dummy_descriptor: jmt$output_descriptor;
          descriptor: jmt$output_descriptor;
          output_state: nft$file_transfer_state;
          last_parameter_sent: nft$file_assignment_params): boolean;

      VAR
        match: boolean;

      match := TRUE;

      IF last_parameter_sent > nfc$null_parameter THEN
        match := (dummy_descriptor.station = descriptor.station) AND
                (dummy_descriptor.device = descriptor.device) AND
                (dummy_descriptor.station_operator = descriptor.station_operator) AND
                (dummy_descriptor.output_destination_family = descriptor.output_destination_family) AND
                (dummy_descriptor.copies = descriptor.copies) AND
                (dummy_descriptor.external_characteristics = descriptor.external_characteristics)
                AND (dummy_descriptor.forms_code = descriptor.forms_code) AND
                (dummy_descriptor.vfu_load_procedure = descriptor.vfu_load_procedure) AND
                (dummy_descriptor.output_destination_usage = descriptor.output_destination_usage) AND
                (dummy_descriptor.vertical_print_density = descriptor.vertical_print_density);

{  If the file is in a hold state, the output priority isn't checked.  Since a file
{  assignment is coming in, the file has been selected and consequently,
{  the priority has been set to the maximum value.

        IF match AND (output_state <> nfc$hold_transfer) THEN
          match := match AND (dummy_descriptor.output_priority = descriptor.output_priority);
        IFEND;
      IFEND;

      descriptor_values_match := match;

    FUNCEND descriptor_values_match;
?? OLDTITLE, EJECT ??

   status.normal := TRUE;

   control_facility := NIL;
   scfs_values_match_descriptor := TRUE;

{  Get the parameters sent on the file assignment message and then verify
{  that the values sent from SCFS match those in SCF's copy of the file
{  descriptor.  If they do not, SCFS must process outstanding modifies and
{  the current file assignment message will be rejected.

    nfp$crack_file_assignment_msg (message, msg_length, io_station_name, device_name, device_type,
          device_attributes, btfs_di_xns_address, btfs_di_title, system_file_name, application_file,
          remote_system_protocol, remote_system_type, route_back_position, last_parameter_sent, status);

    message_response := nfc$file_assignment_rejected;

{ Set the appropriate BTFS/DI address:
{   - If there is a BTFS/DI title then get its network address.
{   - If there is no BTFS/DI title then use BTFS/DI XNS address (unless this
{     mainframe only supports OSI, which means SCF cannot support the transfer)

    IF status.normal AND (btfs_di_title.length > 0) THEN
      nfp$get_btfs_di_address (btfs_di_title, client_name, io_station_name, device_name,
            wait_list, wait_activity_list, btfs_di_network_address, status);
      IF (NOT status.normal) AND (status.condition = nae$no_translation_available) THEN
        message_response := nfc$btfsdi_title_not_translated;
      IFEND;
    ELSE
      protocol_stacks := nap$supported_protocol_stacks ();
      IF (((protocol_stacks DIV nac$xns_protocol_stack) DIV 2) * 2) <>
            (protocol_stacks DIV nac$xns_protocol_stack) THEN
        btfs_di_network_address.kind := nac$internet_address;
        btfs_di_network_address.internet_address := btfs_di_xns_address;
      ELSE
        osp$set_status_abnormal (nfc$status_id, nfe$incompatible_address_kind,
              ' ', status);
      IFEND;
    IFEND;

    IF status.normal THEN

      find_file_and_descriptor (system_file_name, first_destination, current_file, descriptor_found);
      IF descriptor_found THEN
        IF last_parameter_sent > nfc$null_parameter THEN
          scfs_values_match_descriptor := descriptor_values_match (application_file.output_descriptor,
                current_file^.output_descriptor, current_file^.transfer_state, last_parameter_sent);
        IFEND;

        IF (scfs_values_match_descriptor) AND ((NOT current_file^.transfer_initiated) OR
              ((current_file^.transfer_initiated) AND (current_file^.transfer_state = nfc$hold_transfer)))
              THEN

{ First control facility to respond to notification that a file was available for printing.

          application_file.output_descriptor := current_file^.output_descriptor;
          find_destination (application_file.output_descriptor.station, first_destination,
                destination_found, destination);
          IF destination_found THEN

{  Send a delete file available message to the control facilities with that
{  destination that haven't responded yet.

            control_facility_entry := destination^.control_facility_list;

          /search_control_facility_list/
            WHILE control_facility_entry <> NIL DO

              next_control_facility_entry := control_facility_entry^.link;
              IF control_facility_entry^.control_facility^.connection_id <> connection_id THEN
                nfp$send_delete_file_available (application_file, {held} FALSE, {requeued} FALSE,
                      control_facility_entry^.control_facility^.connection_id, message, status);
                IF (NOT status.normal) AND ((status.condition <> nae$no_data_available) AND
                        (status.condition <> nfe$invalid_descriptor_value)) THEN
                  remove_control_facility(first_destination, control_facility_entry^.control_facility ,
                        wait_list, wait_activity_list, status);
                  IF (NOT status.normal) AND ((status.condition = nae$application_inactive)
                        OR (status.condition = nae$unknown_application)) THEN
                    RETURN;
                  IFEND;
                IFEND;
              ELSE

{  Save the control facility which has the output file.  }

                control_facility := control_facility_entry^.control_facility;
              IFEND;
              control_facility_entry := next_control_facility_entry;
            WHILEND /search_control_facility_list/;
          IFEND;

{ Attempt to set the output status to 'printing'.  A status of abnormal indicates
{ that the file has been modified or terminated.  If the output has been
{ modified, it may not be set to 'printing' until the modify has been processed
{ If the file has been terminated, the file assignment message will be rejected.

          jmp$set_output_initiated (current_file^.output_descriptor.output_destination_usage,
                current_file^.output_descriptor.system_file_name, status);
          IF status.normal THEN
            current_file^.transfer_initiated := TRUE;
            current_file^.control_facility := control_facility;
            IF current_file^.output_descriptor.output_destination_usage = jmc$public_usage THEN
              application_file.q_file_password := public_queue_file_password;
            ELSE
              application_file.q_file_password := private_queue_file_password;
            IFEND;

            create_device_attributes_var (device_name, device_type, device_attributes, io_station_name,
                  device_attributes_variable, status);

            IF status.normal THEN
              nfp$start_btf_ve_task (btfs_di_network_address, btfs_di_title, io_station_name, device_name,
                    device_attributes_variable, device_attributes.attributes_received, application_file,
                    osc$null_name, debug_async_task, wait_list, wait_activity_list, wait_list_seq,
                    wait_activity_list_seq, btf_task, status);
              IF status.normal THEN
                current_file^.transfer_state := nfc$selected_for_transfer;
                current_file^.btf_task := btf_task;
                nfv$wait_activity_list := wait_activity_list;
                message_response := nfc$file_assignment_accepted;
              IFEND;
            IFEND;
          IFEND;

{ STATUS will be from JMP$SET_OUTPUT_INITIATED or CREATE_DEVICE_ATTRIBUTES_VAR or
{ NFP$START_BTF_VE_TASK.

          IF (NOT status.normal) AND current_file^.transfer_initiated THEN
            pmp$log ('**** SCF - Abnormal status (1) in file assignment message', local_status);
            nap$display_message (status);
            jmp$set_output_completed (current_file^.output_descriptor.output_destination_usage,
                  current_file^.output_descriptor.system_file_name, FALSE, ignore_status);
            current_file^.transfer_initiated := FALSE;
            current_file^.control_facility := NIL;
            remove_file_from_list (current_file^.output_descriptor.system_file_name,
                  destination^);
            nfp$send_delete_file_available (application_file, {held} FALSE, {requeued} FALSE,
                  connection_id, message, status);
          IFEND;

        IFEND;
      IFEND;
    ELSE
      pmp$log ('**** SCF - Abnormal status (2) in file assignment message', local_status);
      nap$display_message (status);
    IFEND;

    nfp$send_file_assignment_resp (io_station_name, device_name, system_file_name, message_response,
          connection_id, message, status);

  PROCEND file_assignment_message;
?? TITLE := '  find_destination', EJECT ??

{}
{  PURPOSE:
{    This procedure determines if the destination name is in SCF/VEs current
{    list of destinations.  If the destination was found, a pointer to
{    the destination is returned.
{}

  PROCEDURE find_destination (name: ost$name;
        first_destination: ^nft$destination;
    VAR destination_found: boolean;
    VAR destination: ^nft$destination);


    destination_found := FALSE;
    destination := first_destination;

  /search_destination_list/
    WHILE NOT destination_found AND (destination <> NIL) DO
      destination_found := name = destination^.name;
      IF NOT destination_found THEN
        destination := destination^.link;
      IFEND;
    WHILEND /search_destination_list/;

  PROCEND find_destination;
?? TITLE := '  find_file_and_descriptor', EJECT ??

{}
{  PURPOSE:
{    This procedure determines if the specified system file name is in
{    the list of files known to SCF/VE.
{}

  PROCEDURE find_file_and_descriptor (system_file_name: jmt$system_supplied_name;
        first_destination: ^nft$destination;
    VAR current_file: ^nft$available_file;
    VAR descriptor_found: boolean);

    VAR
      destination: ^nft$destination;


    destination := first_destination;
    descriptor_found := FALSE;

  /search_destination_list/
    WHILE NOT descriptor_found AND (destination <> NIL) DO
      current_file := destination^.file_list;

    /search_file_list/
      WHILE NOT descriptor_found AND (current_file <> NIL) DO

        descriptor_found := current_file^.output_descriptor.system_file_name = system_file_name;
        IF NOT descriptor_found THEN
          current_file := current_file^.link;
        IFEND;

      WHILEND /search_file_list/;

      destination := destination^.link;
    WHILEND /search_destination_list/;

  PROCEND find_file_and_descriptor;
?? TITLE := '  find_file_in_list', EJECT ??

{}
{  PURPOSE:
{    This procedure returns a pointer to the specified file.  If the file
{    was not found in the list of files known to SCF/VE, a nil pointer is
{    returned.
{}

  PROCEDURE find_file_in_list (system_file_name: jmt$system_supplied_name;
        first_destination: ^nft$destination;
    VAR requested_file: ^nft$available_file;
    VAR destination: ^nft$destination);

    VAR
      current_file: ^nft$available_file,
      file_found: boolean;


    destination := first_destination;
    file_found := FALSE;

  /search_destination_list/
    WHILE NOT file_found AND (destination <> NIL) DO
      current_file := destination^.file_list;

    /search_file_list/
      WHILE NOT file_found AND (current_file <> NIL) DO

        file_found := current_file^.output_descriptor.system_file_name = system_file_name;
        IF file_found THEN
          requested_file := current_file;
        ELSE
          current_file := current_file^.link;
        IFEND;

      WHILEND /search_file_list/;

      IF NOT file_found THEN
        destination := destination^.link;
      IFEND;

    WHILEND /search_destination_list/;

    IF NOT file_found THEN
      requested_file := NIL;
    IFEND;

  PROCEND find_file_in_list;
?? TITLE := '  get_control_facility', EJECT ??

{}
{  PURPOSE:
{    This procedure returns a list of control facility entries that
{    presently control a station with the destination name specified.
{}

  PROCEDURE get_control_facility (activity_index: integer;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR destination: nft$destination;
    VAR control_facility_list: ^nft$linked_list_entry;
    VAR message: ^nft$message_sequence;
    VAR status: ost$status);

    VAR
      connection_file: ^fst$file_reference,
      connection_id: amt$file_identifier,
      control_facility: ^nft$control_facility,
      control_facility_name: ost$name,
      index: integer,
      known_control_facility: boolean,
      translation_address_array: ^ARRAY [1 .. * ] OF nat$network_address,
      translation_address_sequence: ^SEQ (*),
      unique_name: ost$name;

?? NEWTITLE := '    get_cf_with_service_address', EJECT ??

{}
{  PURPOSE:
{    Get the control facility that corresponds to an address returned
{    on the title translation for the destination name.
{}

    PROCEDURE get_cf_with_service_address (service: nat$network_address;
          wait_activity_list: ^nft$wait_activity_list;
      VAR control_facility: ^nft$control_facility;
      VAR control_facility_found: boolean);

      VAR
        i: integer,
        limit: integer;

      control_facility_found := FALSE;
      IF wait_activity_list <> NIL THEN
        limit := UPPERBOUND (wait_activity_list^);

      /search_wait_activity_list/
        FOR i := LOWERBOUND (wait_activity_list^) TO limit DO

          IF wait_activity_list^ [i].kind = nfc$control_facility_connection THEN
            IF wait_activity_list^ [i].cf <> NIL THEN
              IF nfp$network_addresses_match (service, wait_activity_list^ [i].cf^.service_addr) THEN
                IF service.kind = wait_activity_list^ [i].cf^.service_addr.kind THEN
                  IF service.kind = nac$osi_transport_address THEN
                    control_facility_found := service.osi_transport_address.
                          transport_sap_selector (1, service.osi_transport_address.
                          transport_sap_selector_length) = wait_activity_list^ [i].cf^.service_addr.
                          osi_transport_address.transport_sap_selector
                          (1, wait_activity_list^ [i].cf^.service_addr.osi_transport_address.
                          transport_sap_selector_length);
                  ELSEIF service.kind = nac$internet_address THEN
                    control_facility_found := service.internet_address.sap = wait_activity_list^ [i].
                          cf^.service_addr.internet_address.sap;
                  IFEND;
                IFEND;
              IFEND;
              IF control_facility_found THEN
                control_facility := wait_activity_list^ [i].cf;
                RETURN;
              IFEND;
            IFEND;
          IFEND;

        FOREND /search_wait_activity_list/;
      IFEND;

    PROCEND get_cf_with_service_address;
?? TITLE := '    get_title_translation_address', EJECT ??

{}
{  PURPOSE:
{    A translation request was made previously via nap$begin_directory_search.  This
{    procedure gets the title translations, obtaining the addresses which
{    correspond to the various locations of the title within the network.
{}

    PROCEDURE get_title_translation_address (activity_index: integer;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR destination: nft$destination;
      VAR translation_address_sequence: ^SEQ (*);
      VAR translation_address_array: ^ARRAY [1 .. * ] OF nat$network_address;
      VAR status: ost$status);

      CONST
        max_addresses = 100,
        translation_wait_time = 0;

      VAR
        activity: nft$wait_activity,
        number_of_addresses: 0..max_addresses,
        recurrent_search: boolean,
        translation_address: nat$network_address,
        translation_address_ptr: ^nat$network_address,
        translation_attributes: ^nat$translation_attributes,
        translation_status: ost$status;


      status.normal := TRUE;
      number_of_addresses := 0;
      ALLOCATE translation_address_sequence: [[REP max_addresses of nat$network_address]];
      RESET translation_address_sequence;

{  Get all the addresses that correspond to the title translation.

      REPEAT
        translation_attributes := NIL;

        nap$get_title_translation (wait_list^ [activity_index].translation_request, translation_wait_time,
              translation_attributes, translation_address, translation_status);
        IF translation_status.normal THEN
          NEXT translation_address_ptr IN translation_address_sequence;
          translation_address_ptr^ := translation_address;
          number_of_addresses := number_of_addresses + 1;
        IFEND;

      UNTIL (NOT translation_status.normal);

{  Pass the translation addresses back to the calling procedure.

      IF number_of_addresses > 0 THEN
        RESET translation_address_sequence;
        NEXT translation_address_array: [1..number_of_addresses] IN translation_address_sequence;
      IFEND;

      IF translation_status.condition = nae$invalid_directory_search_id THEN
        reissue_translation_request (activity_index, wait_list, destination,
              status);
      IFEND;

    PROCEND get_title_translation_address;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    known_control_facility := FALSE;
    control_facility_list := NIL;
    control_facility := NIL;
    translation_address_array := NIL;
    translation_address_sequence := NIL;

    get_title_translation_address (activity_index, wait_list, wait_activity_list, destination,
          translation_address_sequence, translation_address_array, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

{ For each address returned on the title translation, add the corresponding
{ control facility to the wait lists if it isn't known, and add the
{ corresponding control facility to the control facility list.

    IF translation_address_array <> NIL THEN
      FOR index := 1 TO UPPERBOUND(translation_address_array^) DO

{  Get the control facility that corresponds to the particular address. }

        get_cf_with_service_address (translation_address_array^[index], wait_activity_list, control_facility,
              known_control_facility);
        IF NOT known_control_facility THEN
          pmp$get_unique_name (unique_name, status);
          connection_file := ^unique_name;

{  Establish a connection with the unknown control facility.

          nfp$establish_cf_connection (translation_address_array^[index], connection_file^,
                nfc$scfs_client_data_version, nfc$scf_ve_client, client_name, control_facility_name,
                connection_id, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          ELSEIF status.normal THEN

{ Send BTF/VE Status Message to the new control facility

            nfp$send_btf_ve_status (connection_id, message, status);

{  Add the control facility to the wait lists and to the control facility list.
            IF status.normal THEN
              add_control_facility_to_lists (control_facility_name, connection_file^, connection_id,
                    translation_address_array^[index], wait_list, wait_activity_list, control_facility);
              add_cf_to_control_fac_list(control_facility, control_facility_list);
            IFEND;
          IFEND;
        ELSE {control facility is currently known to SCFS}
          IF NOT cf_in_dest_control_fac_list (control_facility, control_facility_list) THEN
            add_cf_to_control_fac_list(control_facility, control_facility_list);
          IFEND;
        IFEND;
      FOREND;
    IFEND;

    FREE translation_address_sequence;

  PROCEND get_control_facility;
?? TITLE := '  get_destination_and_cntrl_fac', EJECT ??

{}
{  PURPOSE:
{    Check if the specified destination name is known, if it is not
{    known, add it to the destination list, add a title translation
{    for the destination and get the control facilities that have
{    a destination by that name.
{}

  PROCEDURE get_destination_and_cntrl_fac (destination_name: ost$name;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR destination_list: ^nft$destination;
    VAR destination: ^nft$destination;
    VAR message: ^nft$message_sequence;
    VAR status: ost$status);

    VAR
      control_facility_list: ^nft$linked_list_entry,
      destination_found: boolean,
      local_status: ost$status;


    status.normal := TRUE;

    find_destination (destination_name, destination_list, destination_found, destination);

    IF NOT destination_found THEN
      add_destination_to_list (destination_name, destination_list, destination);

      add_await_title_translation(destination^, wait_list, wait_activity_list, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      get_control_facility (UPPERBOUND(wait_list^) , wait_list, wait_activity_list,
            destination^, control_facility_list, message, status);
      IF status.normal THEN
        destination^.control_facility_list := control_facility_list;
      IFEND;
    IFEND;

  PROCEND get_destination_and_cntrl_fac;
?? TITLE := '  initialize_scf_ve', EJECT ??

{}
{  PURPOSE:
{    Determine the "client name" for SCF/VE and
{    allocate space for messages sent and received on the network and
{    for the wait lists.
{}

  PROCEDURE initialize_scf_ve (parameter_list: clt$parameter_list;
    VAR public_queue_file_password: jmt$queue_file_password;
    VAR private_queue_file_password: jmt$queue_file_password;
    VAR wait_list: ^ost$i_wait_list;
    VAR message_area: ^nft$message_sequence;
    VAR status: ost$status);

    CONST
      eight_minutes = 8 * 60 * 1000, {milliseconds}
      max_wait_list_entries = 100;


    status.normal := TRUE;

    jmp$register_output_application (client_name, jmc$public_usage,
          public_queue_file_password, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    jmp$register_output_application (client_name, jmc$private_usage,
          private_queue_file_password, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, scf_command_pdt, status);
    IF status.normal THEN

      ALLOCATE message_area: [[REP nfc$maximum_message_length OF cell]];

      ALLOCATE wait_activity_list_seq: [[REP max_wait_list_entries OF nft$wait_activity]];

      ALLOCATE wait_list_seq: [[REP max_wait_list_entries OF ost$i_activity]];
      RESET wait_list_seq;
      NEXT wait_list: [1 .. 2] IN wait_list_seq;
      wait_list^ [1].activity := osc$i_await_unspecified_event;
      wait_list^ [2].activity := osc$i_await_time;
      wait_list^ [2].milliseconds := eight_minutes;

      nfp$create_appl_def_segment_var (nfc$appl_def_segment_for_scf, wait_list_seq);
    IFEND;

  PROCEND initialize_scf_ve;
?? OLDTITLE ??
?? NEWTITLE := 'reissue_translation_request', EJECT ??

{}
{  PURPOSE:
{    This procedure reissues a translation request that was previously
{    made via nap$begin_directory_search in the event that the translation
{    request becomes inactive.
{}

  PROCEDURE reissue_translation_request (index: integer;
    VAR wait_list: ^ost$i_wait_list;
    VAR destination: nft$destination;
    VAR status: ost$status);

    VAR
      recurrent_search: boolean,
      title: ^nat$title_pattern,
      translation_attributes: ^nat$translation_attributes;


    PUSH title: [start_of_scfs_title_length + osc$max_name_size];
    title^ (1, start_of_scfs_title_length) := start_of_scfs_title;
    title^ (1 + start_of_scfs_title_length, * ) := destination.name;

{  If a recurrent search is requested, distributed translations will continue }
{  to be examined and SCF will be notified of any new titles having the  }
{  specified characteristics. }

    recurrent_search := TRUE;
    nap$begin_directory_search (title^, client_name, recurrent_search, wait_list^ [index].
          translation_request, status);

    IF status.normal THEN
      destination.title_search_id := wait_list^ [index].translation_request;
      destination.translation_time_stamp := #FREE_RUNNING_CLOCK (0);
    IFEND;

  PROCEND reissue_translation_request;
?? TITLE := '  remove_control_facility', EJECT ??


{}
{  PURPOSE:
{    This procedure is called in the event that all reference to a specific
{    control facility should be removed.  The control facility is removed
{    from the destination lists and from the files.  The connection SCF/VE
{    has with the control facility is closed and the control facility is
{    removed from the wait lists.
{}

  PROCEDURE remove_control_facility (first_destination: ^nft$destination;
    VAR control_facility: ^nft$control_facility;
    VAR wait_list: ^ost$i_wait_list;
    VAR wait_activity_list: ^nft$wait_activity_list;
    VAR status: ost$status);

    VAR
      available_file: ^nft$available_file,
      cf_found_in_list: boolean,
      cf_list_entry: ^nft$linked_list_entry,
      destination: ^nft$destination,
      file_id: amt$file_identifier,
      file_name: amt$local_file_name,
      ignore_status: ost$status;

?? NEWTITLE := '    post_new_title_translation_req', EJECT ??

    PROCEDURE post_new_title_translation_req (destination: ^nft$destination;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR status: ost$status);

      VAR
        high: integer,
        ignore_status: ost$status,
        index: integer,
        low: integer;


      status.normal := TRUE;

      low := LOWERBOUND (wait_activity_list^);
      high := UPPERBOUND (wait_activity_list^);

    /search_for_translation_request/
      FOR index := low TO high DO
        IF (wait_activity_list^[index].kind = nfc$title_translation_request) AND (wait_activity_list^[index].
              dest = destination) THEN
          nap$end_directory_search (destination^.title_search_id, ignore_status);
          reissue_translation_request (index, wait_list, destination^, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          IFEND;
        IFEND;
      FOREND /search_for_translation_request/;

    PROCEND post_new_title_translation_req;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;

    destination := first_destination;
    IF control_facility <> NIL THEN
      file_id := control_facility^.connection_id;
      file_name := control_facility^.connection_file_name;
    IFEND;

    /search_destination_list/
    WHILE destination <> NIL DO

      cf_found_in_list := FALSE;
      cf_list_entry := destination^.control_facility_list;

      /remove_cf_from_destination/
      WHILE (cf_list_entry <> NIL) AND (NOT cf_found_in_list) DO
        IF cf_list_entry^.control_facility = control_facility THEN
          cf_found_in_list := TRUE;
          remove_linked_list_entry (cf_list_entry, destination^.control_facility_list);

          post_new_title_translation_req (destination, wait_list, wait_activity_list, status);

          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          IFEND;

          available_file := destination^.file_list;

          /remove_cf_from_file_list/
          WHILE available_file <> NIL DO
            IF available_file^.control_facility = control_facility THEN
              available_file^.control_facility := NIL;
            IFEND;
            available_file := available_file^.link;
          WHILEND /remove_cf_from_file_list/;
        IFEND;
        IF NOT cf_found_in_list THEN
          cf_list_entry := cf_list_entry^.link;
        IFEND;
      WHILEND /remove_cf_from_destination/;
      destination := destination^.link;
    WHILEND /search_destination_list/;

    fsp$close_file (file_id, ignore_status);
    amp$return (file_name, ignore_status);

    nfp$remove_from_wait_lists (control_facility^.wait_activity_index, wait_list, wait_activity_list,
          wait_list_seq, wait_activity_list_seq);

    control_facility := NIL;

  PROCEND remove_control_facility;
?? TITLE := '  remove_file_from_list', EJECT ??

{}
{  PURPOSE:
{    This procedure removes a file from the destinations file list.
{}

  PROCEDURE remove_file_from_list (system_file_name: jmt$system_supplied_name;
    VAR destination: nft$destination);

    VAR
      current_file: ^nft$available_file,
      file_found: boolean,
      status: ost$status;


    current_file := destination.file_list;

    IF current_file^.output_descriptor.system_file_name = system_file_name THEN
      destination.file_list := current_file^.link;
    ELSE
      file_found := FALSE;

    /search_file_list/
      WHILE (NOT file_found) AND (current_file <> NIL) DO
        file_found := current_file^.output_descriptor.system_file_name = system_file_name;
        IF file_found THEN
          current_file^.back_link^.link := current_file^.link;
        ELSE
          current_file := current_file^.link;
        IFEND;
      WHILEND /search_file_list/;
    IFEND;

    IF current_file^.link <> NIL THEN
      current_file^.link^.back_link := current_file^.back_link;
    IFEND;

    IF current_file <> NIL THEN
      FREE current_file;
    IFEND;

  PROCEND remove_file_from_list;
?? TITLE := '  remove_linked_list_entry', EJECT ??

{}
{  PURPOSE:
{    This procedure removes the specified link entry from the
{    doubly linked list.
{}

  PROCEDURE remove_linked_list_entry (VAR link_entry: ^nft$linked_list_entry;
        VAR linked_list: ^nft$linked_list_entry);

    VAR
      back_link: ^nft$linked_list_entry,
      current_link: ^nft$linked_list_entry,
      link: ^nft$linked_list_entry;

    current_link := link_entry;
    back_link := link_entry^.back_link;
    link := link_entry^.link;

    IF link <> NIL THEN
      link^.back_link := back_link;
    IFEND;

    IF back_link <> NIL THEN
      back_link^.link := link;
    IFEND;

    IF link_entry = linked_list THEN
      linked_list := link;
    IFEND;

    link_entry := link;

    FREE current_link;

  PROCEND remove_linked_list_entry;
?? TITLE := '  send_add_file_to_ctrl_facs', EJECT ??

{}
{  PURPOSE:
{    This procedure loops through the list of control facility entries and
{    sends an add file available message.
{}

  PROCEDURE send_add_file_to_ctrl_facs (VAR control_facility_list:  ^nft$linked_list_entry;
        output_descriptor:  jmt$output_descriptor;
        output_state: nft$file_transfer_state;
        destination_list:  ^nft$destination;
    VAR wait_list:  ^ost$i_wait_list;
    VAR wait_activity_list:  ^nft$wait_activity_list;
    VAR message:  ^nft$message_sequence;
    VAR status:  ost$status);

    VAR
      application_file: nft$application_file_descriptor,
      control_facility_entry: ^nft$linked_list_entry,
      next_control_facility_entry: ^nft$linked_list_entry;

    application_file.file_kind := nfc$output_file;
    application_file.output_descriptor := output_descriptor;

    control_facility_entry := control_facility_list;


  /search_control_facility_list/
    WHILE control_facility_entry <> NIL DO

      nfp$send_add_file_available (application_file, output_state,
            control_facility_entry^.control_facility^.connection_id, message, status);
      next_control_facility_entry := control_facility_entry^.link;
      IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
            (status.condition <> nfe$invalid_descriptor_value)) THEN
        remove_control_facility (destination_list, control_facility_entry^.control_facility,
              wait_list, wait_activity_list, status);
        IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
              nae$unknown_application)) THEN
          RETURN;
        IFEND;
      IFEND;
      control_facility_entry := next_control_facility_entry;

    WHILEND /search_control_facility_list/;

  PROCEND send_add_file_to_ctrl_facs;
?? TITLE := '  send_delete_file_to_ctrl_facs', EJECT ??

{}
{  PURPOSE:
{    This procedure loops through the list of control facility entries and
{    sends a delete file available message.
{}

  PROCEDURE send_delete_file_to_ctrl_facs (VAR control_facility_list:  ^nft$linked_list_entry;
        file_requeued:  boolean;
        output_descriptor:  jmt$output_descriptor;
        destination_list:  ^nft$destination;
    VAR wait_list:  ^ost$i_wait_list;
    VAR wait_activity_list:  ^nft$wait_activity_list;
    VAR message:  ^nft$message_sequence;
    VAR status:  ost$status);

    VAR
      application_file: nft$application_file_descriptor,
      control_facility_entry: ^nft$linked_list_entry,
      next_control_facility_entry: ^nft$linked_list_entry;

    application_file.file_kind := nfc$output_file;
    application_file.output_descriptor := output_descriptor;

    control_facility_entry := control_facility_list;

  /search_control_facility_list/
    WHILE control_facility_entry <> NIL DO

      nfp$send_delete_file_available (application_file, {held} FALSE, file_requeued,
            control_facility_entry^.control_facility^.connection_id, message, status);
      next_control_facility_entry := control_facility_entry^.link;
      IF NOT status.normal AND ((status.condition <> nae$no_data_available) AND
            (status.condition <> nfe$invalid_descriptor_value)) THEN
        remove_control_facility (destination_list, control_facility_entry^.control_facility,
              wait_list, wait_activity_list, status);
        IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
              nae$unknown_application)) THEN
          RETURN;
        IFEND;
      IFEND;
      control_facility_entry := next_control_facility_entry;

    WHILEND /search_control_facility_list/;

  PROCEND send_delete_file_to_ctrl_facs;
?? TITLE := '  terminate_scfs_queued_output', EJECT ??

{
{  PURPOSE:
{    This procedure deletes an output queue file from the queue if the file
{    specified in the message was controlled by the control facility that sent
{    the message.  A response is sent back to SCFS and then to OPES with the
{    result of the termination.
{

  PROCEDURE terminate_scfs_queued_output
     (    connection_id: amt$file_identifier;
          first_destination: ^nft$destination;
      VAR message: ^nft$message_sequence;
      VAR msg_length: integer;
      VAR wait_list: ^ost$i_wait_list;
      VAR wait_activity_list: ^nft$wait_activity_list;
      VAR status: ost$status);

    VAR
      current_file: ^nft$available_file,
      descriptor: jmt$output_descriptor,
      descriptor_found: boolean,
      destination: ^nft$destination,
      destination_found: boolean,
      file_name: ost$name,
      ignore_status: ost$status,
      io_station_name: ost$name,
      q_file: ^nft$available_file,
      response: nft$terqo_file_status_codes,
      system_file_name: jmt$system_supplied_name;

?? NEWTITLE := '    cf_connection_in_destination', EJECT ??

    FUNCTION cf_connection_in_destination
      (    connection_id: amt$file_identifier;
           destination: ^nft$destination): boolean;

      VAR
        connection_in_destination: boolean,
        control_facility_entry: ^nft$linked_list_entry,
        control_facility: ^nft$control_facility;


      connection_in_destination := FALSE;
      control_facility_entry := destination^.control_facility_list;

      WHILE (NOT connection_in_destination) AND (control_facility_entry <> NIL) DO
        connection_in_destination := (connection_id = control_facility_entry^.control_facility^.
              connection_id);
        IF NOT connection_in_destination THEN
          control_facility_entry := control_facility_entry^.link;
        IFEND;
      WHILEND;

    cf_connection_in_destination := connection_in_destination;

    FUNCEND cf_connection_in_destination;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    response := nfc$terqo_successful;

    nfp$crack_terqo_msg (message, msg_length, io_station_name, file_name, status);
    IF status.normal THEN
      system_file_name := file_name;

      find_file_and_descriptor (system_file_name, first_destination, current_file, descriptor_found);
      IF descriptor_found THEN
        descriptor := current_file^.output_descriptor;
        find_destination (descriptor.station, first_destination, destination_found, destination);
        IF destination_found AND cf_connection_in_destination (connection_id, destination) THEN
          jmp$set_output_initiated (descriptor.output_destination_usage, descriptor.system_file_name, status);
          IF status.normal THEN
            jmp$set_output_completed (descriptor.output_destination_usage, descriptor.system_file_name, TRUE,
                  ignore_status);

            remove_file_from_list (descriptor.system_file_name, destination^);

            send_delete_file_to_ctrl_facs (destination^.control_facility_list, FALSE, descriptor,
                  first_destination, wait_list, wait_activity_list, message, status);
          ELSE
            response := nfc$terqo_message_rejected;
          IFEND;
        ELSE
          response := nfc$terqo_message_rejected;
        IFEND;
      ELSE
        response := nfc$terqo_unknown_file_name;
      IFEND;
    ELSE
      response := nfc$terqo_message_rejected;
      pmp$log ('**** SCF - abnormal status returned on terminate queued output message', local_status);
      nap$display_message (status);
    IFEND;

    nfp$send_terqo_response_msg (io_station_name, file_name, response, connection_id, message, status);

  PROCEND terminate_scfs_queued_output;
?? TITLE := '  nfp$status_and_control_facility', EJECT ??

{}
{  PURPOSE:
{    This program implements the client application known as SCF/VE.
{    SCF/VE processes file control commands and informs SCFS/VE about
{    new output files, modified output files and terminated output files.
{    SCF/VE also initiates the task known as BTF/VE.  BTF/VE is the
{    host application which is responsible for the transfer of output
{    files from the host to the batch device.
{}
{  DESCRIPTION:
{    - establish condition handler
{    - initialize the application
{    - acquire all new, modified and terminated output
{}
{    LOOP
{      - process file assignment message from SCFS/VE
{      - process delete destination message from SCFS/VE
{      - process a title translation that was initially requested for an
{        unknown destination
{      - process message received from BTF/VE task (indication of transfer
{        complete)
{      - acquire all new, modified and terminated output
{    LOOPEND

  PROGRAM nfp$status_and_control_facility
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      activity_status: ost$activity_status,
      connection_id: amt$file_identifier,
      control_facility: ^nft$control_facility,
      debug_async_task: pmt$debug_mode,
      establish_descriptor: pmt$established_handler,
      exit_condition: [STATIC, READ] pmt$condition := [pmc$block_exit_processing, [pmc$block_exit,
        pmc$program_termination, pmc$program_abort]],
      local_status: ost$status,
      log_names: ARRAY [1..1] OF ost$name,
      message: ^nft$message_sequence,
      message_kind: ^nft$message_kind,
      message_length: integer,
      operator_message: ost$string,
      outstanding_operator_messages: ost$non_negative_integers,
      peer_operation: nat$se_peer_operation,
      private_queue_file_password: jmt$queue_file_password,
      public_queue_file_password: jmt$queue_file_password,
      ready_index: integer,
      wait_activity_list: ^nft$wait_activity_list,
      wait_list: ^ost$i_wait_list;

?? NEWTITLE := '    exit_condition_handler', EJECT ??

{  PURPOSE:
{    This procedure cleans up SCF/VEs environment in the event of a
{    termination.
{      - communication with all BTF/VE tasks will be terminated
{      - all connections will be closed
{      - title translation requests will be terminated
{      - queue file manager will be notified of output that has not
{        finished printing

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

      VAR
        current_file: ^nft$available_file,
        destination: ^nft$destination,
        file_id_is_valid: boolean,
        file_instance: ^bat$task_file_entry,
        file_name: amt$local_file_name,
        i: integer,
        ignore_status: ost$status,
        limit: integer;


      pmp$log ('Status Control Facility dropping', ignore_status);

      IF nfv$wait_activity_list <> NIL THEN
        limit := UPPERBOUND (nfv$wait_activity_list^);

      /clean_up_wait_activity_list/
        FOR i := LOWERBOUND (nfv$wait_activity_list^) TO limit DO
          IF nfv$wait_activity_list^ [i].kind = nfc$btfve_task_message THEN
            nfp$end_async_communication (FALSE, ignore_status);
          ELSEIF nfv$wait_activity_list^ [i].kind = nfc$control_facility_connection THEN
            IF nfv$wait_activity_list^ [i].cf <> NIL THEN
              bap$validate_file_identifier (nfv$wait_activity_list^ [i].cf^.connection_id,
                    file_instance, file_id_is_valid);
              IF file_id_is_valid THEN
                file_name := file_instance^.local_file_name;
                fsp$close_file (nfv$wait_activity_list^ [i].cf^.connection_id, ignore_status);
                amp$return (file_name, ignore_status);
              IFEND;
            IFEND;
          IFEND;
        FOREND /clean_up_wait_activity_list/;
      IFEND;

      destination := destination_list;

    /clean_up_destination_list/
      WHILE destination <> NIL DO
        nap$end_directory_search (destination^.title_search_id, ignore_status);
        current_file := destination^.file_list;

      /clean_up_file_list/
        WHILE current_file <> NIL DO
          jmp$set_output_completed (current_file^.output_descriptor.output_destination_usage,
                current_file^.output_descriptor.system_file_name, FALSE, ignore_status);
          current_file := current_file^.link;
        WHILEND /clean_up_file_list/;

        destination := destination^.link;
      WHILEND /clean_up_destination_list/;

      REPEAT
        clp$delete_variable (nfv$appl_def_segment_variables [nfc$appl_def_segment_for_scf], ignore_status);
      UNTIL NOT ignore_status.normal;

    PROCEND exit_condition_handler;
?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    outstanding_operator_messages := 0;
    debug_async_task := FALSE;

    pmp$establish_condition_handler (exit_condition, ^exit_condition_handler, ^establish_descriptor, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    initialize_scf_ve (parameter_list, public_queue_file_password, private_queue_file_password,
         wait_list, message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    acquire_all_output_files (message, wait_list, wait_activity_list, destination_list, status);
    IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
          nae$unknown_application)) THEN
      RETURN;
    IFEND;

    log_names [1] := 'JOB_MESSAGE';
    clp$log_comment ('Status and Control Facility', log_names, local_status);

  /main_program_loop/
    WHILE TRUE DO

      osp$i_await_activity_completion (wait_list^, ready_index, status);

      IF status.normal THEN
        IF outstanding_operator_messages > 0 THEN
          ofp$receive_operator_response (ofc$system_operator, osc$nowait, operator_message, local_status);
          IF local_status.normal THEN
            outstanding_operator_messages := outstanding_operator_messages - 1;
          IFEND;
        IFEND;

        CASE wait_list^ [ready_index].activity OF
        = nac$i_await_data_available =
          connection_id := wait_list^ [ready_index].file_identifier;
          nfp$get_connection_data (message, connection_id, peer_operation, activity_status, activity_status.
                status);
          IF activity_status.status.normal THEN
            IF peer_operation.kind = nac$se_send_data THEN
              message_length := peer_operation.data_length;

              RESET message;
              NEXT message_kind IN message;
              message_length := message_length - 1;
              CASE message_kind^ OF
              = nfc$file_assignment =
                file_assignment_message (connection_id, destination_list, debug_async_task,
                      public_queue_file_password, private_queue_file_password, message,
                      wait_list, wait_activity_list, message_length, status);

              = nfc$delete_destination =
                delete_destination_message (message, destination_list, wait_list, wait_activity_list,
                      message_length, status);

              = nfc$terminate_queue_output =
                terminate_scfs_queued_output (connection_id, destination_list, message, message_length,
                      wait_list, wait_activity_list,status);

              ELSE

{ SCF does not process any other kinds of messages that come in on the connection.

              CASEND;
            IFEND;
          ELSE
            control_facility := wait_activity_list^ [ready_index].cf;
            remove_control_facility (destination_list, control_facility, wait_list, wait_activity_list,
                  status);
            IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                  nae$unknown_application)) THEN
              RETURN;
            IFEND;
          IFEND;

        = nac$i_await_title_translation =
          check_unknown_destination (message, ready_index, destination_list, wait_list, wait_activity_list,
                status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          IFEND;

        = pmc$i_await_local_queue_message =
          check_for_btf_task_completion (message, ready_index, outstanding_operator_messages, wait_list,
                wait_activity_list, destination_list, status);
          IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
                nae$unknown_application)) THEN
            RETURN;
          IFEND;

        ELSE
          ;

        CASEND;

        acquire_all_output_files (message, wait_list, wait_activity_list, destination_list, status);
        IF (NOT status.normal) AND ((status.condition = nae$application_inactive) OR (status.condition =
              nae$unknown_application)) THEN
          RETURN;
        IFEND;

      ELSE
        pmp$log ('SCF received abnormal status from osp$i_await_activity_completion:', local_status);
        nap$display_message (status);
        RETURN;
      IFEND;

    WHILEND /main_program_loop/;

  PROCEND nfp$status_and_control_facility;
MODEND nfm$status_and_control_facility;
