?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Get block and record type' ??
MODULE dsm$get_block_and_record_type;

{ PURPOSE:
{   This module contains a procedure which retrieves the block type and record type of a file.
{ NOTES:
{   This procedure should be deleted when the $file function is smart enough to perform this function.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
*copyc amp$get_file_attributes
*copyc clp$change_variable
*copyc clp$evaluate_parameters
?? TITLE := 'dsp$get_block_and_record_type', EJECT ??

{ PURPOSE:
{   This procedure uses amp$get_file_attributes to retrieve the block type and the record
{   type of the given file.

  PROCEDURE [XDCL] dsp$get_block_and_record_type
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE get_block_and_record_type, getbart (
{ input, i: file = $required
{ block_type, bt: (VAR) name = $required
{ record_type, rt: (VAR) name  = $required
{ status)

?? PUSH (LISTEXT := ON) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 3, 16, 10, 29, 40, 812],
    clc$command, 7, 4, 3, 0, 0, 2, 4, 'GETBART'], [
    ['BLOCK_TYPE                     ',clc$nominal_entry, 2],
    ['BT                             ',clc$abbreviation_entry, 2],
    ['I                              ',clc$abbreviation_entry, 1],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['RECORD_TYPE                    ',clc$nominal_entry, 3],
    ['RT                             ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [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, 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_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 5,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 5,
  clc$required_parameter, 0, 0],
{ PARAMETER 4
    [7, 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$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];
?? POP ??

  CONST
    p$input = 1,
    p$block_type = 2,
    p$record_type = 3,
    p$status = 4;

  VAR
    pvt: array [1 .. 4] of clt$parameter_value;
    VAR
      contains_data: boolean,
      gfa: ARRAY [1 .. 2] OF amt$get_item,
      local_file: boolean,
      old_file: boolean,
      value: clt$data_value;

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

    gfa [1].key := amc$block_type;
    gfa [2].key := amc$record_type;

    amp$get_file_attributes (pvt [p$input].value^.file_value^, gfa, local_file, old_file,
          contains_data, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    value.kind := clc$name;
    CASE gfa [1].block_type OF
    = amc$system_specified =
      value.name_value := 'SYSTEM_SPECIFIED';
    = amc$user_specified =
      value.name_value := 'USER_SPECIFIED';
    ELSE
      value.name_value := 'SYSTEM_SPECIFIED';
    CASEND;

    clp$change_variable (pvt [p$block_type].variable^, ^value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    value.kind := clc$name;
    CASE gfa [2].record_type OF
    = amc$variable =
      value.name_value := 'VARIABLE';
    = amc$undefined =
      value.name_value := 'UNDEFINED';
    = amc$ansi_fixed =
      value.name_value := 'FIXED';
    = amc$ansi_spanned =
      value.name_value := 'ANSI_SPANNED';
    = amc$ansi_variable =
      value.name_value := 'ANSI_VARIABLE';
    ELSE
      value.name_value := 'UNDEFINED';
    CASEND;

    clp$change_variable (pvt [p$record_type].variable^, ^value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND dsp$get_block_and_record_type;
MODEND dsm$get_block_and_record_type;
