*copyc osd$default_pragmats
MODULE rfm$request_processing_r1;
?? TITLE := 'RHFAM/VE : PP Request Processing : R113' ??
?? NEWTITLE := '  Common Decks' ??
?? EJECT ??
*copyc rft$pp_interface_defs
?? EJECT ??
*copyc cmv$logical_pp_table_p
*copyc cmv$logical_unit_table
*copyc i#call_monitor
*copyc i#move
*copyc i$real_memory_address
?? PUSH (LISTEXT := ON) ??
*copyc mme$condition_codes
?? POP ??
*copyc osv$mainframe_wired_cb_heap
*copyc osv$page_size
*copyc ost$signature_lock
*copyc osp$set_status_abnormal
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$begin_system_activity
*copyc osp$end_system_activity
*copyc osp$set_job_signature_lock
*copyc osp$clear_job_signature_lock
*copyc oss$mainframe_pageable
*copyc osv$mainframe_pageable_heap
*copyc osv$external_interrupt_selector
*copyc pmp$get_executing_task_gtid
?? PUSH (LISTEXT := ON) ??
*copyc rfd$path_status_table
*copyc rfd$nad_general_status
*copyc rfe$condition_codes
?? POP ??
*copyc rft$rhfam_server_table
*copyc rft$r1_interface_defs
*copyc rft$network_block_protocol
*copyc rft$rb_queue_data_fragments
*copyc rfv$response_processor
*copyc rfv$status_response_pending
*copyc rfv$system_task_id
*copyc syp$continue_to_cause
*copyc syp$cycle
*copyc syp$establish_condition_handler
*copyc tmv$null_global_task_id
?? TITLE := '  Global Variables' ??
?? EJECT ??
    CONST
        rfc$max_lock_retries = 50;

    TYPE
        rft$r1_buffer_management = RECORD
          lock: ost$signature_lock,
          entry_count: 0..rfc$max_r1_request_id,
          free_entries: 0..rfc$max_r1_request_id,
          first_free_entry: 0..rfc$max_r1_request_id,
          first_open_entry: 0..rfc$max_r1_request_id,
          buffer_list: ^ARRAY [1..*] OF rft$ring_1_buffer,
        RECEND,

        rft$ring_1_buffer = RECORD
          next_free_entry: 0..rfc$max_r1_request_id,
          next_open_entry: 0..rfc$max_r1_request_id,
          buffer: ^rft$request_response_buffer,
        RECEND;

    VAR
        rfv$request_buffers: [XDCL, oss$mainframe_pageable] rft$r1_buffer_management :=
          [[0], 0, 0, 0, 0, NIL];

    VAR
        clear_lockword: [READ] iot$lockword := [FALSE, 0, [FALSE, 0, 0]],
        set_lockword: [READ] iot$lockword := [TRUE, 0, [TRUE, FALSE, 0, 0]];
?? TITLE := '  RFP$POST_REQUEST' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$post_request(VAR request_info: ^SEQ(*);
                                VAR request_ids: rft$request_identifier;
                                VAR status: ost$status);

