?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : List Functions' ??
MODULE clm$list_functions;

{
{ PURPOSE:
{   This module contains functions related to lists.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_list_size
*copyc cle$ecc_parsing
*copyc cle$work_area_overflow
*copyc clt$data_value
*copyc clt$parameter_list
*copyc clt$work_area
*copyc ost$status
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$begin_utility
*copyc clp$build_pattern_for_wild_card
*copyc clp$change_variable
*copyc clp$convert_array_to_list
*copyc clp$convert_list_to_array
*copyc clp$convert_type_spec_to_desc
*copyc clp$count_list_elements
*copyc clp$create_procedure_variable
*copyc clp$data_value_compare
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$internal_evaluate_expr
*copyc clp$get_expected_type
*copyc clp$make_array_value
*copyc clp$make_boolean_value
*copyc clp$make_integer_value
*copyc clp$make_list_value
*copyc clp$make_record_value
*copyc clp$match_string_pattern
*copyc clp$scan_non_space_lexical_unit
*copyc clp$trimmed_string_size
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc osv$lower_to_upper_26

?? TITLE := 'clp$$add', EJECT ??

  PROCEDURE [XDCL] clp$$add
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$add) $add (
{   element: any = $required
{   list: list 0..clc$max_list_size = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] 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,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 9, 59, 31, 50],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$ADD'], [
    ['ELEMENT                        ',clc$nominal_entry, 1],
    ['LIST                           ',clc$nominal_entry, 2]],
    [
{ 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, 12, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$element = 1,
      p$list = 2;

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


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

    clp$make_list_value (work_area, result);
    IF result = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;

    result^.element_value := pvt [p$element].value;
    IF (pvt [p$list].value^.element_value <> NIL) OR (pvt [p$list].value^.link <> NIL) THEN
      result^.link := pvt [p$list].value;
    IFEND;

  PROCEND clp$$add;
?? TITLE := 'clp$$apply', EJECT ??

  PROCEDURE [XDCL] clp$$apply
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$apply) $apply (
{   list: list 0..clc$max_list_size = $required
{   expression: (DEFER) any = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
    recend := [
    [1,
    [90, 4, 3, 9, 59, 58, 916],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$APPLY'], [
    ['EXPRESSION                     ',clc$nominal_entry, 2],
    ['LIST                           ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter, 0
  , 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]]];

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

    CONST
      p$list = 1,
      p$expression = 2;

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

    VAR
      element_type_description: clt$type_description,
      element_type_specification: ^clt$type_specification,
      expression_parse: clt$parse_state,
      ignore_element_type_kind: clt$type_kind,
      node: ^clt$data_value,
      result_node: ^^clt$data_value,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    IF (pvt [p$list].value^.element_value = NIL) AND (pvt [p$list].value^.link = NIL) THEN
      result := pvt [p$list].value;
      RETURN;
    IFEND;

    get_expected_element_type (pvt [p$expression].value^.deferred_type, work_area, ignore_element_type_kind,
          element_type_specification, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    prepare_deferred_expression (pvt [p$expression].value^.deferred_value, element_type_specification,
          work_area, element_type_description, expression_parse, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'APPLY';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$create_procedure_variable ('X', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          pvt [p$expression].value^.deferred_type, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    node := pvt [p$list].value;
    result_node := ^result;
    WHILE node <> NIL DO
      clp$change_variable ('X', node^.element_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_list_value (work_area, result_node^);
      evaluate_deferred_expression (expression_parse, ^element_type_description, work_area,
            result_node^^.element_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      result_node := ^result_node^^.link;
      node := node^.link;
    WHILEND;

    clp$end_utility (utility_name, status);

  PROCEND clp$$apply;
?? TITLE := 'clp$$build_list', EJECT ??

  PROCEDURE [XDCL] clp$$build_list
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$build_list) $build_list (
{   number_of_new_elements: integer 0..clc$max_list_size = $required
{   next_element: (DEFER) any = $required
{   initial_list: list 0..clc$max_list_size = ()
{   )

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        default_value: string (2),
      recend,
    recend := [
    [1,
    [90, 4, 6, 12, 48, 58, 727],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OSM$$BUILD_LIST'], [
    ['INITIAL_LIST                   ',clc$nominal_entry, 3],
    ['NEXT_ELEMENT                   ',clc$nominal_entry, 2],
    ['NUMBER_OF_NEW_ELEMENTS         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, 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, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [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, 16,
  clc$optional_default_parameter, 0, 2]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, clc$max_list_size, 10]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 3
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE],
    '()']];

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

    CONST
      p$number_of_new_elements = 1,
      p$next_element = 2,
      p$initial_list = 3;

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

{ TYPE
{   element_record_type_spec = record
{     result: list of any
{     index: integer 1..clc$max_list_size
{   recend
{ TYPEND

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

  VAR
    element_record_type_spec: [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      qualifier: clt$record_type_qualifier,
      field_spec_1: clt$field_specification,
      element_type_spec_1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
        recend,
      recend,
      field_spec_2: clt$field_specification,
      element_type_spec_2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
    recend := [
      [1, 0, clc$record_type], [2],
      ['RESULT                         ', clc$required_field, 28], [[1, 0, clc$list_type], [12, 0,
  clc$max_list_size, 0, FALSE, FALSE],
          [[1, 0, clc$union_type], [-$clt$type_kinds [],
          FALSE, 0]]
        ],
      ['INDEX                          ', clc$required_field, 20], [[1, 0, clc$integer_type], [1,
  clc$max_list_size, 10]]
      ];

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

    VAR
      element_record_value: ^clt$data_value,
      element_type_description: clt$type_description,
      expression_parse: clt$parse_state,
      index_value: clt$data_value,
      next_element_value: ^clt$data_value,
      result_node: ^^clt$data_value,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    result := pvt [p$initial_list].value;
    IF pvt [p$number_of_new_elements].value^.integer_value.value <= 0 THEN
      RETURN;
    IFEND;

    prepare_deferred_expression (pvt [p$next_element].value^.deferred_value,
          pvt [p$next_element].value^.deferred_type, work_area, element_type_description, expression_parse,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'BUILD_LIST';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_record_value (2, work_area, element_record_value);
    element_record_value^.field_values^ [1].name := 'RESULT';
    element_record_value^.field_values^ [1].value := result;
    element_record_value^.field_values^ [2].name := 'INDEX';
    clp$create_procedure_variable ('X', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          #SEQ (element_record_type_spec), NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    index_value.kind := clc$integer;
    index_value.integer_value.value := 1;
    index_value.integer_value.radix := 10;
    index_value.integer_value.radix_specified := FALSE;
    element_record_value^.field_values^ [2].value := ^index_value;

    result_node := ^result;
    IF result^.element_value <> NIL THEN
      WHILE result_node^ <> NIL DO
        index_value.integer_value.value := index_value.integer_value.value + 1;
        result_node := ^result_node^^.link;
      WHILEND;
    IFEND;

    FOR index_value.integer_value.value := index_value.integer_value.value TO
          pvt [p$number_of_new_elements].value^.integer_value.value DO
      clp$change_variable ('X', element_record_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      evaluate_deferred_expression (expression_parse, ^element_type_description, work_area,
            next_element_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF result_node^ = NIL THEN
        clp$make_list_value (work_area, result_node^);
      IFEND;
      result_node^^.element_value := next_element_value;
      result_node := ^result_node^^.link;
    FOREND;

    clp$end_utility (utility_name, status);

  PROCEND clp$$build_list;
?? TITLE := 'clp$$build_result', EJECT ??

  PROCEDURE [XDCL] clp$$build_result
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$build_result) $build_result (
{   list: list = $required
{   expression: (DEFER) any = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
    recend := [
    [1,
    [90, 4, 5, 16, 7, 35, 656],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$LIST_RESULT'], [
    ['EXPRESSION                     ',clc$nominal_entry, 2],
    ['LIST                           ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter, 0
  , 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 1, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]]];

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

    CONST
      p$list = 1,
      p$expression = 2;

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

{ TYPE
{   element_record_type_spec = record
{     result: any
{     current: any
{     index: integer 1..clc$max_list_size
{   recend
{ TYPEND

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

  VAR
    element_record_type_spec: [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      qualifier: clt$record_type_qualifier,
      field_spec_1: clt$field_specification,
      element_type_spec_1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      field_spec_2: clt$field_specification,
      element_type_spec_2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      field_spec_3: clt$field_specification,
      element_type_spec_3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
    recend := [
      [1, 0, clc$record_type], [3],
      ['RESULT                         ', clc$required_field, 12], [[1, 0, clc$union_type], [
  -$clt$type_kinds [],
        FALSE, 0]],
      ['CURRENT                        ', clc$required_field, 12], [[1, 0, clc$union_type], [
  -$clt$type_kinds [],
        FALSE, 0]],
      ['INDEX                          ', clc$required_field, 20], [[1, 0, clc$integer_type], [1,
  clc$max_list_size, 10]]
      ];

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

    VAR
      element_record_value: ^clt$data_value,
      element_type_description: clt$type_description,
      expression_parse: clt$parse_state,
      index_value: clt$data_value,
      node: ^clt$data_value,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    result := pvt [p$list].value^.element_value;
    node := pvt [p$list].value^.link;

    IF node = NIL THEN
      RETURN;
    IFEND;

    prepare_deferred_expression (pvt [p$expression].value^.deferred_value,
          pvt [p$expression].value^.deferred_type, work_area, element_type_description, expression_parse,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'BUILD_RESULT';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_record_value (3, work_area, element_record_value);
    element_record_value^.field_values^ [1].name := 'RESULT';
    element_record_value^.field_values^ [2].name := 'CURRENT';
    element_record_value^.field_values^ [3].name := 'INDEX';
    clp$create_procedure_variable ('X', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          #SEQ (element_record_type_spec), NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    index_value.kind := clc$integer;
    index_value.integer_value.value := 1;
    index_value.integer_value.radix := 10;
    index_value.integer_value.radix_specified := FALSE;
    element_record_value^.field_values^ [3].value := ^index_value;

    REPEAT
      element_record_value^.field_values^ [1].value := result;
      element_record_value^.field_values^ [2].value := node^.element_value;
      index_value.integer_value.value := index_value.integer_value.value + 1;
      clp$change_variable ('X', element_record_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      evaluate_deferred_expression (expression_parse, ^element_type_description, work_area, result, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      node := node^.link;
    UNTIL node = NIL;

    clp$end_utility (utility_name, status);

  PROCEND clp$$build_result;
?? TITLE := 'clp$$combine', EJECT ??

  PROCEDURE [XDCL] clp$$combine
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$combine) $combine (
{   expression: (DEFER) any = $required
{   lists: list rest of list 0..clc$max_list_size = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] 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,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 0, 17, 375],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$COMBINE'], [
    ['EXPRESSION                     ',clc$nominal_entry, 1],
    ['LISTS                          ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, 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, 32, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [16, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]
    ]];

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

    CONST
      p$expression = 1,
      p$lists = 2;

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

?? POP ??

    CONST
      typical_number_to_combine = 2;

{ TYPE
{   x_type = array 0..typical_number_to_combine of any
{ TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        name: string (6),
        qualifier: clt$array_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
        recend,
      recend := [[1, 6, clc$array_type], 'X_TYPE', [12, TRUE, [0, typical_number_to_combine]],
            [[1, 0, clc$union_type], [-$clt$type_kinds [], FALSE, 0]]];

?? POP ??

    VAR
      array_type_qualifier: ^clt$array_type_qualifier,
      array_type_specification: ^clt$type_specification,
      array_value: ^clt$data_value,
      element_type_description: clt$type_description,
      element_type_specification: ^clt$type_specification,
      expression_parse: clt$parse_state,
      header: ^clt$type_specification_header,
      ignore_element_type_kind: clt$type_kind,
      ignore_type_name: ^clt$type_name_reference,
      list_node: ^clt$data_value,
      list_number: clt$list_size,
      lists_node: ^clt$data_value,
      number_to_combine: clt$list_size,
      result_node: ^^clt$data_value,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    get_expected_element_type (pvt [p$expression].value^.deferred_type, work_area, ignore_element_type_kind,
          element_type_specification, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    prepare_deferred_expression (pvt [p$expression].value^.deferred_value, element_type_specification,
          work_area, element_type_description, expression_parse, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'COMBINE';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    number_to_combine := clp$count_list_elements (pvt [p$lists].value);
    IF number_to_combine = typical_number_to_combine THEN
      array_type_specification := #SEQ (type_specification);
    ELSE
      PUSH array_type_specification: [[REP #SIZE (type_specification) OF cell]];
      array_type_specification^ := #SEQ (type_specification) ^;
      RESET array_type_specification;
      NEXT header IN array_type_specification;
      NEXT ignore_type_name: [header^.name_size] IN array_type_specification;
      NEXT array_type_qualifier IN array_type_specification;
      array_type_qualifier^.bounds.upper := number_to_combine;
    IFEND;
    clp$create_procedure_variable ('X', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          array_type_specification, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$make_array_value (0, number_to_combine, work_area, array_value);
    clp$make_integer_value (0, 10, FALSE, work_area, array_value^.array_value^ [0]);
    result := NIL;
    result_node := ^result;

  /build_result_list/
    WHILE TRUE DO
      array_value^.array_value^ [0]^.integer_value.value := array_value^.array_value^ [0]^.integer_value.
            value + 1;

      lists_node := pvt [p$lists].value;
      FOR list_number := 1 TO number_to_combine DO
        list_node := lists_node^.element_value;
        IF (list_node = NIL) OR (list_node^.element_value = NIL) THEN
          EXIT /build_result_list/;
        IFEND;
        array_value^.array_value^ [list_number] := list_node^.element_value;
        lists_node^.element_value := list_node^.link;
        lists_node := lists_node^.link;
      FOREND;

      clp$change_variable ('X', array_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_list_value (work_area, result_node^);
      evaluate_deferred_expression (expression_parse, ^element_type_description, work_area,
            result_node^^.element_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      result_node := ^result_node^^.link;
    WHILEND /build_result_list/;

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
    IFEND;

    clp$end_utility (utility_name, status);

  PROCEND clp$$combine;
?? TITLE := 'clp$$difference', EJECT ??

  PROCEDURE [XDCL] clp$$difference
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$difference) $difference (
{   first: list 0..clc$max_list_size = $required
{   second: list 0..clc$max_list_size = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 0, 26, 630],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$DIFFERENCE'], [
    ['FIRST                          ',clc$nominal_entry, 1],
    ['SECOND                         ',clc$nominal_entry, 2]],
    [
{ 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$first = 1,
      p$second = 2;

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

    VAR
      comparison_node: ^clt$data_value,
      differing_node: ^^clt$data_value,
      first_list: ^clt$data_value,
      second_list: ^clt$data_value;


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

    result := NIL;
    differing_node := ^result;
    first_list := pvt [p$first].value;
    second_list := pvt [p$second].value;

    remove_redundant_elements (first_list);

    comparison_node := second_list;

    WHILE first_list <> NIL DO
      IF clp$data_value_compare (first_list^.element_value, comparison_node^.element_value) = clc$equal THEN
        first_list := first_list^.link;
        comparison_node := second_list;
      ELSEIF comparison_node^.link = NIL THEN
        differing_node^ := first_list;
        differing_node := ^first_list^.link;
        first_list := first_list^.link;
        comparison_node := second_list;
      ELSE
        comparison_node := comparison_node^.link;
      IFEND;
    WHILEND;

    IF result <> NIL THEN
      result^.generated_via_list_rest := FALSE;
      differing_node^ := NIL;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$difference;
?? TITLE := 'clp$$first', EJECT ??

  PROCEDURE [XDCL] clp$$first
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$first) $first (
{   list: list = $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,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 0, 36, 829],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$FIRST'], [
    ['LIST                           ',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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 1, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$list = 1;

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


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

    result := pvt [p$list].value^.element_value;

  PROCEND clp$$first;
?? TITLE := 'clp$$intersection', EJECT ??

  PROCEDURE [XDCL] clp$$intersection
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$intersection) $intersection (
{   lists: list rest of list 0..clc$max_list_size = $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,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 0, 44, 448],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$INTERSECTION'], [
    ['LISTS                          ',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, 32, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [16, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]
    ]];

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

    CONST
      p$lists = 1;

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

    VAR
      comparison_node: ^clt$data_value,
      intersecting_node: ^^clt$data_value,
      node: ^clt$data_value,
      top_node: ^clt$data_value;


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

    result := NIL;
    intersecting_node := ^result;
    top_node := pvt [p$lists].value;
    node := top_node^.element_value;

    find_non_empty_list (top_node);

  /find_intersection/
    WHILE (top_node <> NIL) AND (top_node^.link <> NIL) DO
      IF result <> NIL THEN
        node := result;
        result := NIL;
        intersecting_node := ^result;
      IFEND;
      top_node := top_node^.link;
      find_non_empty_list (top_node);
      IF top_node <> NIL THEN
        comparison_node := top_node^.element_value;

        WHILE node <> NIL DO
          IF (node^.element_value <> NIL) AND (node^.element_value^.kind = clc$list) AND
                (node^.element_value^.element_value = NIL) THEN
            node := node^.link;
          ELSEIF clp$data_value_compare (node^.element_value, comparison_node^.element_value) = clc$equal THEN
            intersecting_node^ := node;
            intersecting_node := ^node^.link;
            node := node^.link;
            comparison_node := top_node^.element_value;
          ELSEIF comparison_node^.link = NIL THEN
            node := node^.link;
            IF node <> NIL THEN
              comparison_node := top_node^.element_value;
            IFEND;
          ELSE
            comparison_node := comparison_node^.link;
          IFEND;
        WHILEND;

      IFEND;
      IF result = NIL THEN
        EXIT /find_intersection/;
      IFEND;
      intersecting_node^ := NIL;
    WHILEND /find_intersection/;

    IF result <> NIL THEN
      remove_redundant_elements (result);
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$intersection;
?? TITLE := 'clp$$join', EJECT ??

  PROCEDURE [XDCL] clp$$join
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$join) $join (
{   lists: list rest of list 0..clc$max_list_size = $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,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 0, 52, 979],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$JOIN'], [
    ['LISTS                          ',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, 32, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [16, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]
    ]];

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

    CONST
      p$lists = 1;

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


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

    join_lists (pvt [p$lists].value, result);

    IF result <> NIL THEN
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$join;
?? TITLE := 'clp$$last', EJECT ??

  PROCEDURE [XDCL] clp$$last
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$last) $last (
{   list: list = $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,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 1, 2, 340],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$LAST'], [
    ['LIST                           ',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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 1, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$list = 1;

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


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

    result := pvt [p$list].value;
    WHILE result^.link <> NIL DO
      result := result^.link;
    WHILEND;

    result := result^.element_value;

  PROCEND clp$$last;
?? TITLE := 'clp$$list_of', EJECT ??

  PROCEDURE [XDCL] clp$$list_of
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$list_of) $list_of (
{   elements: list rest of any = $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,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 1, 9, 823],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$LIST_OF'], [
    ['ELEMENTS                       ',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, 28, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [12, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$union_type], [-$clt$type_kinds [],
      FALSE, 0]]
    ]];

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

    CONST
      p$elements = 1;

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


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

    result := pvt [p$elements].value;
    result^.generated_via_list_rest := FALSE;

  PROCEND clp$$list_of;
?? TITLE := 'clp$$nil', EJECT ??

  PROCEDURE [XDCL] clp$$nil
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$nil) $nil (
{   list: list 0..clc$max_list_size = $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,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 1, 23, 645],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$NIL'], [
    ['LIST                           ',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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$list = 1;

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


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

    clp$make_boolean_value ((pvt [p$list].value^.element_value = NIL), clc$true_false_boolean, work_area,
          result);
    IF result = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$$nil;
?? TITLE := 'clp$$rest', EJECT ??

  PROCEDURE [XDCL] clp$$rest
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$rest) $rest (
{   list: list = $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,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 1, 37, 3],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$REST'], [
    ['LIST                           ',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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 1, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$list = 1;

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


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

    result := pvt [p$list].value^.link;

    IF result <> NIL THEN
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$rest;
?? TITLE := 'clp$$reverse', EJECT ??

  PROCEDURE [XDCL] clp$$reverse
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$reverse) $reverse (
{   list: list 0..clc$max_list_size = $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,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 2, 5, 311],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$REVERSE'], [
    ['LIST                           ',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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$list = 1;

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

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

    IF (pvt [p$list].value^.element_value = NIL) AND (pvt [p$list].value^.link = NIL) THEN
      result := pvt [p$list].value;
      RETURN;
    IFEND;

    clp$make_list_value (work_area, result);
    IF result = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;

    result := pvt [p$list].value;
    clp$reverse_list (result);

    result^.generated_via_list_rest := FALSE;

  PROCEND clp$$reverse;
?? TITLE := 'clp$$select', EJECT ??

  PROCEDURE [XDCL] clp$$select
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$select) $select (
{   list: list 0..clc$max_list_size = $required
{   condition: (DEFER) boolean = $required
{   return_option: key
{       (elements, element, e)
{       (indices, index, indexes, i)
{     keyend = elements
{   )

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 7] of clt$keyword_specification,
        default_value: string (8),
      recend,
    recend := [
    [1,
    [90, 9, 20, 14, 51, 6, 660],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OSM$$SELECT'], [
    ['CONDITION                      ',clc$nominal_entry, 2],
    ['LIST                           ',clc$nominal_entry, 1],
    ['RETURN_OPTION                  ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [3, 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, 266,
  clc$optional_default_parameter, 0, 8]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$boolean_type]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [7], [
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ELEMENT                        ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['ELEMENTS                       ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['I                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['INDEX                          ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['INDEXES                        ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['INDICES                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'elements']];

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

    CONST
      p$list = 1,
      p$condition = 2,
      p$return_option = 3;

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

{ TYPE
{   x_type = any
{ TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend := [[1, 0, clc$union_type], [-$clt$type_kinds [], FALSE, 0]];

?? POP ??

    VAR
      expression_parse: clt$parse_state,
      expression_result: ^clt$data_value,
      expression_type_description: clt$type_description,
      index: clt$list_size,
      node: ^clt$data_value,
      result_node: ^^clt$data_value,
      return_selected_indices: boolean,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    IF (pvt [p$list].value^.element_value = NIL) AND (pvt [p$list].value^.link = NIL) THEN
      result := pvt [p$list].value;
      RETURN;
    IFEND;

    return_selected_indices := pvt [p$return_option].value^.keyword_value = 'INDICES';

    prepare_deferred_expression (pvt [p$condition].value^.deferred_value,
          pvt [p$condition].value^.deferred_type, work_area, expression_type_description, expression_parse,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'SELECT';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$create_procedure_variable ('X', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          #SEQ (type_specification), NIL, status);

    index := 0;
    node := pvt [p$list].value;
    result_node := ^result;
    WHILE node <> NIL DO
      clp$change_variable ('X', node^.element_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      evaluate_deferred_expression (expression_parse, ^expression_type_description, work_area,
            expression_result, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      index := index + 1;
      IF expression_result^.boolean_value.value THEN
        IF return_selected_indices THEN
          clp$make_integer_value (index, 10, FALSE, work_area, node^.element_value);
        IFEND;
        result_node^ := node;
        result_node := ^node^.link;
      IFEND;
      node := node^.link;
    WHILEND;

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF result <> NIL THEN
      result_node^ := NIL;
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$select;
?? TITLE := 'clp$$select_strings', EJECT ??

  PROCEDURE [XDCL] clp$$select_strings
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$sels) $select_strings, $select_string (
{   candidates: list 0..clc$max_list_size of string = $required
{   pattern: string_pattern = $required
{   anchor_option: key
{       (anchored, a)
{       (unanchored, u)
{     keyend = unanchored
{   scan_option: (ADVANCED) key
{       (quick_scan, qs)
{       (full_scan, fs)
{     keyend = quick_scan
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 4] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (10),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (10),
      recend,
    recend := [
    [1,
    [90, 4, 12, 12, 35, 16, 735],
    clc$function, 4, 4, 2, 1, 0, 0, 0, 'OSM$$SELS'], [
    ['ANCHOR_OPTION                  ',clc$nominal_entry, 3],
    ['CANDIDATES                     ',clc$nominal_entry, 1],
    ['PATTERN                        ',clc$nominal_entry, 2],
    ['SCAN_OPTION                    ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [2, 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, 24, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [3, 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 3
    [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, 155,
  clc$optional_default_parameter, 0, 10],
{ PARAMETER 4
    [4, clc$advanced_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 10]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [8, 0, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]
    ],
{ PARAMETER 2
    [[1, 0, clc$string_pattern_type]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ANCHORED                       ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['U                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['UNANCHORED                     ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'unanchored'],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [4], [
    ['FS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL_SCAN                      ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['QS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['QUICK_SCAN                     ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'quick_scan']];

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

    CONST
      p$candidates = 1,
      p$pattern = 2,
      p$anchor_option = 3,
      p$scan_option = 4;

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

    VAR
      anchor_option: clt$string_pattern_anchor_opt,
      candidate: ^clt$string_value,
      index: clt$list_size,
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      result_node: ^^clt$data_value,
      return_selected_indices: boolean,
      scan_option: clt$string_pattern_scan_option;


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

    IF (pvt [p$candidates].value^.element_value = NIL) AND (pvt [p$candidates].value^.link = NIL) THEN
      result := pvt [p$candidates].value;
      RETURN;
    IFEND;

    clp$determine_select_result_typ (work_area, return_selected_indices, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$anchor_option].value^.keyword_value = 'ANCHORED' THEN
      anchor_option := clc$sp_anchored;
    ELSE
      anchor_option := clc$sp_unanchored;
    IFEND;

    IF pvt [p$scan_option].value^.keyword_value = 'QUICK_SCAN' THEN
      scan_option := clc$sp_quick_scan;
    ELSE
      scan_option := clc$sp_full_scan;
    IFEND;

    index := 0;
    result := NIL;
    node := pvt [p$candidates].value;
    result_node := ^result;
    WHILE node <> NIL DO
      candidate := node^.element_value^.string_value;

      clp$match_string_pattern (candidate^, pvt [p$pattern].value^.string_pattern_value, anchor_option,
            scan_option, match_info, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      index := index + 1;
      IF match_info.result = clc$sp_success THEN
        IF return_selected_indices THEN
          clp$make_integer_value (index, 10, FALSE, work_area, node^.element_value);
        IFEND;
        result_node^ := node;
        result_node := ^node^.link;
      IFEND;
      node := node^.link;
    WHILEND;

    IF result <> NIL THEN
      result_node^ := NIL;
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$select_strings;
?? TITLE := 'clp$$select_wild_card_names', EJECT ??

  PROCEDURE [XDCL] clp$$select_wild_card_names
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$selwcn) $select_wild_card_names, $select_wild_card_name, $select_name, $select_names (
{   candidates: list 0..clc$max_list_size of name = $required
{   pattern: (wild_card_name) application = $required
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        name: string (14),
        qualifier: clt$application_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 3, 52, 312],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OSM$$SELWCN'], [
    ['CANDIDATES                     ',clc$nominal_entry, 1],
    ['PATTERN                        ',clc$nominal_entry, 2],
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3]],
    [
{ 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, 21, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 18, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [3, 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, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [5, 0, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 2
    [[1, 14, clc$application_type], 'WILD_CARD_NAME', [FALSE]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$candidates = 1,
      p$pattern = 2,
      p$pattern_type = 3;

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

    VAR
      candidate: ^clt$string_value,
      index: clt$list_size,
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      original_pattern: ^clt$string_value,
      pattern: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      result_node: ^^clt$data_value,
      return_selected_indices: boolean,
      string_pattern: ^clt$string_pattern;


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

    IF (pvt [p$candidates].value^.element_value = NIL) AND (pvt [p$candidates].value^.link = NIL) THEN
      result := pvt [p$candidates].value;
      RETURN;
    IFEND;

    clp$determine_select_result_typ (work_area, return_selected_indices, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pattern := pvt [p$pattern].value^.application_value;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    original_pattern := pattern;
    PUSH pattern: [STRLENGTH (original_pattern^)];
    IF pattern_type = clc$wc_basic_pattern THEN
      #TRANSLATE (osv$lower_to_upper, original_pattern^, pattern^);
    ELSE
      #TRANSLATE (osv$lower_to_upper_26, original_pattern^, pattern^);
    IFEND;

    clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
          [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern^, work_area, string_pattern,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    index := 0;
    result := NIL;
    node := pvt [p$candidates].value;
    result_node := ^result;
    WHILE node <> NIL DO
      candidate := ^node^.element_value^.name_value;

      clp$match_string_pattern (candidate^ (1, clp$trimmed_string_size (candidate^)), string_pattern,
            clc$sp_anchored, clc$sp_quick_scan, match_info, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      index := index + 1;
      IF match_info.result = clc$sp_success THEN
        IF return_selected_indices THEN
          clp$make_integer_value (index, 10, FALSE, work_area, node^.element_value);
        IFEND;
        result_node^ := node;
        result_node := ^node^.link;
      IFEND;
      node := node^.link;
    WHILEND;

    IF result <> NIL THEN
      result_node^ := NIL;
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$select_wild_card_names;
?? TITLE := 'clp$$select_wild_card_program_n', EJECT ??

  PROCEDURE [XDCL] clp$$select_wild_card_program_n
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$selwcpn) $select_wild_card_program_names, $select_wild_card_program_name (
{   candidates: list 0..clc$max_list_size of program_name = $required
{   pattern: (wild_card_name) application = $required
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        name: string (14),
        qualifier: clt$application_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 4, 0, 889],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OSM$$SELWCPN'], [
    ['CANDIDATES                     ',clc$nominal_entry, 1],
    ['PATTERN                        ',clc$nominal_entry, 2],
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3]],
    [
{ 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, 19, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 18, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [3, 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, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [3, 0, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$program_name_type]]
    ],
{ PARAMETER 2
    [[1, 14, clc$application_type], 'WILD_CARD_NAME', [FALSE]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$candidates = 1,
      p$pattern = 2,
      p$pattern_type = 3;

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

    VAR
      candidate: ^clt$string_value,
      index: clt$list_size,
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      pattern: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      result_node: ^^clt$data_value,
      return_selected_indices: boolean,
      string_pattern: ^clt$string_pattern;


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

    IF (pvt [p$candidates].value^.element_value = NIL) AND (pvt [p$candidates].value^.link = NIL) THEN
      result := pvt [p$candidates].value;
      RETURN;
    IFEND;

    clp$determine_select_result_typ (work_area, return_selected_indices, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pattern := pvt [p$pattern].value^.application_value;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
          [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern^, work_area, string_pattern,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    index := 0;
    result := NIL;
    node := pvt [p$candidates].value;
    result_node := ^result;
    WHILE node <> NIL DO
      candidate := ^node^.element_value^.program_name_value;

      clp$match_string_pattern (candidate^ (1, clp$trimmed_string_size (candidate^)), string_pattern,
            clc$sp_anchored, clc$sp_quick_scan, match_info, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      index := index + 1;
      IF match_info.result = clc$sp_success THEN
        IF return_selected_indices THEN
          clp$make_integer_value (index, 10, FALSE, work_area, node^.element_value);
        IFEND;
        result_node^ := node;
        result_node := ^node^.link;
      IFEND;
      node := node^.link;
    WHILEND;

    IF result <> NIL THEN
      result_node^ := NIL;
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$select_wild_card_program_n;
?? TITLE := 'clp$$select_wild_card_strings', EJECT ??

  PROCEDURE [XDCL] clp$$select_wild_card_strings
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$selwcs) $select_wild_card_strings, $select_wild_card_string (
{   candidates: list 0..clc$max_list_size of string = $required
{   pattern: (wild_card_pattern) any of
{       string
{       application
{     anyend = $required
{   pattern_type: key
{       (basic, b)
{       (extended, e)
{     keyend = $scl_options.wild_card_pattern_type
{   )

?? 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 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        name: string (17),
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$application_type_qualifier,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (35),
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 4, 10, 295],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'OSM$$SELWCS'], [
    ['CANDIDATES                     ',clc$nominal_entry, 1],
    ['PATTERN                        ',clc$nominal_entry, 2],
    ['PATTERN_TYPE                   ',clc$nominal_entry, 3]],
    [
{ 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, 24, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 49, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [3, 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, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [8, 0, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]
    ],
{ PARAMETER 2
    [[1, 17, clc$union_type], 'WILD_CARD_PATTERN', [[clc$application_type, clc$string_type],
    FALSE, 2],
    8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
    4, [[1, 0, clc$application_type], [FALSE]]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    '$scl_options.wild_card_pattern_type']];

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

    CONST
      p$candidates = 1,
      p$pattern = 2,
      p$pattern_type = 3;

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

    VAR
      candidate: ^clt$string_value,
      index: clt$list_size,
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      pattern: ^clt$string_value,
      pattern_type: clt$wild_card_pattern_type,
      result_node: ^^clt$data_value,
      return_selected_indices: boolean,
      string_pattern: ^clt$string_pattern;


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

    IF (pvt [p$candidates].value^.element_value = NIL) AND (pvt [p$candidates].value^.link = NIL) THEN
      result := pvt [p$candidates].value;
      RETURN;
    IFEND;

    clp$determine_select_result_typ (work_area, return_selected_indices, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$pattern].value^.kind = clc$application THEN
      pattern := pvt [p$pattern].value^.application_value;
    ELSE
      pattern := pvt [p$pattern].value^.string_value;
    IFEND;

    IF pvt [p$pattern_type].value^.keyword_value = 'BASIC' THEN
      pattern_type := clc$wc_basic_pattern;
    ELSE
      pattern_type := clc$wc_extended_pattern;
    IFEND;

    clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts
          [clc$sp_match_at_right, clc$sp_ignore_matched_substring], pattern^, work_area, string_pattern,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    index := 0;
    result := NIL;
    node := pvt [p$candidates].value;
    result_node := ^result;
    WHILE node <> NIL DO
      candidate := node^.element_value^.string_value;

      clp$match_string_pattern (candidate^, string_pattern, clc$sp_anchored, clc$sp_quick_scan, match_info,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      index := index + 1;
      IF match_info.result = clc$sp_success THEN
        IF return_selected_indices THEN
          clp$make_integer_value (index, 10, FALSE, work_area, node^.element_value);
        IFEND;
        result_node^ := node;
        result_node := ^node^.link;
      IFEND;
      node := node^.link;
    WHILEND;

    IF result <> NIL THEN
      result_node^ := NIL;
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$select_wild_card_strings;
?? TITLE := 'clp$$sort', EJECT ??

  PROCEDURE [XDCL] clp$$sort
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$sort) $sort (
{   list: list 0..clc$max_list_size = $required
{   order: (DEFER) any of
{       key
{         (ascending, a)
{         (descending, d)
{       keyend
{       boolean
{     anyend = ascending
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      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,
        recend,
        default_value: string (9),
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 4, 27, 805],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SORT'], [
    ['LIST                           ',clc$nominal_entry, 1],
    ['ORDER                          ',clc$nominal_entry, 2]],
    [
{ 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$deferred_evaluation, clc$standard_parameter_checking, 178,
  clc$optional_default_parameter, 0, 9]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$boolean_type, clc$keyword_type],
    FALSE, 2],
    155, [[1, 0, clc$keyword_type], [4], [
      ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['ASCENDING                      ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['D                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['DESCENDING                     ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    3, [[1, 0, clc$boolean_type]]
    ,
    'ascending']];

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

    CONST
      p$list = 1,
      p$order = 2;

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

{ TYPE
{   x_type = any
{ TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend := [[1, 0, clc$union_type], [-$clt$type_kinds [], FALSE, 0]];

?? POP ??

    VAR
      converted_array: ^clt$data_value,
      current: integer,
      evaluate_expression: boolean,
      expression_parse: clt$parse_state,
      expression_result: ^clt$data_value,
      expression_type_description: clt$type_description,
      gap: integer,
      start: integer,
      swap: ^clt$data_value,
      swap_values: boolean,
      utility_attributes: array [1 .. 1] of clt$utility_attribute,
      utility_name: clt$utility_name;


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

    IF (pvt [p$list].value^.element_value = NIL) AND (pvt [p$list].value^.link = NIL) THEN
      result := pvt [p$list].value;
      RETURN;
    IFEND;

    prepare_deferred_expression (pvt [p$order].value^.deferred_value, pvt [p$order].value^.deferred_type,
          work_area, expression_type_description, expression_parse, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    converted_array := NIL;
    clp$convert_list_to_array (pvt [p$list].value, NIL, NIL, work_area, converted_array, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := 'SORT';
    utility_attributes [1].key := clc$null_utility_attribute;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$create_procedure_variable ('X1', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          #SEQ (type_specification), NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$create_procedure_variable ('X2', clc$local_scope, clc$read_write, clc$immediate_evaluation,
          #SEQ (type_specification), NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Use shell sort technique.

    evaluate_expression := TRUE;
    gap := UPPERBOUND (converted_array^.array_value^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (converted_array^.array_value^) - gap DO
        current := start;
        swap_values := TRUE;
        WHILE (current > 0) AND swap_values DO
          IF evaluate_expression THEN
            clp$change_variable ('X1', converted_array^.array_value^ [current], status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            clp$change_variable ('X2', converted_array^.array_value^ [current + gap], status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            evaluate_deferred_expression (expression_parse, ^expression_type_description, work_area,
                  expression_result, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF expression_result^.kind = clc$keyword THEN
              evaluate_expression := FALSE;
            IFEND;
          IFEND;
          IF evaluate_expression THEN
            swap_values := NOT expression_result^.boolean_value.value;
          ELSEIF expression_result^.keyword_value = 'ASCENDING' THEN
            swap_values := (clp$data_value_compare (converted_array^.array_value^ [current],
                  converted_array^.array_value^ [current + gap]) = clc$left_is_greater);
          ELSE {DESCENDING}
            swap_values := (clp$data_value_compare (converted_array^.array_value^ [current],
                  converted_array^.array_value^ [current + gap]) = clc$right_is_greater);
          IFEND;
          IF swap_values THEN
            swap := converted_array^.array_value^ [current];
            converted_array^.array_value^ [current] := converted_array^.array_value^ [current + gap];
            converted_array^.array_value^ [current + gap] := swap;
            current := current - gap;
          IFEND;
        WHILEND;
      FOREND;
    WHILEND;

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    result := NIL;
    clp$convert_array_to_list (converted_array, NIL, NIL, work_area, result, status);
    IF status.normal THEN
      result^.generated_via_list_rest := FALSE;
    IFEND;

  PROCEND clp$$sort;
?? TITLE := 'clp$$sublist', EJECT ??

  PROCEDURE [XDCL] clp$$sublist
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$sublist) $sublist (
{   list: list 0..clc$max_list_size = $required
{   selector: list 0..clc$max_list_size of any of
{       integer 1..clc$max_list_size
{       range of integer 1..clc$max_list_size
{       record
{         start: integer 1..clc$max_list_size
{         count: any of
{           key
{             all
{           keyend
{           integer 0..clc$max_list_size
{         anyend
{       recend
{     anyend = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: 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$integer_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$range_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
              qualifier: clt$integer_type_qualifier,
            recend,
          recend,
          type_size_3: clt$type_specification_size,
          element_type_spec_3: record
            header: clt$type_specification_header,
            qualifier: clt$record_type_qualifier,
            field_spec_1: clt$field_specification,
            element_type_spec_1: record
              header: clt$type_specification_header,
              qualifier: clt$integer_type_qualifier,
            recend,
            field_spec_2: clt$field_specification,
            element_type_spec_2: 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,
                qualifier: clt$integer_type_qualifier,
              recend,
            recend,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 13, 9, 28, 56, 674],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$SUBLIST'], [
    ['LIST                           ',clc$nominal_entry, 1],
    ['SELECTOR                       ',clc$nominal_entry, 2]],
    [
{ 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, 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, 270,
  clc$required_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [254, 0, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$union_type], [[clc$integer_type, clc$range_type, clc$record_type],
      FALSE, 3],
      20, [[1, 0, clc$integer_type], [1, clc$max_list_size, 10]],
      27, [[1, 0, clc$range_type], [20],
          [[1, 0, clc$integer_type], [1, clc$max_list_size, 10]]
        ],
      183, [[1, 0, clc$record_type], [2],
        ['START                          ', clc$required_field, 20], [[1, 0, clc$integer_type], [1,
  clc$max_list_size, 10]],
        ['COUNT                          ', clc$required_field, 84], [[1, 0, clc$union_type], [[
          clc$integer_type, clc$keyword_type],
          FALSE, 2],
          44, [[1, 0, clc$keyword_type], [1], [
            ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
            ],
          20, [[1, 0, clc$integer_type], [0, clc$max_list_size, 10]]
          ]
        ]
      ]
    ]];

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

    CONST
      p$list = 1,
      p$selector = 2;

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

    VAR
      count: integer,
      list_index: 1 .. clc$max_list_size,
      list_node: ^clt$data_value,
      number_of_elements: clt$list_size,
      result_node: ^^clt$data_value,
      selector_node: ^clt$data_value,
      start: 1 .. clc$max_list_size;


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

    list_node := pvt [p$list].value;
    number_of_elements := clp$count_list_elements (list_node);

    IF number_of_elements = 0 THEN
      result := list_node;
      RETURN;
    IFEND;

    selector_node := pvt [p$selector].value;
    list_index := 1;
    result := NIL;
    result_node := ^result;

    WHILE (selector_node <> NIL) AND (selector_node^.element_value <> NIL) DO
      CASE selector_node^.element_value^.kind OF

      = clc$integer =
        start := selector_node^.element_value^.integer_value.value;
        count := 1;

      = clc$range =
        start := selector_node^.element_value^.low_value^.integer_value.value;
        count := selector_node^.element_value^.high_value^.integer_value.value - start + 1;

      ELSE {clc$record}
        start := selector_node^.element_value^.field_values^ [1].value^.integer_value.value;
        IF selector_node^.element_value^.field_values^ [2].value^.kind = clc$keyword {ALL} THEN
          count := number_of_elements - start + 1;
        ELSE
          count := selector_node^.element_value^.field_values^ [2].value^.integer_value.value;
        IFEND;
      CASEND;

      IF (start <= number_of_elements) AND (count > 0) THEN
        IF start < list_index THEN
          list_node := pvt [p$list].value;
          list_index := 1;
        IFEND;
        WHILE list_index < start DO
          list_index := list_index + 1;
          list_node := list_node^.link;
        WHILEND;
        REPEAT
          clp$make_list_value (work_area, result_node^);
          result_node^^.element_value := list_node^.element_value;
          result_node := ^result_node^^.link;
          list_node := list_node^.link;
          list_index := list_index + 1;
          count := count - 1;
        UNTIL (count = 0) OR (list_node = NIL);
      IFEND;

      selector_node := selector_node^.link;
    WHILEND;

    IF result = NIL THEN
      clp$make_list_value (work_area, result);
      RETURN;
    IFEND;

  PROCEND clp$$sublist;
?? TITLE := 'clp$$subset', EJECT ??

  PROCEDURE [XDCL] clp$$subset
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$subset) $subset (
{   subset: list 0..clc$max_list_size = $required
{   set: list 0..clc$max_list_size = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 5, 7, 629],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$SUBSET'], [
    ['SET                            ',clc$nominal_entry, 2],
    ['SUBSET                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, 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, 16, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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, 16, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]];

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

    CONST
      p$subset = 1,
      p$set = 2;

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

    VAR
      first_list: ^clt$data_value,
      second_list: ^clt$data_value;


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

    first_list := pvt [p$subset].value;

  /traverse_first_list/
    WHILE first_list <> NIL DO
      second_list := pvt [p$set].value;

    /compare_elements/
      WHILE second_list <> NIL DO

{  The check of first_list^.element_value for NIL is necessary for an empty list
{  to be the subset of any list.

        IF (first_list^.element_value = NIL) OR (clp$data_value_compare
              (first_list^.element_value, second_list^.element_value) = clc$equal) THEN
          EXIT /compare_elements/;
        IFEND;
        second_list := second_list^.link;
      WHILEND /compare_elements/;

      IF second_list = NIL THEN
        EXIT /traverse_first_list/;
      IFEND;
      first_list := first_list^.link;
    WHILEND /traverse_first_list/;

    clp$make_boolean_value ((second_list <> NIL), clc$true_false_boolean, work_area, result);
    IF result = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$$subset;
?? TITLE := 'clp$$union', EJECT ??

  PROCEDURE [XDCL] clp$$union
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$union) $union (
{   lists: list rest of list 0..clc$max_list_size = $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,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 3, 10, 5, 15, 550],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$UNION'], [
    ['LISTS                          ',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, 32, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [16, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$list_type], [0, 0, clc$max_list_size, 0, FALSE, FALSE]]
    ]];

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

    CONST
      p$lists = 1;

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


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

    join_lists (pvt [p$lists].value, result);

    IF result <> NIL THEN
      remove_redundant_elements (result);
      result^.generated_via_list_rest := FALSE;
    ELSE
      clp$make_list_value (work_area, result);
      IF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$$union;
?? TITLE := 'clp$reverse_list', EJECT ??

  PROCEDURE [XDCL] clp$reverse_list
    (VAR list: ^clt$data_value);

    VAR
      previous: ^clt$data_value,
      next_node: ^clt$data_value,
      node: ^clt$data_value;

    previous := NIL;
    node := list;

    WHILE node <> NIL DO
      next_node := node^.link;
      node^.link := previous;
      previous := node;
      node := next_node;
    WHILEND;

    list := previous;

  PROCEND clp$reverse_list;
?? TITLE := 'clp$determine_select_result_typ', EJECT ??

  PROCEDURE [XDCL] clp$determine_select_result_typ
    (VAR work_area {input, output} : ^clt$work_area;
     VAR return_selected_indices: boolean;
     VAR status: ost$status);

    VAR
      element_type_kind: clt$type_kind,
      ignore_element_type_spec: ^clt$type_specification;


    get_expected_element_type (NIL, work_area, element_type_kind, ignore_element_type_spec, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    return_selected_indices := element_type_kind = clc$integer_type;

  PROCEND clp$determine_select_result_typ;
?? TITLE := 'evaluate_deferred_expression', EJECT ??

  PROCEDURE [INLINE] evaluate_deferred_expression
    (    expression_parse: clt$parse_state;
         type_description: ^clt$type_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    VAR
      ignore_result_type_description: ^clt$type_description,
      parse: clt$parse_state;


    status.normal := TRUE;
    parse := expression_parse;

    clp$internal_evaluate_expr (parse, type_description, work_area, ignore_result_type_description, result,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit_index < parse.index_limit THEN
      osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;

    IF result^.kind = clc$unspecified THEN
      osp$set_status_abnormal ('CL', cle$unspecified_value_for_req, 'clp$evaluate_expression', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, expression_parse.text^, status);
    IFEND;

  PROCEND evaluate_deferred_expression;
?? TITLE := 'find_non_empty_list', EJECT ??

  PROCEDURE [INLINE] find_non_empty_list
    (VAR node: ^clt$data_value);

    WHILE (node <> NIL) AND (node^.element_value^.kind = clc$list) AND
          (node^.element_value^.element_value = NIL) DO
      node := node^.link;
    WHILEND;

  PROCEND find_non_empty_list;
?? TITLE := 'get_expected_element_type', EJECT ??

  PROCEDURE [INLINE] get_expected_element_type
    (    default_element_type: ^clt$type_specification;
     VAR work_area {input, output} : ^clt$work_area;
     VAR element_type_kind: clt$type_kind;
     VAR element_type_specification: ^clt$type_specification;
     VAR status: ost$status);

    VAR
      expected_type_specification: ^clt$type_specification,
      header: ^clt$type_specification_header,
      ignore_type_name: ^clt$type_name_reference,
      list_type_qualifier: ^clt$list_type_qualifier_v2;


    clp$get_expected_type (work_area, expected_type_specification, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    element_type_specification := default_element_type;

  /find_element_type/
    WHILE expected_type_specification <> NIL DO
      RESET expected_type_specification;
      NEXT header IN expected_type_specification;
      IF header^.kind <> clc$list_type THEN
        EXIT /find_element_type/;
      IFEND;
      NEXT ignore_type_name: [header^.name_size] IN expected_type_specification;
      NEXT list_type_qualifier IN expected_type_specification;
      IF list_type_qualifier^.element_type_specification_size = 0 THEN
        element_type_specification := default_element_type;
        EXIT /find_element_type/;
      IFEND;
      NEXT element_type_specification: [[REP list_type_qualifier^.element_type_specification_size OF cell]] IN
            expected_type_specification;
      IF NOT list_type_qualifier^.list_rest THEN
        EXIT /find_element_type/;
      IFEND;
      expected_type_specification := element_type_specification;
    WHILEND /find_element_type/;

    IF element_type_specification = NIL THEN
      element_type_kind := clc$union_type;
    ELSE
      RESET element_type_specification;
      NEXT header IN element_type_specification;
      element_type_kind := header^.kind;
      RESET element_type_specification;
    IFEND;

  PROCEND get_expected_element_type;
?? TITLE := 'join_lists', EJECT ??

  PROCEDURE [INLINE] join_lists
    (    value: ^clt$data_value;
     VAR result: ^clt$data_value);

    VAR
      last_node: ^clt$data_value,
      next_node: ^^clt$data_value,
      top_node: ^clt$data_value;


    result := NIL;
    next_node := ^result;
    top_node := value;

  /join/
    WHILE TRUE DO
      WHILE top_node^.element_value^.element_value = NIL DO
        IF top_node^.link = NIL THEN
          EXIT /join/;
        IFEND;
        top_node := top_node^.link;
      WHILEND;

      next_node^ := top_node^.element_value;

      IF top_node^.link = NIL THEN
        EXIT /join/;
      IFEND;
      last_node := top_node^.element_value;
      WHILE last_node^.link <> NIL DO
        last_node := last_node^.link;
      WHILEND;
      top_node := top_node^.link;

      next_node := ^last_node^.link;
    WHILEND /join/;

  PROCEND join_lists;
?? TITLE := 'prepare_deferred_expression', EJECT ??

  PROCEDURE [INLINE] prepare_deferred_expression
    (    expression_text: ^clt$expression_text;
         type_specification: ^clt$type_specification;
     VAR work_area {input, output} : ^clt$work_area;
     VAR type_description: clt$type_description;
     VAR expression_parse: clt$parse_state;
     VAR status: ost$status);

    VAR
      lexical_units: ^clt$lexical_units;


    clp$convert_type_spec_to_desc (type_specification, work_area, type_description, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$identify_lexical_units (expression_text, work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$initialize_parse_state (expression_text, lexical_units, expression_parse);
    clp$scan_non_space_lexical_unit (expression_parse);

  PROCEND prepare_deferred_expression;
?? TITLE := 'remove_redundant_elements', EJECT ??

  PROCEDURE [INLINE] remove_redundant_elements
    (VAR node: ^clt$data_value);

    VAR
      local_node: ^clt$data_value,
      previous_node: ^clt$data_value;


    IF (node <> NIL) AND (node^.element_value = NIL) THEN
      node := node^.link;
    IFEND;
    local_node := node;

    WHILE local_node <> NIL DO
      previous_node := local_node;
      WHILE previous_node^.link <> NIL DO
        IF (previous_node^.link^.element_value = NIL) OR (clp$data_value_compare
              (local_node^.element_value, previous_node^.link^.element_value) = clc$equal) THEN
          previous_node^.link := previous_node^.link^.link;
        ELSE
          previous_node := previous_node^.link;
        IFEND;
      WHILEND;
      local_node := local_node^.link;
    WHILEND;

  PROCEND remove_redundant_elements;

MODEND clm$list_functions;

