MODULE osm$simulate_disk_fault;
?? PUSH (LISTEXT := ON) ??
*copyc osd$default_pragmats
*copyc clp$scan_parameter_list
*copyc clp$get_value
*copyc clt$parameter_list
*copyc osv$simulated_disk_fault
*copyc clp$get_fs_path_elements
*copyc fsp$convert_fs_structure_to_pf
*copyc clp$convert_cyc_ref_to_cyc_sel
*copyc jmp$system_job
*copyc pfp$dm_attach_item
*copyc pfp$dm_return_item
*copyc osp$generate_message
*copyc mmp$lock_segment
*copyc mmp$write_modified_pages
*copyc mmp$unlock_segment
*copyc mmp$open_file_by_sfid
*copyc mmp$close_device_file
*copyc osp$simulate_disk_fault_r1
*copyc osp$clear_disk_faults_r1

  VAR
    osv$disk_fault_simulation: [XREF] boolean;

?? POP ??

{ Purpose:
{  This module processes operator commands that set and clear mass storage
{ faults.
{  It runs in ring 3 and interfaces with the permanent file system.
{ Design:
{  iom$process_io_completions looks at a table maintained by this module to
{ determine
{  if a particular i/o request should be considered as completing in error
{ (even
{  though it completed normally).
{ Notes:
{  Only the operator (system job) can execute these commands.
{  No interlocking is performed.


?? EJECT ??

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

{ Purpose:
{  To attach a pf or catalog and put the sfid into the table looked at
{  by iom$process_io_completions.
{ Design:
{  A special PF interface is used to attach a file or catalog.
{  Pages of the file must be flushed from memory so that disk i/o
{  will actually take place.
{  A ring 1 interface is used to maintain entries in the table.
{  The file is normally left attached until a clear_mass_storage_fault
{  command so that the sfid will remain valid.



{    PDT sdf_pdt (
{      file,f: file
{      sfid: integer
{      skip_count,sc: integer = 0
{      count,c: integer = 1
{      read_fault,rf: boolean = true
{      write_fault,wf: boolean = true
{      locked_page,lp: boolean = false
{      first_byte,fb: integer = 0
{      last_byte,lb: integer = 7fffffff(16)
{      error_type,et: key media, unrecovered, down = down)

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

  VAR
    sdf_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^sdf_pdt_names, ^sdf_pdt_params];

  VAR
    sdf_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 19] of
  clt$parameter_name_descriptor := [['FILE', 1], ['F', 1], ['SFID', 2], ['SKIP_COUNT', 3], ['SC', 3], ['COUNT'
  , 4], ['C', 4], ['READ_FAULT', 5], ['RF', 5], ['WRITE_FAULT', 6], ['WF', 6], ['LOCKED_PAGE', 7], ['LP', 7],
  ['FIRST_BYTE', 8], ['FB', 8], ['LAST_BYTE', 9], ['LB', 9], ['ERROR_TYPE', 10], ['ET', 10]];

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

{ FILE F }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ SFID }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, clc$min_integer,
  clc$max_integer]],

{ SKIP_COUNT SC }
    [[clc$optional_with_default, ^sdf_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ COUNT C }
    [[clc$optional_with_default, ^sdf_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ READ_FAULT RF }
    [[clc$optional_with_default, ^sdf_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ WRITE_FAULT WF }
    [[clc$optional_with_default, ^sdf_pdt_dv6], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ LOCKED_PAGE LP }
    [[clc$optional_with_default, ^sdf_pdt_dv7], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ FIRST_BYTE FB }
    [[clc$optional_with_default, ^sdf_pdt_dv8], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ LAST_BYTE LB }
    [[clc$optional_with_default, ^sdf_pdt_dv9], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$integer_value, clc$min_integer, clc$max_integer]],

{ ERROR_TYPE ET }
    [[clc$optional_with_default, ^sdf_pdt_dv10], 1, 1, 1, 1, clc$value_range_not_allowed, [^sdf_pdt_kv10,
  clc$keyword_value]]];

  VAR
    sdf_pdt_kv10: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := ['MEDIA',
  'UNRECOVERED','DOWN'];

  VAR
    sdf_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    sdf_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '1';

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

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

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

  VAR
    sdf_pdt_dv8: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    sdf_pdt_dv9: [STATIC, READ, cls$pdt_names_and_defaults] string (12) := '7fffffff(16)';

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

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

    VAR
      sfid_converter: record
        case boolean of
        = TRUE =
          int: 0 .. 0ffffffff(16),
        = FALSE =
          sfid: gft$system_file_identifier,
        casend,
      recend,
      cycle_selector: clt$cycle_selector,
      efr: fst$evaluated_file_reference,
      path: ^pft$path,
      sdf: ost$simulated_disk_fault,
      ls: ost$status,
      segment: ost$segment,
      open,
      locked: boolean,
      value: clt$value;

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

    IF NOT osv$disk_fault_simulation THEN
      RETURN;
    IFEND;

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

    clp$get_value ('FILE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$unknown_value THEN
      clp$get_value ('SFID', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.kind = clc$unknown_value THEN
        osp$set_status_abnormal ('XX', 0, 'Either FILE or SFID is required',
              status);
        RETURN;
      IFEND;
      sfid_converter.int := value.int.value;
      sdf.sfid := sfid_converter.sfid;
      sdf.direct_sfid := TRUE;
    ELSE
      clp$get_fs_path_elements (value.file.local_file_name, efr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      PUSH path: [1 .. efr.number_of_path_elements];
      fsp$convert_fs_structure_to_pf (efr, path);
      clp$convert_cyc_ref_to_cyc_sel (efr.cycle_reference, cycle_selector);
      pfp$dm_attach_item (path^, cycle_selector.value, sdf.sfid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      sdf.direct_sfid := FALSE;
    IFEND;

    open := FALSE;
    locked := FALSE;

  /file_attached/
    BEGIN
      clp$get_value ('SKIP_COUNT', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.skip_count := value.int.value;

      clp$get_value ('COUNT', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.count := value.int.value;

      clp$get_value ('LOCKED_PAGE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      sdf.locked_page := value.bool.value;
      IF sdf.locked_page THEN
        sdf.count := value.int.value;
        sdf.read_fault := FALSE;
        sdf.write_fault := FALSE;
        sdf.error_type := ioc$no_error;
        sdf.in_use := TRUE;
        osp$simulate_disk_fault_r1 (sdf, status);
        IF status.normal THEN
          { Normal exit for "locked_page" option.
          RETURN;
        ELSE
          EXIT /file_attached/;
        IFEND;
      IFEND;

      clp$get_value ('READ_FAULT', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.read_fault := value.bool.value;

      clp$get_value ('WRITE_FAULT', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.write_fault := value.bool.value;

      clp$get_value ('FIRST_BYTE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.first_byte := value.int.value;

      clp$get_value ('LAST_BYTE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      sdf.last_byte := value.int.value;

      clp$get_value ('ERROR_TYPE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /file_attached/
      IFEND;
      IF value.name.value = 'MEDIA' THEN
        sdf.error_type := ioc$media_error;
      ELSEIF value.name.value = 'UNRECOVERED' THEN
        sdf.error_type := ioc$unrecovered_error;
      ELSE
        sdf.error_type := ioc$unrecovered_error_unit_down;
      IFEND;

      mmp$open_file_by_sfid (sdf.sfid, 3, 3, mmc$as_random,
            mmc$sar_write_extend, segment, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      open := TRUE;
      mmp$lock_segment (#ADDRESS (3, segment, 0), mmc$lus_lock_for_write,
            osc$wait, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      locked := TRUE;
      mmp$write_modified_pages (#ADDRESS (3, segment, 0), 7fffffff(16),
            osc$wait, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      mmp$unlock_segment (#ADDRESS (3, segment, 0), mmc$lus_free, osc$wait,
            status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      locked := FALSE;
      mmp$close_device_file (segment, status);
      IF NOT status.normal THEN
        EXIT /file_attached/;
      IFEND;
      open := FALSE;

      sdf.in_use := TRUE;
      osp$simulate_disk_fault_r1 (sdf, status);
      IF status.normal THEN
        {Normal exit
        RETURN;
      IFEND;

    END /file_attached/;

    {Error exit

    IF locked THEN
      mmp$unlock_segment (#ADDRESS (3, segment, 0), mmc$lus_none, osc$wait,
            ls);
      IF NOT ls.normal THEN
        osp$generate_message (ls, ls);
      IFEND;
      locked := FALSE;
    IFEND;
    IF open THEN
      mmp$close_device_file (segment, ls);
      IF NOT ls.normal THEN
        osp$generate_message (ls, ls);
      IFEND;
      open := FALSE;
    IFEND;
    IF NOT sdf.direct_sfid THEN
      pfp$dm_return_item (sdf.sfid, ls);
      IF NOT ls.normal THEN
        osp$generate_message (ls, ls);
      IFEND;
    IFEND;


  PROCEND osp$simulate_disk_fault;
?? EJECT ??

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

{ Purpose:
{  To remove (clear) all disk faults that are currently set.
{ Design:
{  A special PF interface is used to detach the file.
{  A ring 1 routine is called to invalidate the entries.

{ PDT clemsf_pdt

?? PUSH (LISTEXT := ON) ??

    VAR
      clemsf_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [NIL, NIL];

?? POP ??

    VAR
      ls: ost$status,
      sdf: array [1 .. osc$max_simulated_faults] of ost$simulated_disk_fault,
      i: integer;

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

    IF NOT osv$disk_fault_simulation THEN
      RETURN;
    IFEND;

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

    sdf := osv$simulated_disk_fault;
    osp$clear_disk_faults_r1;
    FOR i := LOWERBOUND (sdf) TO UPPERBOUND (sdf) DO
      IF sdf [i].in_use THEN
        IF NOT sdf [i].direct_sfid THEN
          pfp$dm_return_item (sdf [i].sfid, status);
          IF NOT status.normal THEN
            osp$generate_message (status, ls);
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    status.normal := true;
  PROCEND osp$clear_disk_faults;

MODEND osm$simulate_disk_fault
