?? RIGHT := 110 ??
MODULE dfm$mock_driver;
{
{ This module contains code to simulate the file server driver.
{ This allows some testing of file server code in either a closed
{ shop environment, or in a hands on environment for which there is no
{ physical connection.
{ Currently the only data that may be moved must be in the server
{ wired segment and established by remote procedure call.
{
?? PUSH (LISTEXT := ON) ??
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc dfc$poll_constants
*copyc dfd$request_package
*copyc dfp$determine_client_status
*copyc dfi$display
*copyc dfe$error_condition_codes
*copyc dfp$fetch_qit
*copyc dfp$fetch_queue_entry
*copyc dfp$process_task_request
*copyc dfp$record_transaction_data
*copyc dfp$set_driver_active
*copyc dfp$verify_system_administrator
*copyc dfs$server_wired
*copyc dft$assign_queue_entry_status
*copyc dfv$server_wired_heap
*copyc osp$set_status_abnormal
*copyc ost$caller_identifier
*copyc osv$page_size
*copyc pmp$ready_task
*copyc pmp$long_term_wait
?? POP ??

  VAR
    dfv$p_mock_held_over_data_ptrs:  ^array [1 .. * ] of ^ SEQ
           (REP dfc$max_data_record_bytes OF cell) :=    NIL;

?? EJECT ??
{
{  This command provides a means of executing the test driver from
{  a job. Repeated calls must be made to this to continue driving
{  requests. For example:
{   TASK,DRIVER
{       exet sp=dfp$initiate_test_driver  p=' mock_driver,true, 2000'
{   TASKEND

  PROCEDURE [XDCL, #GATE] dfp$initiate_test_driver
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);



{ pdt initiate_test_driver (driver_name, dn: name = $required
{  continue, c: boolean = false
{  wait_time, wt: integer 0 .. 4000000 = 2000
{  status)

?? PUSH (LISTEXT := ON) ??

  VAR
    initiate_test_driver: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
      ^initiate_test_driver_names, ^initiate_test_driver_params];

  VAR
    initiate_test_driver_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
      clt$parameter_name_descriptor := [['DRIVER_NAME', 1], ['DN', 1], ['CONTINUE', 2], ['C', 2], ['WAIT_TIME'
      , 3], ['WT', 3], ['STATUS', 4]];

  VAR
    initiate_test_driver_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of
      clt$parameter_descriptor := [

{ DRIVER_NAME DN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ CONTINUE C }
    [[clc$optional_with_default, ^initiate_test_driver_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$boolean_value]],

{ WAIT_TIME WT }
    [[clc$optional_with_default, ^initiate_test_driver_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 4000000]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    initiate_test_driver_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';

  VAR
    initiate_test_driver_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := '2000';

?? POP ??

    VAR
      continue: boolean,
      driver_name: ost$name,
      p_queue_interface_table: dft$p_queue_interface_table,
      wait_time: integer,
      value: clt$value;

    dfp$verify_system_administrator ('INITIATE_TEST_DRIVER', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, initiate_test_driver, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DRIVER_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    driver_name := value.name.value;
    dfp$fetch_qit (driver_name, p_queue_interface_table, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('CONTINUE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    continue := value.bool.value;
    IF continue THEN
      clp$get_value ('WAIT_TIME', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      wait_time := value.int.value;
    IFEND;


    dfp$set_driver_active (driver_name, TRUE, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    REPEAT
      dfp$test_driver (p_queue_interface_table);
      IF continue THEN
        pmp$long_term_wait (wait_time, wait_time);
      IFEND;
    UNTIL NOT continue;
  PROCEND dfp$initiate_test_driver;
?? EJECT ??
{ Move the entries from the request buffer to the destination queue.
{ If the destination queue is the server then process the request.

  PROCEDURE [XDCL] dfp$test_driver (p_queue_interface_table:
   dft$p_queue_interface_table);


    VAR
      p_request_buffer: ^dft$request_buffer_directory,
      request_buffer_index: 1 .. dfc$max_request_buffer_entries,
      status: ost$status;


    IF p_queue_interface_table <> NIL THEN
      p_request_buffer := ^p_queue_interface_table^.request_buffer_directory;

    /process_all_requests/
      WHILE p_request_buffer^.inn <> p_request_buffer^.out DO
        #SPOIL (p_request_buffer^.out, p_request_buffer^.inn);
        request_buffer_index := (p_request_buffer^.out + 8) DIV 8;
        IF p_request_buffer^.out = p_request_buffer^.limit THEN
          p_request_buffer^.out := 0;
        ELSE
          p_request_buffer^.out := (p_request_buffer^.out + 8);
        IFEND;
        #SPOIL (p_request_buffer^.out, p_request_buffer^.inn);
        process_request (p_queue_interface_table,
              request_buffer_index, p_request_buffer^.p_request_buffer^.
              request_buffer_entries [request_buffer_index]);
        #SPOIL (p_request_buffer^.out, p_request_buffer^.inn);
      WHILEND /process_all_requests/;
    IFEND;
  PROCEND dfp$test_driver;
?? EJECT ??

  PROCEDURE process_request
    (    p_queue_interface_table: dft$p_queue_interface_table;
         request_buffer_index: 1 .. dfc$max_request_buffer_entries;
     VAR request_buffer_entry: dft$request_buffer_entry);

    VAR
      caller_id: ost$caller_identifier,
      destination_queue_index: dft$queue_index,
      display_length: integer,
      display_string: string (80),
      held_over_data: dft$queue_entry_index,
      mainframe_name: pmt$mainframe_id,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_destination_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_destination_drivr_queue_entry: ^dft$driver_queue_entry,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_driver_queue_header: ^dft$driver_queue_header,
      queue_entry_index: dft$queue_entry_index,
      queue_index: dft$queue_index,
      send_command: boolean,
      server_to_client: boolean,
      status: ost$status;

    #CALLER_ID (caller_id);
    IF request_buffer_entry.queue_index = 0 THEN
      RETURN;
    IFEND;
    display_integer ('* Mock Driver - request buffer index ', request_buffer_index);
    queue_index := request_buffer_entry.queue_index;
    queue_entry_index := request_buffer_entry.queue_entry_index;
    request_buffer_entry.queue_index := 0;

    p_driver_queue_header := ^p_queue_interface_table^.queue_directory.
          driver_queue_pva_directory [queue_index].p_driver_queue^.queue_header;

    { Initialize held over data area.
    IF dfv$p_mock_held_over_data_ptrs = NIL THEN
      ALLOCATE dfv$p_mock_held_over_data_ptrs: [1 .. p_driver_queue_header^.number_of_queue_entries] IN
            dfv$server_wired_heap^;
      FOR held_over_data := 1 TO UPPERBOUND (dfv$p_mock_held_over_data_ptrs^) DO
        dfv$p_mock_held_over_data_ptrs^ [held_over_data] := NIL;
      FOREND;
    IFEND;

    { Get the source queue entry pointers
    dfp$fetch_queue_entry (p_queue_interface_table, queue_index, queue_entry_index, p_driver_queue_entry,
          p_cpu_queue_entry);

    { Get the destination values
    destination_queue_index := p_driver_queue_header^.connection_descriptor.destination.queue_index;
    STRINGREP (display_string, display_length, '  Source queue ', queue_index, ' - Entry ', queue_entry_index,
          ' >-> Destination queue ', destination_queue_index);
    display (display_string (1, display_length));

    dfp$fetch_queue_entry (p_queue_interface_table, destination_queue_index, queue_entry_index,
          p_destination_drivr_queue_entry, p_destination_cpu_queue_entry);

    server_to_client := p_driver_queue_header^.connection_descriptor.source.flags.server_to_client;
    dfp$record_transaction_data (p_destination_drivr_queue_entry^, p_destination_cpu_queue_entry^,
          p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [destination_queue_index].
          p_cpu_queue^.queue_header.transaction_data);
    IF NOT (p_driver_queue_entry^.flags.send_command OR p_driver_queue_entry^.flags.send_data OR
          p_driver_queue_entry^.flags.send_ready_for_data) THEN
      display (' -- ERROR----- REQUEST QUEUED BUT NO FLAGS SET ');
      p_destination_drivr_queue_entry^.flags.subsystem_action := TRUE;
    IFEND;

    send_command := p_driver_queue_entry^.flags.send_command;
    IF p_driver_queue_entry^.flags.send_command THEN
      IF server_to_client THEN
        { Leave the flags alone on the server.
        display_integer ('  Client <--< Server (bytes)', p_driver_queue_entry^.send_buffer_descriptor.
              actual_length);
      ELSE
        p_driver_queue_entry^.flags.buffer_sent := TRUE;
        display_integer ('  Client >--> Server (bytes) ', p_driver_queue_entry^.send_buffer_descriptor.
              actual_length);
      IFEND;
      i#move (p_cpu_queue_entry^.p_send_buffer, p_destination_cpu_queue_entry^.p_receive_buffer,
            p_driver_queue_entry^.send_buffer_descriptor.actual_length);
      p_driver_queue_entry^.flags.send_command := FALSE;
      p_destination_drivr_queue_entry^.flags.buffer_received := TRUE;
    IFEND;
    IF p_driver_queue_entry^.flags.send_data THEN
      IF server_to_client THEN
        display ('  Sending data CLIENT <--< SERVER ');
      ELSE
        display ('  Sending data CLIENT >--> SERVER ');
      IFEND;
      IF p_destination_drivr_queue_entry^.data_descriptor.actual_length = 0 THEN
        display_integer ('  Destination not ready- data i#move to hold over area ',
              (p_driver_queue_entry^.data_descriptor.actual_length DIV 8) * osv$page_size);
        ALLOCATE dfv$p_mock_held_over_data_ptrs^ [queue_entry_index] IN dfv$server_wired_heap^;
        i#move (p_cpu_queue_entry^.p_send_data, dfv$p_mock_held_over_data_ptrs^ [queue_entry_index],
              (p_driver_queue_entry^.data_descriptor.actual_length DIV 8) * osv$page_size);
      ELSE
          display_integer ('  i#move ',
                (p_driver_queue_entry^.data_descriptor.actual_length DIV 8) * osv$page_size);
          i#move (p_cpu_queue_entry^.p_send_data, p_destination_cpu_queue_entry^.p_receive_data,
                (p_driver_queue_entry^.data_descriptor.actual_length DIV 8) * osv$page_size);
          p_destination_drivr_queue_entry^.flags.data_received := TRUE;
      IFEND;
      p_driver_queue_entry^.flags.send_data := FALSE;
      IF server_to_client THEN
        display ('  setting subsystem action on SERVER ');
        p_driver_queue_entry^.flags.subsystem_action := TRUE;
      IFEND;
    IFEND;
    IF p_driver_queue_entry^.flags.send_ready_for_data THEN
      IF server_to_client THEN
        display ('  SERVER ready for data from client');
      ELSE
        display ('  CLIENT ready for data from SERVER ');
      IFEND;
      display_integer ('  i#move from hold over area', (p_driver_queue_entry^.data_descriptor.
            actual_length DIV 8) * osv$page_size);
      i#move (dfv$p_mock_held_over_data_ptrs^ [queue_entry_index], p_cpu_queue_entry^.p_receive_data,
            (p_driver_queue_entry^.data_descriptor.actual_length DIV 8) * osv$page_size);
      FREE dfv$p_mock_held_over_data_ptrs^ [queue_entry_index] IN dfv$server_wired_heap^;
      p_driver_queue_entry^.flags.subsystem_action := TRUE;
      p_driver_queue_entry^.flags.send_ready_for_data := FALSE;
      p_destination_drivr_queue_entry^.flags.ready_for_data_received := TRUE;
    IFEND;
    p_driver_queue_entry^.flags.driver_action := FALSE;
    p_destination_drivr_queue_entry^.flags.subsystem_action := TRUE;

    IF caller_id.ring = 3 THEN
      { The mock driver is running in a hands on environment actually activate
      { the task.
      display_integer ('  readying task.index ', p_destination_cpu_queue_entry^.global_task_id.index);
      pmp$ready_task (p_destination_cpu_queue_entry^.global_task_id, status);
      IF NOT status.normal THEN
        display (' ---- error from pmp$ready_task ---');
        display_status (status);
      IFEND;
    ELSE { stubs environment
      IF NOT server_to_client THEN
        IF send_command THEN
          display ('  Calling dfp$process_task_request on SERVER ');
          IF queue_entry_index = dfc$poll_queue_index THEN
            display ('     Poll task request.');
            mainframe_name := p_queue_interface_table^.queue_directory.
                 cpu_queue_pva_directory [destination_queue_index].p_cpu_queue^.queue_header.
                 destination_mainframe_name;
            dfp$determine_client_status (mainframe_name, status);
          ELSE
            display ('     User request.');
            dfp$process_task_request (p_queue_interface_table, destination_queue_index, queue_entry_index,
                  p_destination_drivr_queue_entry, p_destination_cpu_queue_entry, status);
            display ('  Server request returned ');
          IFEND;
          IF NOT status.normal THEN
            display (' ---- ERROR from dfp$process_task_request ---');
            display_status (status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND process_request;

MODEND dfm$mock_driver;