*copyc rfh$post_request

    VAR
        request_id: rft$request_identifier;

    status.normal := TRUE;

    {     Save ring 3 identification.

    request_id := request_ids;

    CASE  request_ids.ring_3_id.location.kind  OF
    = rfc$pp_request =

      rfp$post_pp_request(request_ids.ring_3_id.location.logical_pp, request_info, request_id, status);
      IF  status.normal  THEN

        {   Add ring 1 identification.

        request_ids := request_id;
      IFEND;

    = rfc$unit_request =

      rfp$post_unit_request(request_ids.ring_3_id.location.logical_unit, request_info, request_id, status);
      IF  status.normal  THEN

        {   Add ring 1 identification.

        request_ids := request_id;
      IFEND;

    ELSE

      {   This should never occur with normal CYBIL type checking

      osp$set_status_abnormal(rfc$product_id, rfe$unsupported_request_type, '', status);

    CASEND;
  PROCEND rfp$post_request;
?? NEWTITLE := '    RFP$POST_PP_REQUEST' ??
?? EJECT ??
  PROCEDURE rfp$post_pp_request(pp_number: iot$pp_number;
                            VAR request_info: ^SEQ(*);
                            VAR request_id: rft$request_identifier;
                            VAR status: ost$status);


{    The purpose of this request is to post a request for the specified peripheral
{    processor to perform.  A peripheral request is generated in the wired section and
{    the request is queued for the PP driver to process.
{
{    pp_number: (input) This parameter specifies the logical pp number of the corresponding
{      PP.  The request is queued in the pp interface table for this PP.
{
{    request_info: (input) This parameter specifies a pointer to an adaptable sequence which
{      contains the information that is required to generate the request.
{
{    request_id: (output) This parameter returns the identifier of the request that was posted.
{      This parameter is only meaningful if the status is normal.
{
{    status: (output) This parameter returns the results of the request.  A status of normal
{      means that the request was successfully posted.

    VAR
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        pp_interface_table: ^iot$pp_interface_table,
        request_buffer_ptr: ^rft$request_response_buffer,
        command_identifier: ^rft$pp_commands,
        command_entry: rft$command,
        command_flags: rft$function_flags;

    status.normal := TRUE;
    pp_interface_table :=  cmv$logical_pp_table_p^ [pp_number].pp_info.pp_interface_table_p;

    IF  pp_interface_table = NIL  THEN

      {  This should not happen.

      osp$set_status_abnormal(rfc$product_id, rfe$invalid_peripheral_element, 'PP', status);
      osp$append_status_integer(osc$status_parameter_delimiter, pp_number, 10, false, status);
      RETURN;
    IFEND;

    RESET  request_info;
    NEXT  command_identifier  IN  request_info;
    IF  command_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request buffer is empty',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$POST_PP_REQUEST', status);
      RETURN;
    IFEND;

    get_wired_request_buffer(request_buffer_ptr, request_id);
    IF  request_buffer_ptr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'mainframe_wired', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$POST_PP_REQUEST', status);
      RETURN;
    IFEND;

    command_flags.store_response := TRUE;
    command_flags.indirect_address := FALSE;
    command_flags.pp_processing := FALSE;
    command_flags.pp_process_complete := FALSE;
    command_flags.flush_buffer := FALSE;

    command_buffer := #LOC(request_buffer_ptr^.command_buffer);

    CASE  command_identifier^  OF
    = ioc$cc_idle =

      command_entry.pp_flags := command_flags;
      command_entry.pp_function_code := rfc$pp_idle;
      command_buffer^[rfc$cbi_pp_request] := command_entry;
      request_buffer_ptr^.rhfam_request.request_length := request_buffer_ptr^.rhfam_request.request_length
        + #SIZE(rft$command);

    = ioc$cc_resume =

      command_entry.pp_flags := command_flags;
      command_entry.pp_function_code := rfc$pp_resume;
      command_buffer^[rfc$cbi_pp_request] := command_entry;
      request_buffer_ptr^.rhfam_request.request_length := request_buffer_ptr^.rhfam_request.request_length
        + #SIZE(rft$command);

    ELSE

      {  Sorry, but your request is not currently supported.

      osp$set_status_abnormal(rfc$product_id, rfe$invalid_request_command, '', status);
      osp$append_status_integer(osc$status_parameter_delimiter, command_identifier^, 16, TRUE, status);
    CASEND;

    IF  status.normal  THEN
      link_request_buffer(request_buffer_ptr, ^pp_interface_table^.lockword,
        ^pp_interface_table^.pp_request_queue, ^pp_interface_table^.pp_request_queue_rma);
    ELSE
      free_wired_request_buffer(request_id.ring_1_id.entry);
    IFEND;

  PROCEND rfp$post_pp_request;
?? TITLE := '    RFP$POST_UNIT_REQUEST' ??
?? EJECT ??
  PROCEDURE rfp$post_unit_request(unit_number: iot$logical_unit;
                              VAR request_info: ^SEQ(*);
                              VAR request_id: rft$request_identifier;
                              VAR status: ost$status);


{    The purpose of this request is to post a request in the specified unit interface table
{    for a PP to process.  A peripheral request is generated in the wired section and
{    the request is queued for the PP driver to process.
{
{    unit_number: (input) This parameter specifies the logical unit number of the corresponding
{      NAD.  The request is queued in the unit interface table for this NAD.
{
{    request_info: (input) This parameter specifies a pointer to an adaptable sequence which
{      contains the information that is required to generate the request.
{
{    request_id: (output) This parameter returns the identifier of the request that was posted.
{      This parameter is only meaningful if the status is normal.
{
{    status: (output) This parameter returns the results of the request.  A status of normal
{      means that the request was successfully posted.


    VAR
        error_string: STRING(35),
        unit_interface_table: ^iot$unit_interface_table,
        request_buffer_ptr: ^rft$request_response_buffer,
        command_entry: rft$command,
        command_identifier: ^rft$logical_commands,
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        path_id: ^rft$path_identifier,
        reject_code: ^rft$reject_code,
        physical_from: ^rft$physical_from,
        receive_conditions: ^rft$transfer_mode,
        rejected_control_message,
        asynchronous_request,
        remote_status_primed,
        unconditionally_status,
        abnormal_termination,
        maintenance_connection: ^BOOLEAN,
        control_message_size: ^rft$control_message_text,
        control_message: ^rft$nbp_control_message,
        out_connect_request,
        out_connect_request_buff: ^rft$nbp_outgoing_connect,
        in_connect_request,
        in_connect_request_buff: ^rft$nbp_incoming_connect,
        retry_count: ^rft$retry_count,
        alert_mask: rft$alert_conditions,
        rma: integer,
        ignore_status: ost$status,
        path_count: ^rft$path_identifier,
        command_flags: rft$function_flags;

    status.normal := TRUE;
    unit_interface_table :=  cmv$logical_unit_table^[unit_number].unit_interface_table;

    IF  unit_interface_table = NIL  THEN

      {  This should not happen.

      osp$set_status_abnormal(rfc$product_id, rfe$invalid_peripheral_element, 'UNIT', status);
      osp$append_status_integer(osc$status_parameter_delimiter, unit_number, 10, false, status);
      RETURN;
    IFEND;

    RESET  request_info;
    NEXT  command_identifier  IN  request_info;
    IF  command_identifier = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request buffer is empty',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$POST_UNIT_REQUEST', status);
      RETURN;
    IFEND;

    get_wired_request_buffer(request_buffer_ptr, request_id);
    IF  request_buffer_ptr = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'mainframe_wired', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$POST_UNIT_REQUEST', status);
      RETURN;
    IFEND;

    command_entry.lc_function_code := command_identifier^;
    command_flags.store_response := TRUE;
    command_flags.indirect_address := FALSE;
    command_flags.pp_processing := FALSE;
    command_flags.pp_process_complete := FALSE;
    command_flags.flush_buffer := TRUE;
    request_buffer_ptr^.rhfam_request.request_length := request_buffer_ptr^.rhfam_request.request_length
      + (rfc$cbi_unit_request_2 * #SIZE(rft$command));

    command_buffer := #LOC(request_buffer_ptr^.command_buffer);

  /create_request/
    BEGIN

      CASE  command_identifier^  OF
      = rfc$lc_request_connection =

        NEXT  maintenance_connection  IN  request_info;
        IF  maintenance_connection = NIL  THEN
          status.normal := FALSE;
          error_string := 'no type flag: REQUEST CONNECT';
          EXIT /create_request/;
        IFEND;
        command_flags.maintenance_connection := maintenance_connection^;
        command_entry.lc_flags := command_flags;
        NEXT  out_connect_request  IN  request_info;
        IF  out_connect_request = NIL  THEN
          status.normal := FALSE;
          error_string := 'no message: REQUEST CONNECT';
          EXIT /create_request/;
        IFEND;
        out_connect_request_buff := #LOC(command_buffer^[rfc$cbi_general_buffer]);
        out_connect_request_buff^ := out_connect_request^;
        i#real_memory_address(out_connect_request_buff, rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := #SIZE(rft$nbp_outgoing_connect);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].lc_path_id := 0;

      = rfc$lc_obtain_connect_request =

        command_entry.lc_flags := command_flags;
        NEXT  physical_from  IN  request_info;
        IF  physical_from = NIL  THEN
          status.normal := FALSE;
          error_string := 'no physical from: OBTAIN CONNECT';
          EXIT /create_request/;
        IFEND;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: OBTAIN CONNECT';
          EXIT /create_request/;
        IFEND;
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := #SIZE(rft$nbp_incoming_connect);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].cm_physical_from := physical_from^;
        command_buffer^[rfc$cbi_unit_request_2].cm_path_id := path_id^;

      = rfc$lc_accept_connect_request =

        command_entry.lc_flags := command_flags;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: CONNECT ACCEPT';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].lc_path_id := path_id^;

      = rfc$lc_reject_connect_request =

        command_entry.lc_flags := command_flags;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: CONNECT REJECT';
          EXIT /create_request/;
        IFEND;
        NEXT  reject_code  IN  request_info;
        IF  reject_code = NIL  THEN
          status.normal := FALSE;
          error_string := 'no reject_code: CONNECT REJECT';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].rc_reject_code := reject_code^;
        command_buffer^[rfc$cbi_unit_request_2].rc_path_id := path_id^;

      = rfc$lc_send_data =

        command_flags.pp_process_complete := TRUE;
        command_entry.lc_flags := command_flags;
        NEXT  asynchronous_request  IN  request_info;
        IF  asynchronous_request = NIL  THEN
          status.normal := FALSE;
          error_string := 'no async flag: SEND DATA';
          EXIT /create_request/;
        IFEND;
        request_buffer_ptr^.asynchronous_request := asynchronous_request^;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: SEND DATA';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].io_path_id := path_id^;
        command_buffer^[rfc$cbi_in_pointer].bp_offset := 0;
        command_buffer^[rfc$cbi_out_pointer].bp_offset := 0;
        request_buffer_ptr^.previous_out_ptr := rfc$cbi_first_io_entry;
        request_buffer_ptr^.rhfam_request.request_length := request_buffer_ptr^.rhfam_request.request_length
          + ((rfc$cbi_last_io_entry - rfc$cbi_unit_request_2) * #SIZE(rft$command));
        link_request_buffer(request_buffer_ptr, ^unit_interface_table^.unit_q_lockword,
          ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma);
        rfp$continue_io_request(request_info, request_id, ioc$explicit_write, TRUE, status);
        IF  NOT status.normal  THEN
          delink_and_free_buffer(request_id.ring_1_id.entry, ^unit_interface_table^.unit_q_lockword,
            ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma, ignore_status);
        IFEND;

        {  Once we get here we cannot continue with the end of block processing.

        RETURN;

      = rfc$lc_receive_data =

        NEXT  receive_conditions  IN  request_info;
        IF  receive_conditions = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing transfer mode: RECEIVE DATA';
          EXIT /create_request/;
        IFEND;
        alert_mask.long_input_block := FALSE;
        alert_mask.pru_block_next := FALSE;
        alert_mask.non_pru_block_next := FALSE;
        alert_mask.end_of_message := FALSE;
        alert_mask.eor_mark_encountered := FALSE;
        alert_mask.eof_mark_encountered := FALSE;
        alert_mask.eoi_mark_encountered := FALSE;
        CASE  receive_conditions^.transfer_mode OF
        = rfc$tm_record_mode =
          alert_mask.non_pru_block_next := TRUE;
          CASE  receive_conditions^.termination_mark  OF
          = rfc$rm_eor =
            alert_mask.eor_mark_encountered := TRUE;
            alert_mask.eof_mark_encountered := TRUE;
            alert_mask.eoi_mark_encountered := TRUE;
          = rfc$rm_eof =
            alert_mask.eof_mark_encountered := TRUE;
            alert_mask.eoi_mark_encountered := TRUE;
          = rfc$rm_eoi =
            alert_mask.eoi_mark_encountered := TRUE;
          ELSE
            {  no additional flags.
          CASEND;
        = rfc$tm_message_mode =
          alert_mask.pru_block_next := TRUE;
          alert_mask.end_of_message := TRUE;
        ELSE
          {  no additional flags.
        CASEND;
        request_buffer_ptr^.rhfam_request.alert_mask := alert_mask;
        command_flags.pp_process_complete := TRUE;
        command_entry.lc_flags := command_flags;
        NEXT  asynchronous_request  IN  request_info;
        IF  asynchronous_request = NIL  THEN
          status.normal := FALSE;
          error_string := 'no async flag: RECEIVE DATA';
          EXIT /create_request/;
        IFEND;
        request_buffer_ptr^.asynchronous_request := asynchronous_request^;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: RECEIVE DATA';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].io_path_id := path_id^;
        command_buffer^[rfc$cbi_in_pointer].bp_offset := 0;
        command_buffer^[rfc$cbi_out_pointer].bp_offset := 0;
        request_buffer_ptr^.previous_out_ptr := rfc$cbi_first_io_entry;
        request_buffer_ptr^.rhfam_request.request_length := request_buffer_ptr^.rhfam_request.request_length
          + ((rfc$cbi_last_io_entry - rfc$cbi_unit_request_2) * #SIZE(rft$command));
        link_request_buffer(request_buffer_ptr, ^unit_interface_table^.unit_q_lockword,
          ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma);
        rfp$continue_io_request(request_info, request_id, ioc$explicit_read, TRUE, status);
        IF  NOT status.normal  THEN
          delink_and_free_buffer(request_id.ring_1_id.entry, ^unit_interface_table^.unit_q_lockword,
            ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma, ignore_status);
        IFEND;

        {  Once we get here we cannot continue with the end of block processing.

        RETURN;

      = rfc$lc_status_nad =

        NEXT  unconditionally_status  IN  request_info;
        IF  unconditionally_status = NIL  THEN
          status.normal := FALSE;
          error_string := 'no type flag: STATUS NAD';
          EXIT /create_request/;
        IFEND;
        command_flags.unconditionally_status := unconditionally_status^;
        command_entry.lc_flags := command_flags;
        NEXT  path_count  IN  request_info;
        IF  path_count = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path count: STATUS NAD';
          EXIT /create_request/;
        IFEND;
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := path_count^ * #SIZE(rft$nad_status_entry);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;

      = rfc$lc_send_control_message =

        command_entry.lc_flags := command_flags;
        NEXT  control_message_size IN  request_info;
        IF  control_message_size = NIL  THEN
          status.normal := FALSE;
          error_string := 'no text size: SEND CONTROL MESSAGE';
          EXIT /create_request/;
        IFEND;
        NEXT  control_message : [control_message_size^] IN  request_info;
        IF  control_message = NIL  THEN
          status.normal := FALSE;
          error_string := 'no message: SEND CONTROL MESSAGE';
          EXIT /create_request/;
        IFEND;
        i#move(control_message, #LOC(command_buffer^[rfc$cbi_general_buffer]), #SIZE(control_message^));
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := #SIZE(control_message^);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;

      = rfc$lc_receive_control_message =

        NEXT  rejected_control_message IN  request_info;
        IF  rejected_control_message = NIL  THEN
          status.normal := FALSE;
          error_string := 'no type flag: RECEIVE CONTROL MESSAGE';
          EXIT /create_request/;
        IFEND;
        command_flags.rejected_control_message := rejected_control_message^;
        command_entry.lc_flags := command_flags;
        NEXT  physical_from  IN  request_info;
        IF  physical_from = NIL  THEN
          status.normal := FALSE;
          error_string := 'no physical from: RECEIVE CONTROL MESSAGE';
          EXIT /create_request/;
        IFEND;
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := rfc$max_control_message_size;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].cm_physical_from := physical_from^;

      = rfc$lc_disconnect_paths =

        NEXT  abnormal_termination  IN  request_info;
        IF  abnormal_termination = NIL  THEN
          status.normal := FALSE;
          error_string := 'no type flag: DISCONNECT';
          EXIT /create_request/;
        IFEND;
        command_flags.abnormal_termination := abnormal_termination^;
        command_entry.lc_flags := command_flags;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: DISCONNECT';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].lc_path_id := path_id^;

      = rfc$lc_read_path_status_table =

        command_entry.lc_flags := command_flags;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: PATH STATUS';
          EXIT /create_request/;
        IFEND;
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := #SIZE(rft$path_status_table);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        command_buffer^[rfc$cbi_unit_request_2].lc_path_id := path_id^;

      = rfc$lc_obtain_nad_general_stat =

        NEXT  remote_status_primed  IN  request_info;
        IF  remote_status_primed = NIL  THEN
          status.normal := FALSE;
          error_string := 'no type flag: GENERAL STATUS';
          EXIT /create_request/;
        IFEND;
        command_flags.primed := remote_status_primed^;
        command_entry.lc_flags := command_flags;
        i#real_memory_address(^command_buffer^[rfc$cbi_general_buffer], rma);
        command_entry.lc_rma := rma;
        command_entry.lc_length := #SIZE(rft$nad_general_status);
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        NEXT  retry_count  IN  request_info;
        IF  retry_count = NIL  THEN
          status.normal := FALSE;
          error_string := 'no retry count: GENERAL STATUS';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_2].os_retry_count := retry_count^;
        NEXT  path_id  IN  request_info;
        IF  path_id = NIL  THEN
          status.normal := FALSE;
          error_string := 'no path ID: GENERAL STATUS';
          EXIT /create_request/;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_2].os_path_id := path_id^;

      = rfc$lc_process_physical_command =

        command_entry.lc_flags := command_flags;
        command_buffer^[rfc$cbi_unit_request_1] := command_entry;
        add_physical_command_entries(request_info, request_buffer_ptr, error_string, status);

      ELSE

        {  Sorry, but your request is not currently supported.

        status.normal := FALSE;
        error_string := 'invalid unit request command';
      CASEND;

    END /create_request/;

    IF  status.normal  THEN
      link_request_buffer(request_buffer_ptr, ^unit_interface_table^.unit_q_lockword,
        ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma);
    ELSE
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, error_string, status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$POST_UNIT_REQUEST', status);
      free_wired_request_buffer(request_id.ring_1_id.entry);
    IFEND;

  PROCEND rfp$post_unit_request;
??  NEWTITLE := '      ADD_PHYSICAL_COMMAND_ENTRIES' ??
??  EJECT ??
  PROCEDURE  add_physical_command_entries(VAR request_info: ^SEQ(*);
                                          VAR request_buffer: ^rft$request_response_buffer;
                                          VAR error_string: STRING(35);
                                          VAR status: ost$status);

{    The purpose of this routine is to generate the user specified physical command entries and add
{    them into the request buffer.
{
{    request_info: (input,output) This parameter points to the adaptable sequence which contains the
{      user's request.  The pointer currently points to the next entry following the initial
{      logical command identifier.  Upon exit this pointer points to the entry after the last
{      physical command.
{
{    request_buffer: (input,ouput) This parameter points to the request response buffer.  If status
{      is normal then the contents of this buffer contains all of the physical commands specified
{      by the caller.
{
{    error_string: (output) This parameter contains the status text string if status is not
{      normal.
{
{    status: (output) This paramter returns the results of the request.  A status of normal
{      means that the request is ready to be queued.

    VAR
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        function_code: ^rft$nad_function_codes,
        buffer_address: ^^cell,
        buffer_rma: integer,
        transfer_length: ^rft$transfer_length,
        nad_memory_addr,
        nad_memory_length: ^rft$transfer_lgth_addr,
        nad_status_mask,
        nad_status_value: ^rft$nad_status_flags,
        command_identifier: ^rft$physical_commands,
        command_entry: rft$command,
        current_command,
        last_command,
        index: rft$command_entry,
        number_of_commands: ^rft$command_entry;

    command_buffer := #LOC(request_buffer^.command_buffer);
    current_command := rfc$cbi_general_buffer;
    last_command := rfc$cbi_last_command_entry;
    status.normal := TRUE;

    NEXT  number_of_commands  IN  request_info;
    IF  (number_of_commands = NIL) OR
        (number_of_commands^ = 0) THEN
      status.normal := FALSE;
      error_string := 'the physical command list is empty';
      RETURN;
    IFEND;
    FOR  index := 1  TO  number_of_commands^  DO
      NEXT  command_identifier  IN  request_info;
      IF  command_identifier = NIL  THEN
        status.normal := FALSE;
        error_string := 'missing physical command entry';
        RETURN;
      IFEND;

      command_entry.pc_function_code := command_identifier^;

      CASE  command_identifier^  OF
      = rfc$pc_function_nad =
        NEXT  function_code  IN  request_info;
        IF  function_code = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing function code';
          RETURN;
        IFEND;
        command_entry.fn_nad_function_code := function_code^;

      = rfc$pc_output_8_in_8_mode, rfc$pc_input_8_in_8_mode =

        NEXT  transfer_length  IN  request_info;
        IF  transfer_length = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing transfer length';
          RETURN;
        IFEND;
        command_entry.pc_length := transfer_length^;
        NEXT  buffer_address  IN  request_info;
        IF  buffer_address = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing buffer address';
          RETURN;
        IFEND;
        i#real_memory_address(buffer_address^, buffer_rma);
        command_entry.pc_rma := buffer_rma;

      = rfc$pc_set_addr_and_length =
        NEXT  nad_memory_addr  IN  request_info;
        IF  nad_memory_addr = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing NAD memory address';
          RETURN;
        IFEND;
        command_entry.nm_addr := nad_memory_addr^;
        NEXT  nad_memory_length  IN  request_info;
        IF  nad_memory_length = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing NAD memory length';
          RETURN;
        IFEND;
        command_entry.nm_length := nad_memory_length^;
        command_buffer^[last_command] := command_entry;
        i#real_memory_address(#LOC(command_buffer^[last_command]), buffer_rma);
        command_entry.pc_function_code := command_identifier^;
        command_entry.pc_length := #SIZE(rft$command);
        command_entry.pc_rma := buffer_rma;
        last_command := last_command - 1;

      = rfc$pc_microcode_status, rfc$pc_hardware_status =

        NEXT  nad_status_mask  IN  request_info;
        IF  nad_status_mask = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing nad status mask';
          RETURN;
        IFEND;
        command_entry.st_mask := nad_status_mask^;
        NEXT  nad_status_value  IN  request_info;
        IF  nad_status_value = NIL  THEN
          status.normal := FALSE;
          error_string := 'missing nad status mask';
          RETURN;
        IFEND;
        command_entry.st_value := nad_status_value^;

      ELSE

        {  Sorry, but your request is not currently supported.

        status.normal := FALSE;
        error_string := 'invalid physical command id';
        RETURN;
      CASEND;
      IF  current_command > last_command  THEN
        status.normal := FALSE;
        error_string := 'request exceeds maximum buffer size';
        RETURN;
      IFEND;
      command_buffer^[current_command] := command_entry;
      request_buffer^.rhfam_request.request_length := request_buffer^.rhfam_request.request_length
        + #SIZE(rft$command);
      current_command := current_command + 1;

    FOREND;

  PROCEND add_physical_command_entries;
??  TITLE := '      RFP$CONTINUE_IO_REQUEST' ??
??  EJECT ??
  PROCEDURE  [XDCL, #GATE] rfp$continue_io_request(VAR request_info: ^SEQ(*);
                                                   request_id: rft$request_identifier;
                                                   io_type: iot$io_function;
                                                   restart_request: BOOLEAN;
                                               VAR status: ost$status);

*copyc rfh$continue_io_request

    VAR
        request_block: rft$rb_queue_data_fragments,
        command_buff: ^ARRAY [rft$command_entry] OF rft$command,
        buffer_rma: integer,
        header,
        command_entry: rft$command,
        block_length,
        fragment_length: integer,
        fragment_address: ^CELL,
        page_size: ost$page_size,
        touch_page: CELL,
        ring: ost$ring,
        segment: ost$segment,
        offset: ost$segment_offset,
        io_fragment: ^rft$io_fragment,
        sub_function_length: 0..rfc$command_buffer_size,
        request_buffer: ^rft$request_response_buffer,
        fragment,
        block,
        pva_index,
        header_index,
        old_buff_index,
        buffer_index: rft$command_entry,
        send_intermediate_response: ^BOOLEAN,
        pages_swapped,
        all_data_wired: BOOLEAN,
        identifier: 1..rfc$max_r1_request_id,
        error_string: STRING(35),
        task_id: ost$global_task_id,
        number_of_fragments,
        number_of_blocks: ^0..rfc$command_buffer_size;

??  NEWTITLE := '        CONTINUE_IO_CONDITION_HANDLER' ??
??  EJECT ??
    PROCEDURE continue_io_condition_handler (mf: ost$monitor_fault;
                                             p_msa: ^ost$minimum_save_area;
                                        VAR  continue:  syt$continue_option);
    VAR
      p_sac: ^mmt$segment_access_condition,
      ignore: ost$status;

    IF mf.identifier = mmc$segment_fault_processor_id THEN
      p_sac := #LOC(mf.contents);

      CASE p_sac^.identifier OF
      = mmc$sac_io_read_error =
        osp$set_status_abnormal (rfc$product_id, rfe$segment_access_error,
           'io error accessing file', status);
        EXIT rfp$continue_io_request
      ELSE
      CASEND;
    IFEND;

    syp$continue_to_cause (mf, p_msa, syc$condition_ignored, continue);

  PROCEND  continue_io_condition_handler;
?? OLDTITLE ??
?? EJECT ??
    identifier := request_id.ring_1_id.entry;
    request_buffer := rfv$request_buffers.buffer_list^[identifier].buffer;
    page_size := osv$page_size;
    command_buff := #LOC(request_buffer^.command_buffer);
    status.normal := TRUE;
    all_data_wired := TRUE;
    syp$establish_condition_handler (^continue_io_condition_handler);

  /main_section/
    BEGIN
      NEXT  send_intermediate_response  IN  request_info;
      IF  send_intermediate_response = NIL  THEN
        status.normal := FALSE;
        error_string := 'missing intermediate response flag';
        EXIT /main_section/;
      IFEND;
      IF  restart_request  THEN
        IF  NOT command_buff^[rfc$cbi_unit_request_1].lc_flags.pp_process_complete  THEN
          status.normal := FALSE;
          error_string := 'cannot restart active I/O request';
          EXIT /main_section/;
        IFEND;

        {  The previous IN pointer is reset here because the buffer must be empty
        {  whenever the complete flag is set and new requests are to be added.

        request_buffer^.previous_in_ptr := request_buffer^.previous_out_ptr;

        {  Can only change the command flags when restarting the request, otherwise
        {  a conflict could occur if the PP was updating the word at the same time.

        command_buff^[rfc$cbi_unit_request_1].lc_flags.send_intermediate_response :=
          send_intermediate_response^;
        IF  send_intermediate_response^  THEN
          command_buff^[rfc$cbi_unit_request_2].io_retry_count := 0;
          command_buff^[rfc$cbi_unit_request_2].io_previous_in_pointer :=
            command_buff^[rfc$cbi_out_pointer].bp_offset;  {  the out pointer is used to cause a
                                                           {  comparison match to force a PP response
          command_buff^[rfc$cbi_unit_request_2].io_in_pointer_change := 0;
        IFEND;
      IFEND;

      command_buff^[rfc$cbi_in_pointer].bp_more_data := send_intermediate_response^;

    /queue_request/
      REPEAT
        pages_swapped := FALSE;
        buffer_index := request_buffer^.previous_in_ptr;
        old_buff_index := request_buffer^.previous_out_ptr;
        pva_index := rfc$cbi_first_indirect_pva;

        NEXT  number_of_blocks  IN  request_info;
        IF  (number_of_blocks = NIL) OR
            (number_of_blocks^ = 0)  THEN
          status.normal := FALSE;
          error_string := 'no blocks to queue for I/O request';
          EXIT /main_section/;
        IFEND;
        FOR  block := 1  TO  number_of_blocks^  DO
          NEXT  number_of_fragments  IN  request_info;
          IF  (number_of_fragments = NIL) OR
              (number_of_fragments^ = 0)  THEN
            status.normal := FALSE;
            error_string := 'missing I/O fragment count';
            EXIT /main_section/;
          IFEND;

          header_index := buffer_index;
          buffer_index := buffer_index + 1;
          IF  buffer_index >= rfc$cbi_limit_pointer  THEN
            buffer_index := rfc$cbi_first_io_entry;
          IFEND;
          IF  buffer_index = old_buff_index  THEN
            status.normal := FALSE;
            error_string := 'attempt to overflow request buffer';
            EXIT /main_section/;
          IFEND;
          sub_function_length := #SIZE(rft$command);
          block_length := 0;

          FOR  fragment := 1 TO number_of_fragments^  DO

            NEXT  io_fragment  IN  request_info;
            IF  io_fragment = NIL  THEN
              status.normal := FALSE;
              error_string := 'missing I/O fragment';
              EXIT /main_section/;
            IFEND;

            IF  io_fragment^.wired  THEN
              i#real_memory_address(io_fragment^.address, buffer_rma);
              command_entry.wired := TRUE;
              command_entry.re_length := io_fragment^.length;
              command_entry.re_address := buffer_rma;
              command_buff^[buffer_index] := command_entry;
              buffer_index := buffer_index + 1;
              IF  buffer_index >= rfc$cbi_limit_pointer  THEN
                buffer_index := rfc$cbi_first_io_entry;
              IFEND;
              IF  buffer_index = old_buff_index  THEN
                status.normal := FALSE;
                error_string := 'attempt to overflow request buffer';
                EXIT /main_section/;
              IFEND;
              sub_function_length := sub_function_length + #SIZE(rft$command);
            ELSE
              command_entry.wired := FALSE;
              command_entry.pe_length := io_fragment^.length;
              fragment_length := io_fragment^.length;
              command_entry.pe_pva_index := pva_index;
              command_buff^[buffer_index] := command_entry;
              command_buff^[pva_index].pv_pva := io_fragment^.address;
              fragment_address := io_fragment^.address;
              pva_index := pva_index + 1;
              ring := #ring(fragment_address);
              segment := #segment(fragment_address);
              offset := #offset(fragment_address);
            /touch_pages/
              WHILE  TRUE  DO
                touch_page := fragment_address^;

                { reserve space for monitor to insert the RMA entry.

                buffer_index := buffer_index + 1;
                IF  buffer_index >= rfc$cbi_limit_pointer  THEN
                  buffer_index := rfc$cbi_first_io_entry;
                IFEND;
                IF  buffer_index = old_buff_index  THEN
                  status.normal := FALSE;
                  error_string := 'attempt to overflow request buffer';
                  EXIT /main_section/;
                IFEND;
                sub_function_length := sub_function_length + #SIZE(rft$command);
                fragment_length := fragment_length - (page_size - (offset MOD page_size));
                IF  fragment_length <= 0  THEN
                  EXIT /touch_pages/;
                IFEND;
                offset := ((offset DIV page_size) * page_size) + page_size;
                fragment_address := #address(ring, segment, offset);
              WHILEND /touch_pages/;
              all_data_wired := FALSE;
            IFEND;
            block_length := block_length + io_fragment^.length;
          FOREND;
          header.sf_transfer_length := 0;
          header.sf_buffer_length := block_length;
          header.sf_length := sub_function_length;
          command_buff^[header_index] := header;
        FOREND;

        IF  all_data_wired  THEN
          request_buffer^.previous_in_ptr := buffer_index;
          #SPOIL(request_buffer^.previous_in_ptr,command_buff^);
          command_buff^[rfc$cbi_in_pointer].bp_offset := (buffer_index - rfc$cbi_first_io_entry) * 8;
          IF  restart_request  THEN
            request_buffer^.response_posted := FALSE;
            #SPOIL(request_buffer^.response_posted,command_buff^);
            command_buff^[rfc$cbi_unit_request_1].lc_flags.pp_process_complete := FALSE;
          IFEND;
        ELSE
          request_block.clear_complete_flag := restart_request;
          request_block.io_type := io_type;
          request_block.reqcode := syc$rc_queue_rhfam_request;
          request_block.number_of_blocks := number_of_blocks^;
          request_block.request_buffer := request_buffer;
          i#call_monitor(#LOC(request_block), #SIZE(rft$rb_queue_data_fragments));
          IF  NOT request_block.status.normal  THEN
            IF  request_block.status.condition = mme$page_frame_not_assigned  THEN
              RESET  request_info  TO  number_of_blocks;
              pages_swapped := TRUE;
            ELSE
              status.normal := FALSE;
              error_string := 'monitor page lock failed';
            IFEND;
          IFEND;
        IFEND;
      UNTIL  NOT pages_swapped;    { /queue_request/ }
    END /main_section/;

    IF  NOT status.normal  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, error_string, status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$CONTINUE_IO_REQUEST', status);
    IFEND;

  PROCEND rfp$continue_io_request;
?? TITLE := '      GET_WIRED_REQUEST_BUFFER' ??
?? EJECT ??
  PROCEDURE  get_wired_request_buffer(VAR buffer_pointer: ^rft$request_response_buffer;
                                      VAR request_id: rft$request_identifier);

{    The purpose of this procedure is to reserve a request response buffer in the mainframe wired
{    section for issuing a peripheral request.
{
{    buffer_pointer: (output) This parameter returns a pointer to a buffer in the
{      mainframe wired heap.  A value of NIL means that no space is available.
{
{    request_id: (input, output) This parameter specifies the ring 3 identifier on entry.  On exit
{      this parameter contains the ring 1 and the ring 3 identifiers.

    VAR
        request_ptr: ^rft$peripheral_request,
        request_response_buffer : ^rft$request_response_buffer,
        buff_id: 0..rfc$max_r1_request_id,
        task_id: ost$global_task_id;


    lock_table(rfv$request_buffers.lock);
    IF  rfv$request_buffers.first_free_entry <> 0  THEN
      buff_id := rfv$request_buffers.first_free_entry;
      rfv$request_buffers.first_free_entry := rfv$request_buffers.buffer_list^[buff_id].next_free_entry;
      rfv$request_buffers.free_entries := rfv$request_buffers.free_entries - 1;
      request_response_buffer := rfv$request_buffers.buffer_list^[buff_id].buffer;
    ELSE
      unlock_table(rfv$request_buffers.lock);
      ALLOCATE  request_response_buffer  IN  osv$mainframe_wired_cb_heap^;
      IF  request_response_buffer = NIL  THEN
        buffer_pointer := NIL;
        RETURN;
      ELSE
        lock_table(rfv$request_buffers.lock);
        rfv$request_buffers.entry_count := rfv$request_buffers.entry_count + 1;
        buff_id := rfv$request_buffers.first_open_entry;
        rfv$request_buffers.first_open_entry := rfv$request_buffers.buffer_list^[buff_id].next_open_entry;
        rfv$request_buffers.buffer_list^[buff_id].buffer := request_response_buffer;
      IFEND;
    IFEND;
    unlock_table(rfv$request_buffers.lock);

    request_id.ring_1_id.entry := buff_id;
    request_id.ring_1_id.address := request_response_buffer;
    request_response_buffer^.io_request.response_processor_p := rfv$response_processor;
    pmp$get_executing_task_gtid(task_id);
    request_response_buffer^.task_id := task_id;
    request_response_buffer^.response_posted := FALSE;
    request_response_buffer^.request_id := request_id;
    request_response_buffer^.asynchronous_request := FALSE;
    request_ptr := ^request_response_buffer^.rhfam_request;
    request_response_buffer^.io_request.device_request_p := request_ptr;
    request_ptr^.request_buffer_ptr := request_response_buffer;
    request_ptr^.request_length := #SIZE(rft$peripheral_request);
    request_ptr^.recovery := ioc$terminate_at_error;
    request_ptr^.interrupt.value := TRUE;
    request_ptr^.interrupt.port_number := osv$external_interrupt_selector;
    request_ptr^.priority := 1;
    buffer_pointer := request_response_buffer;

  PROCEND get_wired_request_buffer;
?? TITLE := '      LINK_REQUEST_BUFFER' ??
?? EJECT ??
  PROCEDURE link_request_buffer(request_buffer: ^rft$request_response_buffer;
                                lockword: ^iot$lockword;
                                request_queue: ^^iot$io_request;
                                request_queue_rma: ^ost$real_memory_address);

{    The purpose of this routine is to link a peripheral request into the
{    specified request queue.
{
{    request_buffer: (input) This parameter specifies a pointer to the request that is to be
{      linked into the specified request queue.
{
{    lockword: (input) This parameter specifies a pointer to the lockword that must be set
{      prior to placing the request into the queue.
{
{    request_queue: (input) This parameter specifies a pointer to the request queue.
{
{    request_queue_rma: (input) This parameter specifies the RMA of the request queue pointer.

    VAR
        ignore_status: ost$status,
        cs_status: 0..2,
        actual_lockword: iot$lockword,
        io_request_ptr: ^iot$io_request,
        count,
        pp_request_rma: integer,
        rhfam_request: ^rft$peripheral_request;

    i#real_memory_address(^request_buffer^.rhfam_request, pp_request_rma);
    request_buffer^.rhfam_request.next_pp_request := NIL;
    request_buffer^.rhfam_request.next_pp_request_rma := 0;
    count := 0;

    osp$begin_system_activity;
    REPEAT
      #compare_swap(lockword^, clear_lockword, set_lockword, actual_lockword, cs_status);
      CASE cs_status OF
      = osc$cs_failed =
        count := count + 1;
        IF (actual_lockword.lock_owner.cpu_lock) OR (count > rfc$max_lock_retries) THEN
          osp$end_system_activity;
          syp$cycle;
          count := 0;
          osp$begin_system_activity;
        IFEND;
      ELSE
        ;
      CASEND;
    UNTIL  cs_status = osc$cs_successful;

    IF  request_queue^ = NIL  THEN
      request_queue^ := ^request_buffer^.io_request;
      request_queue_rma^ := pp_request_rma;
    ELSE
      io_request_ptr := request_queue^;
      REPEAT
        rhfam_request := io_request_ptr^.device_request_p;
        io_request_ptr := rhfam_request^.next_pp_request;
      UNTIL  io_request_ptr = NIL;

      rhfam_request^.next_pp_request := ^request_buffer^.io_request;
      rhfam_request^.next_pp_request_rma := pp_request_rma;
    IFEND;

    REPEAT
      #compare_swap(lockword^, set_lockword, clear_lockword, actual_lockword, cs_status);
    UNTIL  cs_status = osc$cs_successful;

    osp$end_system_activity;

  PROCEND link_request_buffer;
?? OLDTITLE ??
?? OLDTITLE ??
?? TITLE := '  RFP$DELINK_REQUEST' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$delink_request(VAR request_ids: rft$request_identifier;
                                             VAR status: ost$status);

*copyc rfh$delink_request

    VAR
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        unit_number: iot$logical_unit,
        unit_interface_table: ^iot$unit_interface_table;

    status.normal := TRUE;
    CASE  request_ids.ring_3_id.location.kind  OF
    = rfc$pp_request =

      free_wired_request_buffer(request_ids.ring_1_id.entry);

    = rfc$unit_request =

      unit_number := request_ids.ring_3_id.location.logical_unit;
      unit_interface_table :=  cmv$logical_unit_table^[unit_number].unit_interface_table;

      IF  unit_interface_table <> NIL  THEN
        command_buffer := #LOC(request_ids.ring_1_id.address^.command_buffer);
        IF  command_buffer^[rfc$cbi_unit_request_1].lc_function_code = rfc$lc_status_nad  THEN
          rfv$status_response_pending^[request_ids.ring_3_id.nad].in_host := FALSE;
        IFEND;
        delink_and_free_buffer(request_ids.ring_1_id.entry, ^unit_interface_table^.unit_q_lockword,
          ^unit_interface_table^.next_request, ^unit_interface_table^.next_request_rma, status);
      ELSE

        {  This should not happen.

        osp$set_status_abnormal(rfc$product_id, rfe$invalid_peripheral_element, 'UNIT', status);
        osp$append_status_integer(osc$status_parameter_delimiter, unit_number, 10, false, status);
      IFEND;

    ELSE

      {   This means there is a RING 1 TO RING 3 communication error.

      osp$set_status_abnormal(rfc$product_id, rfe$unsupported_request_type, '', status);

    CASEND;

    request_ids.ring_1_id.address := NIL;
    request_ids.ring_1_id.entry := rfc$max_r1_request_id;

  PROCEND rfp$delink_request;
?? NEWTITLE := '    DELINK_AND_FREE_BUFFER' ??
?? EJECT ??
  PROCEDURE delink_and_free_buffer(ring_1_entry: 1..rfc$max_r1_request_id;
                                   lockword: ^iot$lockword;
                                   request_queue: ^^iot$io_request;
                                   request_queue_rma: ^ost$real_memory_address;
                               VAR status: ost$status);

{    The purpose of this routine is to delink a peripheral request from the
{    specified request queue.
{
{    ring_1_entry: (input, output) This parameter specifies the request identifier of the request to
{      delink.
{
{    lockword: (input) This parameter specifies a pointer to the lockword that must be set
{      prior to removing the request from the queue.
{
{    request_queue: (input) This parameter specifies a pointer to the request queue.
{
{    request_queue_rma: (input) This parameter specifies the RMA of the request queue pointer.
{
{    status: (output) This parameter returns the results of the request.  A status of normal
{      means that the request buffer was successfully delinked.

    VAR
        request_ptr: ^rft$request_response_buffer,
        cs_status: 0..2,
        actual_lockword: iot$lockword,
        io_request_ptr: ^iot$io_request,
        count,
        pp_request_rma: integer,
        previous_request,
        rhfam_request: ^rft$peripheral_request;

    status.normal := TRUE;
    count := 0;

    osp$begin_system_activity;
    REPEAT
      #compare_swap(lockword^, clear_lockword, set_lockword, actual_lockword, cs_status);
      CASE cs_status OF
      = osc$cs_failed =
        count := count + 1;
        IF (actual_lockword.lock_owner.cpu_lock) OR (count > rfc$max_lock_retries) THEN
          osp$end_system_activity;
          syp$cycle;
          count := 0;
          osp$begin_system_activity;
        IFEND;
      ELSE
        ;
      CASEND;
    UNTIL  cs_status = osc$cs_successful;

    IF  request_queue^ = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request ID is invalid',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'DELINK_AND_FREE_BUFFER',
        status);
    ELSE
      rhfam_request := request_queue^^.device_request_p;
      IF  rhfam_request^.request_buffer_ptr^.request_id.ring_1_id.entry = ring_1_entry  THEN
        request_queue^ := rhfam_request^.next_pp_request;
        request_queue_rma^ := rhfam_request^.next_pp_request_rma;
      ELSE
        io_request_ptr := rhfam_request^.next_pp_request;
        WHILE   (io_request_ptr <> NIL)
            AND (rhfam_request^.request_buffer_ptr^.request_id.ring_1_id.entry <> ring_1_entry)  DO
          previous_request := rhfam_request;
          rhfam_request := io_request_ptr^.device_request_p;
          io_request_ptr := rhfam_request^.next_pp_request;
        WHILEND;
        IF  rhfam_request^.request_buffer_ptr^.request_id.ring_1_id.entry = ring_1_entry  THEN
          previous_request^.next_pp_request := rhfam_request^.next_pp_request;
          previous_request^.next_pp_request_rma := rhfam_request^.next_pp_request_rma;
        ELSE
          osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request ID is invalid',
            status);
          osp$append_status_parameter(osc$status_parameter_delimiter, 'DELINK_AND_FREE_BUFFER',
            status);
        IFEND;
      IFEND;
    IFEND;

    REPEAT
      #compare_swap(lockword^, set_lockword, clear_lockword, actual_lockword, cs_status);
    UNTIL  cs_status = osc$cs_successful;

    osp$end_system_activity;

    IF  status.normal  THEN
      free_wired_request_buffer(ring_1_entry);
    IFEND;

  PROCEND delink_and_free_buffer;
?? TITLE := '    FREE_WIRED_REQUEST_BUFFER' ??
?? EJECT ??
  PROCEDURE [INLINE] free_wired_request_buffer(buffer_id: 0..rfc$max_r1_request_id);

    lock_table(rfv$request_buffers.lock);
    IF  (buffer_id >= LOWERBOUND(rfv$request_buffers.buffer_list^))  AND
        (buffer_id <= UPPERBOUND(rfv$request_buffers.buffer_list^))  THEN
      rfv$request_buffers.buffer_list^[buffer_id].next_free_entry := rfv$request_buffers.first_free_entry;
      rfv$request_buffers.first_free_entry := buffer_id;
      rfv$request_buffers.free_entries := rfv$request_buffers.free_entries + 1;
    IFEND;
    unlock_table(rfv$request_buffers.lock);

  PROCEND;
?? OLDTITLE ??
?? TITLE := '  RFP$RE_ISSUE_REQUEST' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$re_issue_request(VAR request_ids: rft$request_identifier;
                                               VAR status: ost$status);

*copyc rfh$re_issue_request

    VAR
        pp_number: iot$pp_number,
        unit_number: iot$logical_unit,
        unit_interface_table: ^iot$unit_interface_table,
        pp_interface_table: ^iot$pp_interface_table;

    status.normal := TRUE;

    CASE  request_ids.ring_3_id.location.kind  OF
    = rfc$pp_request =

      pp_number := request_ids.ring_3_id.location.logical_pp;
      pp_interface_table :=  cmv$logical_pp_table_p^ [pp_number].pp_info.pp_interface_table_p;

      IF  pp_interface_table <> NIL  THEN
        clear_complete_flag(request_ids.ring_1_id.entry, ^pp_interface_table^.lockword,
          ^pp_interface_table^.pp_request_queue, status);
      ELSE

        {  This should not happen.

        osp$set_status_abnormal(rfc$product_id, rfe$invalid_peripheral_element, 'PP', status);
        osp$append_status_integer(osc$status_parameter_delimiter, pp_number, 10, false, status);
      IFEND;

    = rfc$unit_request =

      unit_number := request_ids.ring_3_id.location.logical_unit;
      unit_interface_table :=  cmv$logical_unit_table^[unit_number].unit_interface_table;

      IF  unit_interface_table <> NIL  THEN
        clear_complete_flag(request_ids.ring_1_id.entry, ^unit_interface_table^.unit_q_lockword,
          ^unit_interface_table^.next_request, status);
      ELSE

        {  This should not happen.

        osp$set_status_abnormal(rfc$product_id, rfe$invalid_peripheral_element, 'UNIT', status);
        osp$append_status_integer(osc$status_parameter_delimiter, unit_number, 10, false, status);
      IFEND;

    ELSE

      {   This means there is a RING 1 TO RING 3 communication error.

      osp$set_status_abnormal(rfc$product_id, rfe$unsupported_request_type, '', status);

    CASEND;

  PROCEND rfp$re_issue_request;
?? NEWTITLE := '    CLEAR_COMPLETE_FLAG' ??
?? EJECT ??
  PROCEDURE clear_complete_flag(ring_1_entry: 1..rfc$max_r1_request_id;
                                lockword: ^iot$lockword;
                                request_queue: ^^iot$io_request;
                            VAR status: ost$status);

{    The purpose of this routine is to clear the complete flag of a peripheral request to
{    have the PP program retry the request.
{
{    ring_1_entry: (input) This parameter specifies the request identifier of the request to
{      delink.
{
{    lockword: (input) This parameter specifies a pointer to the lockword that must be set
{      prior to clearing the complete flag.
{
{    request_queue: (input) This parameter specifies a pointer to the request queue.
{
{    status: (output) This parameter returns the results of the request.  A status of normal
{      means that the request buffer was successfully delinked.

    VAR
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        cs_status: 0..2,
        actual_lockword: iot$lockword,
        count: INTEGER,
        io_request_ptr: ^iot$io_request,
        rhfam_request: ^rft$peripheral_request;

    status.normal := TRUE;
    count := 0;

    osp$begin_system_activity;
    REPEAT
      #compare_swap(lockword^, clear_lockword, set_lockword, actual_lockword, cs_status);
      CASE cs_status OF
      = osc$cs_failed =
        count := count + 1;
        IF (actual_lockword.lock_owner.cpu_lock) OR (count > rfc$max_lock_retries) THEN
          osp$end_system_activity;
          syp$cycle;
          count := 0;
          osp$begin_system_activity;
        IFEND;
      ELSE
        ;
      CASEND;
    UNTIL  cs_status = osc$cs_successful;

    IF  request_queue^ <> NIL  THEN
      io_request_ptr := request_queue^;
      REPEAT
        rhfam_request := io_request_ptr^.device_request_p;
        io_request_ptr := rhfam_request^.next_pp_request;
      UNTIL  (io_request_ptr = NIL)
          OR (rhfam_request^.request_buffer_ptr^.request_id.ring_1_id.entry = ring_1_entry);
      IF  (rhfam_request^.request_buffer_ptr^.request_id.ring_1_id.entry = ring_1_entry)  THEN
        rhfam_request^.request_buffer_ptr^.response_posted := FALSE;
        command_buffer := #LOC(rhfam_request^.request_buffer_ptr^.command_buffer);
        IF  command_buffer^[rfc$cbi_unit_request_1].lc_function_code = rfc$lc_status_nad  THEN
          command_buffer^[rfc$cbi_unit_request_1].lc_flags.unconditionally_status := TRUE;
          rfv$status_response_pending^[rhfam_request^.request_buffer_ptr^.request_id.ring_3_id.nad].in_host
            := FALSE;
        IFEND;
        command_buffer^[rfc$cbi_unit_request_1].lc_flags.pp_process_complete := FALSE;
      ELSE
        osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request ID is invalid',
          status);
        osp$append_status_parameter(osc$status_parameter_delimiter, 'CLEAR_COMPLETE_FLAG',
          status);
      IFEND;
    ELSE
      osp$set_status_abnormal(rfc$product_id, rfe$request_processing_err, 'the request ID is invalid',
        status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'CLEAR_COMPLETE_FLAG',
        status);
    IFEND;

    REPEAT
      #compare_swap(lockword^, set_lockword, clear_lockword, actual_lockword, cs_status);
    UNTIL  cs_status = osc$cs_successful;

    osp$end_system_activity;

  PROCEND clear_complete_flag;
?? OLDTITLE ??
?? TITLE := '  RFP$UNCONDITIONALLY_STATUS' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$unconditionally_status(unit_number: iot$logical_unit);

*copyc rfh$unconditionally_status

    VAR
        count: INTEGER,
        waiting_for_pp: BOOLEAN,
        request_queue: ^^iot$io_request,
        command_buffer: ^ARRAY [rft$command_entry] OF rft$command,
        cs_status: 0..2,
        lockword: ^iot$lockword,
        actual_lockword: iot$lockword,
        io_request_ptr: ^iot$io_request,
        rhfam_request: ^rft$peripheral_request,
        unit_interface_table: ^iot$unit_interface_table;

    unit_interface_table :=  cmv$logical_unit_table^[unit_number].unit_interface_table;
    IF  unit_interface_table = NIL  THEN
      RETURN;
    IFEND;
    lockword := ^unit_interface_table^.unit_q_lockword;
    request_queue :=  ^unit_interface_table^.next_request;
    REPEAT
      count := 0;
      waiting_for_pp := FALSE;
      osp$begin_system_activity;
      REPEAT
        #compare_swap(lockword^, clear_lockword, set_lockword, actual_lockword, cs_status);
        CASE cs_status OF
        = osc$cs_failed =
          count := count + 1;
          IF (actual_lockword.lock_owner.cpu_lock) OR (count > rfc$max_lock_retries) THEN
            osp$end_system_activity;
            syp$cycle;
            count := 0;
            osp$begin_system_activity;
          IFEND;
        ELSE
          ;
        CASEND;
      UNTIL  cs_status = osc$cs_successful;

      IF  request_queue^ <> NIL  THEN
        io_request_ptr := request_queue^;
        REPEAT
          rhfam_request := io_request_ptr^.device_request_p;
          command_buffer := #LOC(rhfam_request^.request_buffer_ptr^.command_buffer);
          io_request_ptr := rhfam_request^.next_pp_request;
        UNTIL  (io_request_ptr = NIL) OR
               (command_buffer^[rfc$cbi_unit_request_1].lc_function_code = rfc$lc_status_nad);
        IF  command_buffer^[rfc$cbi_unit_request_1].lc_function_code = rfc$lc_status_nad  THEN
          IF  NOT command_buffer^[rfc$cbi_unit_request_1].lc_flags.pp_process_complete  THEN
            IF  NOT command_buffer^[rfc$cbi_unit_request_1].lc_flags.pp_processing  THEN
              command_buffer^[rfc$cbi_unit_request_1].lc_flags.unconditionally_status := TRUE;
            ELSE
              waiting_for_pp := TRUE;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

      REPEAT
        #compare_swap(lockword^, set_lockword, clear_lockword, actual_lockword, cs_status);
      UNTIL  cs_status = osc$cs_successful;

      osp$end_system_activity;

      IF  waiting_for_pp  THEN
        syp$cycle;
      IFEND;

    UNTIL  NOT waiting_for_pp;

  PROCEND rfp$unconditionally_status;
?? TITLE := '  RFP$SET_SYSTEM_TASK_ID' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$set_system_task_id(start_up: boolean);

*copyc rfh$set_system_task_id

    VAR
        task_id: ost$global_task_id;

    IF  start_up  THEN
      pmp$get_executing_task_gtid(task_id);
    ELSE
      task_id := tmv$null_global_task_id;
    IFEND;
    rfv$system_task_id := task_id;

  PROCEND rfp$set_system_task_id;
?? NEWTITLE := '    RFP$RELEASE_REQUEST_BUFFERS' ??
?? EJECT ??
  PROCEDURE [XDCL,#GATE]  rfp$release_request_buffers;

*copyc rfh$release_request_buffers

    VAR
        buffer_id: 0..rfc$max_r1_request_id,
        free_buffer: ^rft$request_response_buffer;


    {  No interlock is obtained here since the system task should not call this routine
    {  if there are any active pp requests.

    IF  rfv$request_buffers.buffer_list <> NIL  THEN
      FOR  buffer_id := LOWERBOUND(rfv$request_buffers.buffer_list^)  TO
                        UPPERBOUND(rfv$request_buffers.buffer_list^)  DO
        IF  rfv$request_buffers.buffer_list^[buffer_id].buffer <> NIL  THEN
          FREE  rfv$request_buffers.buffer_list^[buffer_id].buffer  IN osv$mainframe_wired_cb_heap^;
        IFEND;
      FOREND;
      FREE  rfv$request_buffers.buffer_list  IN  osv$mainframe_pageable_heap^;
    IFEND;
    IF  rfv$status_response_pending <> NIL  THEN
      FREE  rfv$status_response_pending  IN  osv$mainframe_wired_cb_heap^;
    IFEND;

  PROCEND rfp$release_request_buffers;
?? TITLE := '    RFP$RESERVE_REQUEST_BUFFERS' ??
?? EJECT ??
  PROCEDURE [XDCL,#GATE]  rfp$reserve_request_buffers(buffer_count: INTEGER;
                                                  VAR status: ost$status);

*copyc rfh$reserve_request_buffers

    VAR
        nad_index,
        local_nads: rft$local_nads,
        buffer_id,
        buff_id: 0..rfc$max_r1_request_id,
        buffer: ^rft$request_response_buffer;

    local_nads := buffer_count DIV rfc$max_concurrent_requests;
    ALLOCATE  rfv$status_response_pending : [1..local_nads]  IN  osv$mainframe_wired_cb_heap^;
    IF  rfv$status_response_pending = NIL  THEN
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'mainframe_wired', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$RESERVE_REQUEST_BUFFERS', status);
      RETURN;
    IFEND;
    FOR  nad_index := 1  TO  local_nads  DO
      rfv$status_response_pending^[nad_index].in_host := FALSE;
    FOREND;

    {  No interlock is obtained here because the system task calls this
    {  routine before initialization is complete.

    ALLOCATE  rfv$request_buffers.buffer_list : [1..buffer_count]  IN  osv$mainframe_pageable_heap^;
    IF  rfv$request_buffers.buffer_list <> NIL  THEN
      rfv$request_buffers.free_entries := 0;
      rfv$request_buffers.entry_count := 0;
      rfv$request_buffers.first_free_entry := 0;
      rfv$request_buffers.first_open_entry := LOWERBOUND(rfv$request_buffers.buffer_list^);
      FOR  buffer_id := LOWERBOUND(rfv$request_buffers.buffer_list^)  TO
                        UPPERBOUND(rfv$request_buffers.buffer_list^)  DO
        rfv$request_buffers.buffer_list^[buffer_id].buffer := NIL;
        rfv$request_buffers.buffer_list^[buffer_id].next_free_entry := 0;
        IF  buffer_id = UPPERBOUND(rfv$request_buffers.buffer_list^)  THEN
          rfv$request_buffers.buffer_list^[buffer_id].next_open_entry := 0;
        ELSE
          rfv$request_buffers.buffer_list^[buffer_id].next_open_entry := buffer_id + 1;
        IFEND;
      FOREND;

      {  Pre-allocate a few buffers for performance purposes.

      FOR  buffer_id := 1 TO 4  DO
        ALLOCATE buffer IN osv$mainframe_wired_cb_heap^;
        IF  buffer = NIL  THEN
          RETURN;
        IFEND;
        buff_id := rfv$request_buffers.first_open_entry;
        rfv$request_buffers.first_open_entry := rfv$request_buffers.buffer_list^[buff_id].next_open_entry;
        rfv$request_buffers.buffer_list^[buff_id].buffer := buffer;
        rfv$request_buffers.buffer_list^[buff_id].next_free_entry := rfv$request_buffers.first_free_entry;
        rfv$request_buffers.first_free_entry := buff_id;
        rfv$request_buffers.free_entries := rfv$request_buffers.free_entries + 1;
        rfv$request_buffers.entry_count := rfv$request_buffers.entry_count + 1;
      FOREND;
    ELSE
      osp$set_status_abnormal(rfc$product_id, rfe$heap_exhausted, 'mainframe_paged', status);
      osp$append_status_parameter(osc$status_parameter_delimiter, 'RFP$RESERVE_REQUEST_BUFFERS', status);
    IFEND;

  PROCEND rfp$reserve_request_buffers;
?? OLDTITLE ??
?? TITLE := '  RFP$CHANGE_NAD_STATUS' ??
?? EJECT ??
  PROCEDURE [XDCL, #GATE] rfp$change_nad_status(nad_unit: iot$logical_unit;
                                                nad_state: rft$element_state);

{    The purpose of this routine is to change the state of a nad.
{
{    nad_unit: (input) This parameter specifies the logical unit number of the corresponding
{      nad, whose status is to be changed.
{
{    nad_state: (input) This parameter specifies the state that the corresponding NAD should be
{      changed to.

    VAR
        count: INTEGER,
        nad_state_flags: ^rft$nad_state_flags,
        switch_state_ptr: ^cell,
        unit_status: iot$unit_status,
        unit_interface_table: ^iot$unit_interface_table,
        ignore_status: ost$status,
        cs_status: 0..2,
        lockword: ^iot$lockword,
        actual_lockword: iot$lockword;

    unit_interface_table :=  cmv$logical_unit_table^[nad_unit].unit_interface_table;

    IF  unit_interface_table = NIL  THEN

      {  This should not happen, ignore request }

      RETURN;
    IFEND;

    lockword := ^unit_interface_table^.unit_q_lockword;
    count := 0;

    osp$begin_system_activity;
    REPEAT
      #compare_swap(lockword^, clear_lockword, set_lockword, actual_lockword, cs_status);
      CASE cs_status OF
      = osc$cs_failed =
        count := count + 1;
        IF (actual_lockword.lock_owner.cpu_lock) OR (count > rfc$max_lock_retries) THEN
          osp$end_system_activity;
          syp$cycle;
          count := 0;
          osp$begin_system_activity;
        IFEND;
      ELSE
        ;
      CASEND;
    UNTIL  cs_status = osc$cs_successful;

    unit_status := unit_interface_table^.unit_status;
    switch_state_ptr := ^unit_status;
    nad_state_flags := switch_state_ptr;

    IF  nad_state = rfc$es_on  THEN
      nad_state_flags^.disabled := FALSE;
      nad_state_flags^.down := FALSE;
    ELSEIF nad_state = rfc$es_down  THEN
      nad_state_flags^.down := TRUE;
    ELSE
      nad_state_flags^.disabled := TRUE;
    IFEND;

    unit_interface_table^.unit_status := unit_status;

    REPEAT
      #compare_swap(lockword^, set_lockword, clear_lockword, actual_lockword, cs_status);
    UNTIL  cs_status = osc$cs_successful;

    osp$end_system_activity;

  PROCEND rfp$change_nad_status;
?? TITLE := '  lock_table', EJECT ??
  PROCEDURE  lock_table (VAR lock: ost$signature_lock);

{
{     The purpose of this procedure is to obtain the global lock on a
{     RHFAM ring 1 table.  This procedure increments the system table lock
{     count to prevent unnecessary swapping.
{
{     LOCK: (input,output)  This parameter specifies the signature lock to
{       obtain.
{


    osp$begin_system_activity;
    osp$set_job_signature_lock(lock);

  PROCEND lock_table;
?? TITLE := '  unlock_table ', EJECT ??
  PROCEDURE unlock_table (VAR lock: ost$signature_lock);

{
{     The purpose of this procedure is to release a global lock on a RHFAM
{     ring 1 table.  This procedure decrements the system buffer locked
{     count that was incremented when the table was locked.
{
{     LOCK: (input,output)  This parameter specifies the signature lock to
{       release.
{


    osp$clear_job_signature_lock(lock);
    osp$end_system_activity;

  PROCEND unlock_table;
MODEND rfm$request_processing_r1;

