MODULE dum$segment_file_manager;
?? RIGHT := 110 ??
*copy osd$default_pragmats

{ PURPOSE:
{
{   This module contains SCL command and function processors to implement
{   segment file access within the Analyze System utility.
{
{ DESIGN:
{
{   This module contains SCL commands for opening and closing files for segment
{   access and an SCL function for obtaining the address assigned to an open
{   file.  A table is maintained to describe each file that has been opened.
{   The table is keyed by the Global File Name of the file being described.
{   Each file is allowed to be opened only once.  The entry for a file contains
{   the address assigned to the file so it may be returned by the "$file_pva"
{   function whenever requested.  The entry also contains the file identifier
{   for use when the file is closed.  The "open_file" command allows files to be
{   opened with arbitrary access and share modes and to be created if desired.
{   As a convenience, the "$file_pva" function opens a file for "read" access if
{   it is not already open.  The "close_file" command may be used to close an
{   individual file or all open files.  Files are removed from the table when
{   they are closed.
{
{   The size of the table is fixed at compile time and determines the maximum
{   number of files that can be open at one time.  The size can easily be
{   changed by changing the one line in the type definitions that sets the upper
{   bound of the file list array.

?? PUSH (LISTEXT := ON) ??
*copyc amp$fetch
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc clp$evaluate_parameters
*copyc clt$work_area
*copyc due$exception_condition_codes
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_file
*copyc osp$append_status_integer
*copyc osp$set_status_abnormal
?? POP ??
?? NEWTITLE := '  Global Definitions', EJECT ??
  CONST
    c$access_based = 'ACCESS_BASED                   ',
    c$all = 'ALL                            ',
    c$append = 'APPEND                         ',
    c$always = 'ALWAYS                         ',
    c$execute = 'EXECUTE                        ',
    c$modify = 'MODIFY                         ',
    c$never = 'NEVER                          ',
    c$permitted = 'PERMITTED                      ',
    c$read = 'READ                           ',
    c$shorten = 'SHORTEN                        ',
    c$write = 'WRITE                          ';

  TYPE
    t$create_option  = (c$always_create, c$sometimes_create, c$never_create),

    t$open_options = record
      access_mode: fst$access_modes,
      share_mode: fst$share_modes,
      create_option: t$create_option,
      allow_previous_open: boolean,
    recend;

  CONST
    c$nil_file_index = 0;

  TYPE
    t$file_list = record
      file_count: t$file_index,
      files: array [1 .. 16] of t$file_entry,
    recend,

    t$file_entry = record
      gfn: ost$binary_unique_name,
      fid: amt$file_identifier,
      pva: ^cell,
    recend,

    t$file_index = 0 .. 4096;

  VAR
    v$file_list: t$file_list := [c$nil_file_index, *];
?? TITLE := '  dup$close_file_command', EJECT ??

  PROCEDURE [XDCL] dup$close_file_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE close_file, clof (
{   file, f: any of
{       key
{         all
{       keyend
{       file
{     anyend = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 31, 11, 28, 56, 915],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 67, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$file_type, clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

    CONST
      p$file = 1,
      p$status = 2;

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

    VAR
      file_exists: boolean,
      file_index: t$file_index,
      gfn: ost$binary_unique_name,
      p_file_reference: ^fst$file_reference;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (pvt [p$file].value^.kind = clc$file) THEN
      p_file_reference := pvt [p$file].value^.file_value;
      get_file_info (p_file_reference^, file_exists, gfn, file_index);
      IF (file_index = c$nil_file_index) THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$file_not_open, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, p_file_reference^, status);
      ELSE
        fsp$close_file (v$file_list.files [file_index].fid, status);
        IF status.normal THEN
          release_file_list_entry (file_index);
        IFEND;
      IFEND;
    ELSE
      WHILE (v$file_list.file_count > 0) AND status.normal DO
        fsp$close_file (v$file_list.files [1].fid, status);
        IF status.normal THEN
          release_file_list_entry (1);
        IFEND;
      WHILEND;
    IFEND;
  PROCEND dup$close_file_command;
?? TITLE := '  dup$file_pva_function', EJECT ??

  PROCEDURE [XDCL] dup$file_pva_function (parameter_list: clt$parameter_list;
    VAR p_work: ^clt$work_area;
    VAR p_value: ^clt$data_value;
    VAR status: ost$status);

{ FUNCTION $file_pva, $fp (
{   file: file = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 29, 16, 28, 37, 631],
    clc$function, 1, 1, 1, 0, 0, 0, 0, ''], [
    ['FILE                           ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]]];

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

    CONST
      p$file = 1;

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

    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          pva: ^cell,
        = 1 =
          pva_subrange: 0 .. 0ffffffffffff(16),
        casend,
      recend;

    VAR
      file_index: t$file_index,
      open_options: t$open_options,
      pva: ^cell;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    open_options.access_mode.selector := fsc$specific_access_modes;
    open_options.access_mode.value := $fst$file_access_options [fsc$read];
    open_options.share_mode.selector := fsc$determine_from_access_modes;
    open_options.create_option := c$never_create;
    open_options.allow_previous_open := TRUE;

    open_file (pvt [p$file].value^.file_value^, open_options, file_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pva := v$file_list.files [file_index].pva;

    NEXT p_value IN p_work;
    p_value^.kind := clc$integer;
    p_value^.integer_value.radix := 16;
    p_value^.integer_value.radix_specified := TRUE;
    converter.pva := pva;
    p_value^.integer_value.value := converter.pva_subrange;
  PROCEND dup$file_pva_function;
?? TITLE := '  dup$open_file_command', EJECT ??

  PROCEDURE [XDCL] dup$open_file_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);

{ PROCEDURE open_file, opef (
{   file, f: file = $required
{   access_mode, am: any of
{       key
{         (permitted, p)
{         all, none
{       keyend
{       list of key
{         (read, r)
{         (execute, e)
{         (write, w)
{         (shorten, s)
{         (append, a)
{         (modify, m)
{       keyend
{     anyend = (read, execute)
{   share_mode, sm: any of
{       key
{         (access_based, ab)
{         (permitted, p, required)
{         all, none
{       keyend
{       list of key
{         (read, r)
{         (execute, e)
{         (write, w)
{         (shorten, s)
{         (append, a)
{         (modify, m)
{       keyend
{     anyend = access_based
{   create_file, cf: key
{       (always, a)
{       (sometimes, s)
{       (never, n)
{     keyend = sometimes
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 4] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 12] of clt$keyword_specification,
          recend,
        recend,
        default_value: string (15),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 7] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 12] of clt$keyword_specification,
          recend,
        recend,
        default_value: string (12),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
        default_value: string (9),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 3, 30, 11, 31, 15, 636],
    clc$command, 9, 5, 1, 0, 0, 0, 5, ''], [
    ['ACCESS_MODE                    ',clc$nominal_entry, 2],
    ['AM                             ',clc$abbreviation_entry, 2],
    ['CF                             ',clc$abbreviation_entry, 4],
    ['CREATE_FILE                    ',clc$nominal_entry, 4],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['SHARE_MODE                     ',clc$nominal_entry, 3],
    ['SM                             ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 642,
  clc$optional_default_parameter, 0, 15],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 753,
  clc$optional_default_parameter, 0, 12],
{ PARAMETER 4
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$optional_default_parameter, 0, 9],
{ PARAMETER 5
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    155, [[1, 0, clc$keyword_type], [4], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['P                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['PERMITTED                      ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    467, [[1, 0, clc$list_type], [451, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$keyword_type], [12], [
        ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
        ['APPEND                         ', clc$nominal_entry, clc$normal_usage_entry, 5],
        ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
        ['EXECUTE                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
        ['MODIFY                         ', clc$nominal_entry, clc$normal_usage_entry, 6],
        ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
        ['READ                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
        ['SHORTEN                        ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['W                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
        ['WRITE                          ', clc$nominal_entry, clc$normal_usage_entry, 3]]
        ]
      ]
    ,
    '(read, execute)'],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    266, [[1, 0, clc$keyword_type], [7], [
      ['AB                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ACCESS_BASED                   ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['P                              ', clc$alias_entry, clc$normal_usage_entry, 2],
      ['PERMITTED                      ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['REQUIRED                       ', clc$abbreviation_entry, clc$normal_usage_entry, 2]]
      ],
    467, [[1, 0, clc$list_type], [451, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$keyword_type], [12], [
        ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
        ['APPEND                         ', clc$nominal_entry, clc$normal_usage_entry, 5],
        ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
        ['EXECUTE                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
        ['M                              ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
        ['MODIFY                         ', clc$nominal_entry, clc$normal_usage_entry, 6],
        ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
        ['READ                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
        ['SHORTEN                        ', clc$nominal_entry, clc$normal_usage_entry, 4],
        ['W                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
        ['WRITE                          ', clc$nominal_entry, clc$normal_usage_entry, 3]]
        ]
      ]
    ,
    'access_based'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [6], [
    ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ALWAYS                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['NEVER                          ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['SOMETIMES                      ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'sometimes'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$file = 1,
      p$access_mode = 2,
      p$share_mode = 3,
      p$create_file = 4,
      p$status = 5;

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

    VAR
      file_index: t$file_index,
      open_options: t$open_options;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_access_mode (pvt [p$access_mode].value^, open_options.access_mode);
    get_share_mode (pvt [p$share_mode].value^, open_options.share_mode);
    get_create_option (pvt [p$create_file].value^, open_options.create_option);
    open_options.allow_previous_open := FALSE;

    open_file (pvt [p$file].value^.file_value^, open_options, file_index, status);
  PROCEND dup$open_file_command;
?? TITLE := '  assign_file_list_entry', EJECT ??

  PROCEDURE assign_file_list_entry (VAR file_index: t$file_index);

    IF (v$file_list.file_count >= UPPERBOUND (v$file_list.files)) THEN
      file_index := c$nil_file_index;
    ELSE
      v$file_list.file_count := v$file_list.file_count + 1;
      file_index := v$file_list.file_count;
    IFEND;
  PROCEND assign_file_list_entry;
?? TITLE := '  get_access_mode', EJECT ??

  PROCEDURE get_access_mode (access_value: clt$data_value;
    VAR access_mode: fst$access_modes);

    VAR
      p_element: ^clt$data_value,
      p_list: ^clt$data_value;

    access_mode.selector := fsc$specific_access_modes;
    access_mode.value := $fst$file_access_options [];

    IF (access_value.kind = clc$keyword) THEN
      IF (access_value.keyword_value = c$permitted) THEN
        access_mode.selector := fsc$permitted_access_modes;
      ELSEIF (access_value.keyword_value = c$all) THEN
        access_mode.value := - $fst$file_access_options [];
      IFEND;
    ELSEIF (access_value.kind = clc$list) THEN
      p_list := ^access_value;
      WHILE (p_list <> NIL) DO
        p_element := p_list^.element_value;

        IF (p_element^.keyword_value = c$read) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$read];
        ELSEIF (p_element^.keyword_value = c$execute) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$execute];
        ELSEIF (p_element^.keyword_value = c$write) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$shorten, fsc$append,
                fsc$modify];
        ELSEIF (p_element^.keyword_value = c$shorten) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$shorten];
        ELSEIF (p_element^.keyword_value = c$append) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$append];
        ELSEIF (p_element^.keyword_value = c$modify) THEN
          access_mode.value := access_mode.value + $fst$file_access_options [fsc$modify];
        IFEND;

        p_list := p_list^.link;
      WHILEND;
    IFEND;
  PROCEND get_access_mode;
?? TITLE := '  get_create_option', EJECT ??

  PROCEDURE get_create_option (create_value: clt$data_value;
    VAR create_option: t$create_option);

    IF (create_value.keyword_value = c$always) THEN
      create_option := c$always_create;
    ELSEIF (create_value.keyword_value = c$never) THEN
      create_option := c$never_create;
    ELSE
      create_option := c$sometimes_create;
    IFEND;
  PROCEND get_create_option;
?? TITLE := '  get_file_info', EJECT ??

  PROCEDURE get_file_info (file_reference: fst$file_reference;
    VAR file_exists: boolean;
    VAR gfn: ost$binary_unique_name;
    VAR file_index: t$file_index);

    VAR
      attribute: array [1 .. 1] of amt$get_item,
      local: boolean,
      data: boolean,
      status: ost$status;

    attribute [1].key := amc$global_file_name;
    amp$get_file_attributes (file_reference, attribute, local, file_exists, data, status);

    file_exists := status.normal AND file_exists;
    IF file_exists THEN
      gfn := attribute [1].global_file_name;
      file_index := v$file_list.file_count;
      WHILE (file_index <> c$nil_file_index) AND (gfn <> v$file_list.files [file_index].gfn) DO
        file_index := file_index - 1;
      WHILEND;
    ELSE
      file_index := c$nil_file_index;
    IFEND;
  PROCEND get_file_info;
?? TITLE := '  get_share_mode', EJECT ??

  PROCEDURE get_share_mode (share_value: clt$data_value;
    VAR share_mode: fst$share_modes);

    VAR
      p_element: ^clt$data_value,
      p_list: ^clt$data_value;

    share_mode.selector := fsc$specific_share_modes;
    share_mode.value := $fst$file_access_options [];

    IF (share_value.kind = clc$keyword) THEN
      IF (share_value.keyword_value = c$permitted) THEN
        share_mode.selector := fsc$required_share_modes;
      ELSEIF (share_value.keyword_value = c$access_based) THEN
        share_mode.selector := fsc$determine_from_access_modes;
      ELSEIF (share_value.keyword_value = c$all) THEN
        share_mode.value := - $fst$file_access_options [];
      IFEND;
    ELSEIF (share_value.kind = clc$list) THEN
      p_list := ^share_value;
      WHILE (p_list <> NIL) DO
        p_element := p_list^.element_value;

        IF (p_element^.keyword_value = c$read) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$read];
        ELSEIF (p_element^.keyword_value = c$execute) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$execute];
        ELSEIF (p_element^.keyword_value = c$write) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$shorten, fsc$append,
                fsc$modify];
        ELSEIF (p_element^.keyword_value = c$shorten) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$shorten];
        ELSEIF (p_element^.keyword_value = c$append) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$append];
        ELSEIF (p_element^.keyword_value = c$modify) THEN
          share_mode.value := share_mode.value + $fst$file_access_options [fsc$modify];
        IFEND;

        p_list := p_list^.link;
      WHILEND;
    IFEND;
  PROCEND get_share_mode;
?? TITLE := '  open_file', EJECT ??

  PROCEDURE open_file (file_reference: fst$file_reference;
        open_options: t$open_options;
    VAR file_index: t$file_index;
    VAR status: ost$status);

    VAR
      attachment: array [1 .. 3] of fst$attachment_option,
      attribute: array [1 .. 1] of amt$fetch_item,
      fid: amt$file_identifier,
      file_existed: boolean,
      file_opened: boolean,
      gfn: ost$binary_unique_name,
      local_status: ost$status,
      segment: amt$segment_pointer;

    status.normal := TRUE;

    get_file_info (file_reference, file_existed, gfn, file_index);

    IF (file_index <> c$nil_file_index) THEN {file already open}
      IF NOT open_options.allow_previous_open THEN
        osp$set_status_abnormal (duc$dump_analyzer_id, due$file_already_open, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, file_reference, status);
      IFEND;
      RETURN;
    ELSEIF (open_options.create_option = c$always_create) AND file_existed THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$file_already_exists, '', status);
      osp$append_status_file (osc$status_parameter_delimiter, file_reference, status);
      RETURN;
    IFEND;

    assign_file_list_entry (file_index);
    IF (file_index = c$nil_file_index) THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$open_file_limit, '', status);
      osp$append_status_file (osc$status_parameter_delimiter, file_reference, status);
      osp$append_status_integer (osc$status_parameter_delimiter, UPPERBOUND (v$file_list.files), 10, FALSE,
            status);
      RETURN;
    IFEND;

    attachment [1].selector := fsc$access_and_share_modes;
    attachment [1].access_modes := open_options.access_mode;
    attachment [1].share_modes := open_options.share_mode;

    IF (open_options.create_option = c$sometimes_create) THEN
      attachment [2].selector := fsc$null_attachment_option;
    ELSE
      attachment [2].selector := fsc$create_file;
      attachment [2].create_file := (open_options.create_option = c$always_create);
    IFEND;

    attachment [3].selector := fsc$wait_for_attachment;
    attachment [3].wait_for_attachment.wait := osc$nowait;

    fsp$open_file (file_reference, amc$segment, ^attachment, NIL, NIL, NIL, NIL, fid, status);
    file_opened := status.normal;

    IF NOT file_existed AND file_opened THEN
      attribute [1].key := amc$global_file_name;
      amp$fetch (fid, attribute, status);
      IF status.normal THEN
        gfn := attribute [1].global_file_name;
      IFEND;
    IFEND;

    IF status.normal THEN
      amp$get_segment_pointer (fid, amc$cell_pointer, segment, status);
    IFEND;

    IF status.normal THEN
      v$file_list.files [file_index].gfn := gfn;
      v$file_list.files [file_index].fid := fid;
      v$file_list.files [file_index].pva := segment.cell_pointer;
    ELSE
      release_file_list_entry (file_index);
      IF file_opened THEN
        fsp$close_file (fid, local_status);
      IFEND;
    IFEND;
  PROCEND open_file;
?? TITLE := '  release_file_list_entry', EJECT ??

  PROCEDURE release_file_list_entry (file_index: t$file_index);

    IF (file_index <> v$file_list.file_count) THEN
      v$file_list.files [file_index] := v$file_list.files [v$file_list.file_count];
    IFEND;

    v$file_list.file_count := v$file_list.file_count - 1;
  PROCEND release_file_list_entry;
?? OLDTITLE ??
MODEND dum$segment_file_manager;
