?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE System Command Language Test Utility (SCLTU)' ??
MODULE clm$test_utility;

{
{ PURPOSE:
{   This module contains a command utility used to test command language
{   supplied interfaces.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc cle$work_area_overflow
*copyc clt$parameter_list
*copyc clt$data_value
*copyc clt$work_area
*copyc ost$status
?? POP ??
*copyc clp$begin_utility
*copyc clp$build_pattern_for_wild_card
*copyc clp$change_variable
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$convert_real_to_string
*copyc clp$convert_string_to_file
*copyc clp$convert_string_to_integer
*copyc clp$convert_string_to_name
*copyc clp$convert_string_to_real
*copyc clp$edit_command_parameter_list
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$evaluate_token
*copyc clp$get_job_parameters
*copyc clp$include_file
*copyc clp$make_boolean_value
*copyc clp$make_integer_value
*copyc clp$make_list_value
*copyc clp$make_sized_string_value
*copyc clp$make_value
*copyc clp$match_string_pattern
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$sp_convert_to_string
*copyc clp$trimmed_string_size
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$establish_block_exit_hndlr
*copyc osp$disestablish_cond_handler
*copyc osp$set_status_abnormal

?? TITLE := 'utility command and function tables, etc.', EJECT ??

  SECTION
    read_only: READ;

  CONST
    utility_name = 'SCLTU                          ',
    utility_prompt = 'SCLTU';

{ table command_table section_name=read_only
{ command (quit qui), quit
{ command (clp$convert_string_to_integer convert_string_to_integer consti), convert_string_to_integer
{ command (clp$convert_string_to_name convert_string_to_name constn), convert_string_to_name
{ command (clp$convert_string_to_real convert_string_to_real constr), convert_string_to_real
{ command (clp$edit_command_parameter_list edit_command_parameter_list edicpl), edit_command_parameter_list
{ command (clp$evaluate_token evaluate_token evat), evaluate_token
{ command (clp$get_job_parameters get_job_parameters getjp), get_job_parameters
{ command (test_string_patterns test_string_pattern tessp), test_string_patterns
{ command (display_string_pattern dissp), display_string_pattern
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    command_table: [STATIC, READ, read_only] ^clt$command_table := ^command_table_entries,

    command_table_entries: [STATIC, READ, read_only] array [1 .. 23] of clt$command_table_entry := [
          {} ['CLP$CONVERT_STRING_TO_INTEGER  ', clc$nominal_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^convert_string_to_integer],
          {} ['CLP$CONVERT_STRING_TO_NAME     ', clc$nominal_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^convert_string_to_name],
          {} ['CLP$CONVERT_STRING_TO_REAL     ', clc$nominal_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^convert_string_to_real],
          {} ['CLP$EDIT_COMMAND_PARAMETER_LIST', clc$nominal_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^edit_command_parameter_list],
          {} ['CLP$EVALUATE_TOKEN             ', clc$nominal_entry, clc$normal_usage_entry, 6,
          clc$automatically_log, clc$linked_call, ^evaluate_token],
          {} ['CLP$GET_JOB_PARAMETERS         ', clc$nominal_entry, clc$normal_usage_entry, 7,
          clc$automatically_log, clc$linked_call, ^get_job_parameters],
          {} ['CONSTI                         ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^convert_string_to_integer],
          {} ['CONSTN                         ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^convert_string_to_name],
          {} ['CONSTR                         ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^convert_string_to_real],
          {} ['CONVERT_STRING_TO_INTEGER      ', clc$alias_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^convert_string_to_integer],
          {} ['CONVERT_STRING_TO_NAME         ', clc$alias_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^convert_string_to_name],
          {} ['CONVERT_STRING_TO_REAL         ', clc$alias_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^convert_string_to_real],
          {} ['EDICPL                         ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^edit_command_parameter_list],
          {} ['EDIT_COMMAND_PARAMETER_LIST    ', clc$alias_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^edit_command_parameter_list],
          {} ['EVALUATE_TOKEN                 ', clc$alias_entry, clc$normal_usage_entry, 6,
          clc$automatically_log, clc$linked_call, ^evaluate_token],
          {} ['EVAT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
          clc$automatically_log, clc$linked_call, ^evaluate_token],
          {} ['GETJP                          ', clc$abbreviation_entry, clc$normal_usage_entry, 7,
          clc$automatically_log, clc$linked_call, ^get_job_parameters],
          {} ['GET_JOB_PARAMETERS             ', clc$alias_entry, clc$normal_usage_entry, 7,
          clc$automatically_log, clc$linked_call, ^get_job_parameters],
          {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^quit],
          {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^quit],
          {} ['TESSP                          ', clc$abbreviation_entry, clc$normal_usage_entry, 8,
          clc$automatically_log, clc$linked_call, ^test_string_patterns],
          {} ['TEST_STRING_PATTERN            ', clc$alias_entry, clc$normal_usage_entry, 8,
          clc$automatically_log, clc$linked_call, ^test_string_patterns],
          {} ['TEST_STRING_PATTERNS           ', clc$nominal_entry, clc$normal_usage_entry, 8,
          clc$automatically_log, clc$linked_call, ^test_string_patterns]];

?? POP ??

{ table function_table type=function section_name=read_only
{ function ($memory $mem), clp$$memory, " availability=advanced_usage
{ function ($memory_string $ms), clp$$memory_string, " availability=advanced_usage
{ function ($nil_pva $np), clp$$nil_pva, " availability=advanced_usage
{ function $match                         clp$$match xref
{ function $sp_any                        clp$$sp_any xref
{ function $sp_balance                    clp$$sp_balance xref
{ function $sp_capture                    clp$$sp_capture xref
{ function $sp_count                      clp$$sp_count xref
{ function $sp_defer                      clp$$sp_defer xref
{ function $sp_fail                       clp$$sp_fail xref
{ function $sp_fence                      clp$$sp_fence xref
{ function $sp_left                       clp$$sp_left xref
{ function $sp_index                      clp$$sp_index xref
{ function $sp_not_any                    clp$$sp_not_any xref
{ function $sp_null                       clp$$sp_null xref
{ function $sp_or                         clp$$sp_or xref
{ function $sp_repeat                     clp$$sp_repeat xref
{ function $sp_right                      clp$$sp_right xref
{ function $sp_stop                       clp$$sp_stop xref
{ function $sp_string                     clp$$sp_string xref
{ function $sp_succeed                    clp$$sp_succeed xref
{ function $sp_test                       clp$$sp_test xref
{ function $sp_upto                       clp$$sp_upto xref
{ function ($sp_wild_card                 ,$sp_wc) clp$$sp_wild_card xref
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  function_table: [STATIC, READ, read_only] ^clt$function_processor_table := ^function_table_entries,

  function_table_entries: [STATIC, READ, read_only] array [1 .. 28] of clt$function_proc_table_entry := [
  {} ['$MATCH                         ', clc$nominal_entry, clc$normal_usage_entry, 4,
        clc$linked_call, ^clp$$match],
  {} ['$MEM                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$linked_call, ^clp$$memory],
  {} ['$MEMORY                        ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$linked_call, ^clp$$memory],
  {} ['$MEMORY_STRING                 ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$linked_call, ^clp$$memory_string],
  {} ['$MS                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$linked_call, ^clp$$memory_string],
  {} ['$NIL_PVA                       ', clc$nominal_entry, clc$normal_usage_entry, 3,
        clc$linked_call, ^clp$$nil_pva],
  {} ['$NP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
        clc$linked_call, ^clp$$nil_pva],
  {} ['$SP_ANY                        ', clc$nominal_entry, clc$normal_usage_entry, 5,
        clc$linked_call, ^clp$$sp_any],
  {} ['$SP_BALANCE                    ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$linked_call, ^clp$$sp_balance],
  {} ['$SP_CAPTURE                    ', clc$nominal_entry, clc$normal_usage_entry, 7,
        clc$linked_call, ^clp$$sp_capture],
  {} ['$SP_COUNT                      ', clc$nominal_entry, clc$normal_usage_entry, 8,
        clc$linked_call, ^clp$$sp_count],
  {} ['$SP_DEFER                      ', clc$nominal_entry, clc$normal_usage_entry, 9,
        clc$linked_call, ^clp$$sp_defer],
  {} ['$SP_FAIL                       ', clc$nominal_entry, clc$normal_usage_entry, 10,
        clc$linked_call, ^clp$$sp_fail],
  {} ['$SP_FENCE                      ', clc$nominal_entry, clc$normal_usage_entry, 11,
        clc$linked_call, ^clp$$sp_fence],
  {} ['$SP_INDEX                      ', clc$nominal_entry, clc$normal_usage_entry, 13,
        clc$linked_call, ^clp$$sp_index],
  {} ['$SP_LEFT                       ', clc$nominal_entry, clc$normal_usage_entry, 12,
        clc$linked_call, ^clp$$sp_left],
  {} ['$SP_NOT_ANY                    ', clc$nominal_entry, clc$normal_usage_entry, 14,
        clc$linked_call, ^clp$$sp_not_any],
  {} ['$SP_NULL                       ', clc$nominal_entry, clc$normal_usage_entry, 15,
        clc$linked_call, ^clp$$sp_null],
  {} ['$SP_OR                         ', clc$nominal_entry, clc$normal_usage_entry, 16,
        clc$linked_call, ^clp$$sp_or],
  {} ['$SP_REPEAT                     ', clc$nominal_entry, clc$normal_usage_entry, 17,
        clc$linked_call, ^clp$$sp_repeat],
  {} ['$SP_RIGHT                      ', clc$nominal_entry, clc$normal_usage_entry, 18,
        clc$linked_call, ^clp$$sp_right],
  {} ['$SP_STOP                       ', clc$nominal_entry, clc$normal_usage_entry, 19,
        clc$linked_call, ^clp$$sp_stop],
  {} ['$SP_STRING                     ', clc$nominal_entry, clc$normal_usage_entry, 20,
        clc$linked_call, ^clp$$sp_string],
  {} ['$SP_SUCCEED                    ', clc$nominal_entry, clc$normal_usage_entry, 21,
        clc$linked_call, ^clp$$sp_succeed],
  {} ['$SP_TEST                       ', clc$nominal_entry, clc$normal_usage_entry, 22,
        clc$linked_call, ^clp$$sp_test],
  {} ['$SP_UPTO                       ', clc$nominal_entry, clc$normal_usage_entry, 23,
        clc$linked_call, ^clp$$sp_upto],
  {} ['$SP_WC                         ', clc$abbreviation_entry, clc$normal_usage_entry, 24,
        clc$linked_call, ^clp$$sp_wild_card],
  {} ['$SP_WILD_CARD                  ', clc$nominal_entry, clc$normal_usage_entry, 24,
        clc$linked_call, ^clp$$sp_wild_card]];

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

?? POP ??



  VAR
    display_control: clt$display_control,
    first_time: boolean := TRUE,
    restart_utility: boolean,
    segment_pointer: amt$segment_pointer,
    work_area: ^clt$work_area;

?? TITLE := 'scltu', EJECT ??

  PROGRAM clp$_scl_test_utility
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE scl_test_utility, scltu (
{   input, i: file = $command
{   output, o: file = $output
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (8),
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 14, 23, 2, 538],
    clc$command, 5, 3, 0, 0, 0, 0, 3, ''], [
    ['I                              ',clc$abbreviation_entry, 1],
    ['INPUT                          ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type],
    '$command'],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$input = 1,
      p$output = 2,
      p$status = 3;

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

    VAR
      default_ring_attributes: amt$ring_attributes,
      file_reference: ^fst$file_reference,
      utility_attributes: array [1 .. 3] of clt$utility_attribute;


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

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);
    clp$open_display_reference (pvt [p$output].value^.file_value^, NIL, fsc$legible_data,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    work_area := segment_pointer.sequence_pointer;

    REPEAT
      restart_utility := FALSE;

      utility_attributes [1].key := clc$utility_prompt;
      utility_attributes [1].prompt.value := utility_prompt;
      utility_attributes [1].prompt.size := STRLENGTH (utility_prompt);
      utility_attributes [2].key := clc$utility_command_table;
      utility_attributes [2].command_table := command_table;
      utility_attributes [3].key := clc$utility_function_proc_table;
      utility_attributes [3].function_processor_table := function_table;
      clp$begin_utility (utility_name, utility_attributes, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF first_time THEN
        first_time := FALSE;
        file_reference := pvt [p$input].value^.file_value;
      ELSEIF file_reference^ (1, STRLENGTH (':$COMMAND.')) <> ':$COMMAND.' THEN
        PUSH file_reference: [clp$trimmed_string_size (file_reference^) + STRLENGTH ('.$ASIS')];
        file_reference^ := pvt [p$input].value^.file_value^;
        file_reference^ (STRLENGTH (file_reference^) - STRLENGTH ('.$ASIS') + 1, * ) := '.$ASIS';
      IFEND;

      clp$include_file (file_reference^, utility_prompt, utility_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

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

    UNTIL NOT restart_utility;

    clp$close_display (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    mmp$delete_scratch_segment (segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND clp$_scl_test_utility;
?? TITLE := 'quit', EJECT ??

  PROCEDURE quit
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE quit, qui (
{   restart, r: boolean = no
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (2),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 14, 53, 55, 176],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['R                              ',clc$abbreviation_entry, 1],
    ['RESTART                        ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$boolean_type],
    'no'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

    CONST
      p$restart = 1,
      p$status = 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;

    restart_utility := pvt [p$restart].value^.boolean_value.value;

    clp$end_include (utility_name, status);

  PROCEND quit;
?? TITLE := 'pva_ring', EJECT ??

  FUNCTION [INLINE] pva_ring
    (    address: 0 .. 0ffffffffffff(16)): 0 .. 0f(16);


    pva_ring := address DIV 100000000000(16);

  FUNCEND pva_ring;
?? TITLE := 'pva_segment', EJECT ??

  FUNCTION [INLINE] pva_segment
    (    address: 0 .. 0ffffffffffff(16)): 0 .. 0fff(16);


    pva_segment := (address MOD 100000000000(16)) DIV 100000000(16);

  FUNCEND pva_segment;
?? TITLE := 'pva_offset', EJECT ??

  FUNCTION [INLINE] pva_offset
    (    address: 0 .. 0ffffffffffff(16)): -80000000(16) .. 7fffffff(16);

    VAR
      offset_converter: packed record
        case 1 .. 2 of
        = 1 =
          positive_offset: 0 .. 0ffffffff(16),
        = 2 =
          signed_offset: -80000000(16) .. 7fffffff(16),
        casend,
      recend;


    offset_converter.positive_offset := address MOD 100000000(16);
    pva_offset := offset_converter.signed_offset;

  FUNCEND pva_offset;
?? TITLE := 'clp$$memory', EJECT ??

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

{ FUNCTION $memory (
{   address: integer 0..0ffffffffffff(16) = $required
{   size: integer 1..8 = 6
{   )

?? 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$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 8, 3, 15, 6, 33, 401],
    clc$function, 2, 2, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['SIZE                           ',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, 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$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0ffffffffffff(16), 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, 8, 10],
    '6']];

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

    CONST
      p$address = 1,
      p$size = 2;

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

    VAR
      address: 0 .. 0ffffffffffff(16),
      pointer: ^string (8),
      size: 1 .. 8,
      word: string (8);


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

    address := pvt [p$address].value^.integer_value.value;
    size := pvt [p$size].value^.integer_value.value;

    clp$make_integer_value (0, 16, TRUE, work_area, result);
    pointer := #ADDRESS (#RING (^address), pva_segment (address), pva_offset (address));
    #UNCHECKED_CONVERSION (result^.integer_value.value, word);
    word (8 + 1 - size, size) := pointer^ (1, size);
    #UNCHECKED_CONVERSION (word, result^.integer_value.value);

  PROCEND clp$$memory;
?? TITLE := 'clp$$memory_string', EJECT ??

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

{ FUNCTION $memory_string (
{   address: integer 0..0ffffffffffff(16) = $required
{   size: integer 0..cyc$max_string_size = 1
{   )

?? 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$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 8, 3, 15, 56, 18, 198],
    clc$function, 2, 2, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',clc$nominal_entry, 1],
    ['SIZE                           ',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, 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$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0ffffffffffff(16), 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, cyc$max_string_size, 10],
    '1']];

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

    CONST
      p$address = 1,
      p$size = 2;

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

    VAR
      address: 0 .. 0ffffffffffff(16),
      pointer: ^string (cyc$max_string_size),
      size: 0 .. cyc$max_string_size;


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

    address := pvt [p$address].value^.integer_value.value;
    size := pvt [p$size].value^.integer_value.value;

    clp$make_sized_string_value (size, work_area, result);
    pointer := #ADDRESS (#RING (^address), pva_segment (address), pva_offset (address));
    result^.string_value^ := pointer^ (1, size);

  PROCEND clp$$memory_string;
?? TITLE := 'clp$$nil_pva', EJECT ??

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

{ FUNCTION $nil_pva (
{   address: integer 0..0ffffffffffff(16) = $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$integer_type_qualifier,
      recend,
    recend := [
    [1,
    [89, 8, 3, 16, 13, 33, 262],
    clc$function, 1, 1, 1, 0, 0, 0, 0, ''], [
    ['ADDRESS                        ',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, 20, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 0ffffffffffff(16), 10]]];

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

    CONST
      p$address = 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$address].value^.integer_value.value DIV 80000000(16)) = 1ffff(16),
          clc$true_false_boolean, work_area, result);

  PROCEND clp$$nil_pva;
?? TITLE := 'convert_string_to_integer', EJECT ??

  PROCEDURE convert_string_to_integer
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE convert_string_to_integer, consti (
{   string, s: string = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 18, 3, 43, 393],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['S                              ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2],
    ['STRING                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      int: clt$integer,
      str: ost$string;


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

    clp$convert_string_to_integer (pvt [p$string].value^.string_value^, int, status);
    IF status.normal THEN
      clp$convert_integer_to_string (int.value, int.radix, int.radix_specified, str, status);
      IF status.normal THEN
        clp$put_display (display_control, str.value (1, str.size), clc$no_trim, status);
      IFEND;
    IFEND;

  PROCEND convert_string_to_integer;
?? TITLE := 'convert_string_to_name', EJECT ??

  PROCEDURE convert_string_to_name
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE convert_string_to_name, constn (
{   string, s: string = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 18, 3, 43, 393],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['S                              ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2],
    ['STRING                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      name: clt$name;


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

    clp$convert_string_to_name (pvt [p$string].value^.string_value^, name, status);
    IF status.normal THEN
      clp$put_display (display_control, name.value (1, name.size), clc$no_trim, status);
    IFEND;

  PROCEND convert_string_to_name;
?? TITLE := 'convert_string_to_real', EJECT ??

  PROCEDURE convert_string_to_real
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE convert_string_to_real, constr (
{   string, s: string = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 18, 3, 43, 393],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['S                              ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2],
    ['STRING                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      real_number: clt$real,
      str: ost$string;


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

    clp$convert_string_to_real (pvt [p$string].value^.string_value^, real_number, status);
    IF status.normal THEN
      clp$convert_real_to_string (real_number.value, real_number.number_of_digits, str, status);
      IF status.normal THEN
        clp$put_display (display_control, str.value (1, str.size), clc$no_trim, status);
      IFEND;
    IFEND;

  PROCEND convert_string_to_real;
?? TITLE := 'edit_command_parameter_list', EJECT ??

  PROCEDURE edit_command_parameter_list
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE edit_command_parameter_list, edicpl (
{   command_and_parameters, cap: string = $required
{   max_string, maxs: integer 0..clc$max_string_size = $required
{   edited_parameters, ep: (VAR) list 0..clc$max_list_size of string = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 4, 13, 39, 22, 425],
    clc$command, 7, 4, 3, 0, 0, 1, 4, ''], [
    ['CAP                            ',clc$abbreviation_entry, 1],
    ['COMMAND_AND_PARAMETERS         ',clc$nominal_entry, 1],
    ['EDITED_PARAMETERS              ',clc$nominal_entry, 3],
    ['EP                             ',clc$abbreviation_entry, 3],
    ['MAXS                           ',clc$abbreviation_entry, 2],
    ['MAX_STRING                     ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 24,
  clc$required_parameter, 0, 0],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10]],
{ PARAMETER 3
    [[1, 0, clc$list_type], [8, 0, clc$max_list_size, FALSE],
      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]
    ],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$command_and_parameters = 1,
      p$max_string = 2,
      p$edited_parameters = 3,
      p$status = 4;

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

    VAR
      i: clt$data_representation_count,
      node: ^clt$data_value,
      representation: ^clt$data_representation,
      result: ^clt$data_value,
      string_count: ^clt$data_representation_count,
      string_size: ^clt$string_size;


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

    RESET work_area;

    clp$edit_command_parameter_list (pvt [p$command_and_parameters].value^.string_value^,
          pvt [p$max_string].value^.integer_value.value, work_area, representation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT string_count IN representation;
    clp$make_list_value (work_area, result);
    node := result;

    FOR i := 1 TO string_count^ DO
      clp$make_value (clc$string, work_area, node^.element_value);
      NEXT string_size IN representation;
      NEXT node^.element_value^.string_value: [string_size^] IN representation;
      IF i < string_count^ THEN
        clp$make_list_value (work_area, node^.link);
        node := node^.link;
      IFEND;
    FOREND;

    clp$change_variable (pvt [p$edited_parameters].variable^, result, status);

  PROCEND edit_command_parameter_list;
?? TITLE := 'evaluate_token', EJECT ??

  PROCEDURE evaluate_token
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE evaluate_token, evat (
{   text, t: string = $required
{   evaluation_options, evaluation_option, eo: list 0..clc$max_list_size of key
{       (clc$ignore_spaces_before_token, isbt)
{       (clc$comment_is_token, cit)
{       (clc$classify_name_token, cnt)
{       (clc$cobol_name_is_token, cnit)
{       (clc$special_cybil_name_is_token, scnit)
{       (clc$international_char_is_token, icit)
{       (clc$special_char_is_token, scit)
{     keyend = ()
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 14] of clt$keyword_specification,
        recend,
        default_value: string (2),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 3, 18, 23, 9, 307],
    clc$command, 6, 3, 1, 0, 0, 0, 3, ''], [
    ['EO                             ',clc$abbreviation_entry, 2],
    ['EVALUATION_OPTION              ',clc$alias_entry, 2],
    ['EVALUATION_OPTIONS             ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['T                              ',clc$abbreviation_entry, 1],
    ['TEXT                           ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 541,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [525, 0, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [14], [
      ['CIT                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['CLC$CLASSIFY_NAME_TOKEN        ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['CLC$COBOL_NAME_IS_TOKEN        ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['CLC$COMMENT_IS_TOKEN           ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['CLC$IGNORE_SPACES_BEFORE_TOKEN ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['CLC$INTERNATIONAL_CHAR_IS_TOKEN', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['CLC$SPECIAL_CHAR_IS_TOKEN      ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['CLC$SPECIAL_CYBIL_NAME_IS_TOKEN', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['CNIT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
      ['CNT                            ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['ICIT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
      ['ISBT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['SCIT                           ', clc$abbreviation_entry, clc$normal_usage_entry, 7],
      ['SCNIT                          ', clc$abbreviation_entry, clc$normal_usage_entry, 5]]
      ]
    ,
    '()'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$text = 1,
      p$evaluation_options = 2,
      p$status = 3;

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

?? NEWTITLE := 'put_line', EJECT ??

    PROCEDURE [INLINE] put_line;

      clp$put_display (display_control, line (1, line_size), clc$trim, status);
      IF NOT status.normal THEN
        EXIT evaluate_token;
      IFEND;

    PROCEND put_line;
?? OLDTITLE, EJECT ??

    VAR
      token_kind_strings: [STATIC, READ, read_only] array [clt$lexical_token_kind] of ost$name :=
            ['clc$unknown_token', 'clc$end_of_line_token', 'clc$space_token', 'clc$comment_token',
            'clc$semicolon_token', 'clc$colon_token', 'clc$cybil_assign_token', 'clc$left_parenthesis_token',
            'clc$right_parenthesis_token', 'clc$comma_token', 'clc$ellipsis_token', 'clc$dot_token',
            'clc$query_token', 'clc$greater_than_token', 'clc$greater_equal_token', 'clc$less_than_token',
            'clc$less_equal_token', 'clc$equal_token', 'clc$not_equal_token', 'clc$concatenate_token',
            'clc$exponentiate_token', 'clc$multiply_token', 'clc$divide_token', 'clc$add_token',
            'clc$subtract_token', 'clc$left_bracket_token', 'clc$reverse_slant_token',
            'clc$right_bracket_token', 'clc$circumflex_token', 'clc$grave_accent_token',
            'clc$left_brace_token', 'clc$vertical_bar_token', 'clc$right_brace_token', 'clc$tilde_token',
            'clc$number_sign_token', 'clc$dollar_sign_token', 'clc$commercial_at_token',
            'clc$underscore_token', 'clc$name_token', 'clc$cybil_name_token', 'clc$special_cybil_name_token',
            'clc$simple_name_token', 'clc$cobol_name_token', 'clc$string_token', 'clc$unsigned_integer_token',
            'clc$signed_integer_token', 'clc$unsigned_real_token', 'clc$signed_real_token'];

    VAR
      line: string (132),
      line_size: integer,
      page_width: amt$page_width,
      evaluation_options: clt$token_evaluation_options,
      node: ^clt$data_value,
      spaces_preceded_token: boolean,
      str: ost$string,
      str_index: ost$string_index,
      text: ^clt$string_value,
      text_index: clt$string_index,
      token: clt$lexical_token;


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

    evaluation_options := $clt$token_evaluation_options [];
    node := pvt [p$evaluation_options].value;
    WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
      IF node^.element_value^.keyword_value = 'CLC$IGNORE_SPACES_BEFORE_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options
              [clc$ignore_spaces_before_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$COMMENT_IS_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options [clc$comment_is_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$CLASSIFY_NAME_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options [clc$classify_name_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$COBOL_NAME_IS_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options [clc$cobol_name_is_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$SPECIAL_CYBIL_NAME_IS_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options
              [clc$special_cybil_name_is_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$INTERNATIONAL_CHAR_IS_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options
              [clc$international_char_is_token];
      ELSEIF node^.element_value^.keyword_value = 'CLC$SPECIAL_CHAR_IS_TOKEN' THEN
        evaluation_options := evaluation_options + $clt$token_evaluation_options [clc$special_char_is_token];
      IFEND;
      node := node^.link;
    WHILEND;

    text := pvt [p$text].value^.string_value;
    text_index := 1;
    REPEAT
      clp$evaluate_token (text^, evaluation_options, text_index, spaces_preceded_token, token, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (line, line_size, 'INDEX =', text_index);
      put_line;
      STRINGREP (line, line_size, 'SPACES_PRECEDED_TOKEN = ', spaces_preceded_token);
      put_line;
      STRINGREP (line, line_size, 'TOKEN.TEXT_INDEX =', token.text_index);
      put_line;
      STRINGREP (line, line_size, 'TOKEN.TEXT_SIZE =', token.text_size);
      put_line;
      STRINGREP (line, line_size, 'TOKEN.DESCRIPTOR = ', token.descriptor);
      put_line;
      STRINGREP (line, line_size, 'TOKEN.KIND = ', token_kind_strings [token.kind]);
      put_line;
      CASE token.kind OF

      = clc$unknown_token .. clc$string_token =
        STRINGREP (line, line_size, 'TOKEN.STR.SIZE =', token.str.size);
        put_line;
        STRINGREP (line, line_size, 'TOKEN.STR.VALUE = ..');
        put_line;
        IF display_control.page_width <= STRLENGTH (line) THEN
          page_width := display_control.page_width;
        ELSE
          page_width := STRLENGTH (line);
        IFEND;
        str_index := 1;
        REPEAT
          line_size := token.str.size - str_index + 1;
          IF line_size > page_width THEN
            line_size := page_width;
          IFEND;
          line := token.str.value (str_index, line_size);
          put_line;
          str_index := str_index + line_size;
        UNTIL str_index > token.str.size;
        STRINGREP (line, line_size, 'TOKEN.STR_COMPLETE = ', token.str_complete);
        put_line;

      = clc$unsigned_integer_token, clc$signed_integer_token =
        clp$convert_integer_to_string (token.int.value, token.int.radix, token.int.radix_specified, str,
              status);
        IF status.normal THEN
          clp$put_display (display_control, str.value (1, str.size), clc$no_trim, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = clc$unsigned_real_token, clc$signed_real_token =
        clp$convert_real_to_string (token.rnum.value, token.rnum.number_of_digits, str, status);
        IF status.normal THEN
          clp$put_display (display_control, str.value (1, str.size), clc$no_trim, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      CASEND;
    UNTIL text_index > STRLENGTH (text^);

  PROCEND evaluate_token;
?? TITLE := 'get_job_parameters', EJECT ??

  PROCEDURE get_job_parameters
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE get_job_parameters, getjp (
{   file, f: file = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 4, 13, 49, 27, 99],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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


    VAR
      file: clt$file,
      job_system_label: jmt$job_system_label,
      login_command_in_file: boolean;


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

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

{--- The following call is commented out becuase clp$get_job_parameters is not #GATEd and therefore
{--- cannot be called from outside of task services.
{--- To make this testing command useful, the test utility can be run on a job template that has been
{--- modified to #GATE clp$get_job_parameters.
{
{   clp$get_job_parameters (#RING (^job_system_label), file.local_file_name, job_system_label,
{         login_command_in_file, status);
{
{--- Set a breakpoint here to in order to display the results.

    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND get_job_parameters;
?? TITLE := 'test_string_patterns', EJECT ??

  PROCEDURE test_string_patterns
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE test_string_patterns, test_string_pattern, tessp (
{   pattern, p: (wild_card_pattern) string = $required
{   subjects, subject, s: any of
{       list of string
{       list of name
{     anyend = $required
{   anchor_option, ao: (BY_NAME) boolean = yes
{   pattern_build_options, pattern_build_option, pbo: (BY_NAME) list 0..clc$max_list_size of key
{       (file_reference_pattern, frp)
{       (ignore_matched_substring, ims)
{       (match_at_left, mal)
{       (match_at_right, mar)
{     keyend = (ignore_matched_substring, match_at_right)
{   scan_option, so: (BY_NAME) key
{       (quick, q)
{       (full, f)
{     keyend = quick
{   wild_card_pattern_type, wcpt: (BY_NAME) key
{       (basic, b)
{       (extended, e)
{     keyend = extended
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 15] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        name: string (17),
        qualifier: clt$string_type_qualifier,
      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$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$string_type_qualifier,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$name_type_qualifier,
          recend,
        recend,
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (3),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 8] of clt$keyword_specification,
        recend,
        default_value: string (42),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (5),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (8),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 11, 2, 16, 14, 27, 697],
    clc$command, 15, 7, 2, 0, 0, 0, 7, ''], [
    ['ANCHOR_OPTION                  ',clc$nominal_entry, 3],
    ['AO                             ',clc$abbreviation_entry, 3],
    ['P                              ',clc$abbreviation_entry, 1],
    ['PATTERN                        ',clc$nominal_entry, 1],
    ['PATTERN_BUILD_OPTION           ',clc$alias_entry, 4],
    ['PATTERN_BUILD_OPTIONS          ',clc$nominal_entry, 4],
    ['PBO                            ',clc$abbreviation_entry, 4],
    ['S                              ',clc$abbreviation_entry, 2],
    ['SCAN_OPTION                    ',clc$nominal_entry, 5],
    ['SO                             ',clc$abbreviation_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['SUBJECT                        ',clc$alias_entry, 2],
    ['SUBJECTS                       ',clc$nominal_entry, 2],
    ['WCPT                           ',clc$abbreviation_entry, 6],
    ['WILD_CARD_PATTERN_TYPE         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 25, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 65, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 4
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 319,
  clc$optional_default_parameter, 0, 42],
{ PARAMETER 5
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 5],
{ PARAMETER 6
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 7
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 17, clc$string_type], 'WILD_CARD_PATTERN', [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$list_type],
    FALSE, 2],
    24, [[1, 0, clc$list_type], [8, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]
      ],
    21, [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$name_type], [1, osc$max_name_size]]
      ]
    ],
{ PARAMETER 3
    [[1, 0, clc$boolean_type],
    'yes'],
{ PARAMETER 4
    [[1, 0, clc$list_type], [303, 0, clc$max_list_size, FALSE],
      [[1, 0, clc$keyword_type], [8], [
      ['FILE_REFERENCE_PATTERN         ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['FRP                            ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['IGNORE_MATCHED_SUBSTRING       ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['IMS                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['MAL                            ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['MAR                            ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
      ['MATCH_AT_LEFT                  ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['MATCH_AT_RIGHT                 ', clc$nominal_entry, clc$normal_usage_entry, 4]]
      ]
    ,
    '(ignore_matched_substring, match_at_right)'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [4], [
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['Q                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['QUICK                          ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'quick'],
{ PARAMETER 6
    [[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]]
    ,
    'extended'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$pattern = 1,
      p$subjects = 2,
      p$anchor_option = 3,
      p$pattern_build_options = 4,
      p$scan_option = 5,
      p$wild_card_pattern_type = 6,
      p$status = 7;

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

    VAR
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      pattern: ^clt$string_pattern,
      anchor_option: clt$string_pattern_anchor_opt,
      pattern_build_options: clt$string_pattern_build_opts,
      scan_option: clt$string_pattern_scan_option,
      subject: ^clt$string_value,
      summary: string (256),
      summary_size: integer,
      wild_card_pattern_type: clt$wild_card_pattern_type;


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

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

    pattern_build_options := $clt$string_pattern_build_opts [];
    node := pvt [p$pattern_build_options].value;
    WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
      IF node^.element_value^.keyword_value = 'FILE_REFERENCE_PATTERN' THEN
        pattern_build_options := pattern_build_options + $clt$string_pattern_build_opts
              [clc$sp_file_reference_pattern];
      ELSEIF node^.element_value^.keyword_value = 'IGNORE_MATCHED_SUBSTRING' THEN
        pattern_build_options := pattern_build_options + $clt$string_pattern_build_opts
              [clc$sp_ignore_matched_substring];
      ELSEIF node^.element_value^.keyword_value = 'MATCH_AT_LEFT' THEN
        pattern_build_options := pattern_build_options + $clt$string_pattern_build_opts
              [clc$sp_match_at_left];
      ELSE {MATCH_AT_RIGHT}
        pattern_build_options := pattern_build_options + $clt$string_pattern_build_opts
              [clc$sp_match_at_right];
      IFEND;
      node := node^.link;
    WHILEND;

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

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

    RESET work_area;

    clp$build_pattern_for_wild_card (wild_card_pattern_type, pattern_build_options,
          pvt [p$pattern].value^.string_value^, work_area, pattern, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    node := pvt [p$subjects].value;
    WHILE node <> NIL DO
      IF node^.element_value^.kind = clc$string THEN
        subject := node^.element_value^.string_value;
      ELSE
        subject := ^node^.element_value^.name_value (1, clp$trimmed_string_size
              (node^.element_value^.name_value));
      IFEND;

      clp$match_string_pattern (subject^, pattern, anchor_option, scan_option, match_info, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF match_info.result = clc$sp_success THEN
        STRINGREP (summary, summary_size, ' Match SUCCEEDED for ''', subject^, ''' -- index:',
              match_info.index, ', size:', match_info.size);
      ELSE
        STRINGREP (summary, summary_size, ' Match FAILED    for ''', subject^, '''');
      IFEND;
      clp$put_display (display_control, summary (1, summary_size), clc$no_trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      node := node^.link;
    WHILEND;

  PROCEND test_string_patterns;
?? TITLE := 'display_string_pattern', EJECT ??

  PROCEDURE display_string_pattern
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE display_string_pattern, dissp (
{   string_pattern, sp: string_pattern = $required
{   output, o: file = $output
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 1, 20, 17, 40, 22, 258],
    clc$command, 5, 3, 1, 0, 0, 0, 3, ''], [
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['SP                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['STRING_PATTERN                 ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_pattern_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$string_pattern = 1,
      p$output = 2,
      p$status = 3;

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

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    ignore_condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      IF output_open THEN
        clp$close_display (display_control, handler_status);
        output_open := FALSE;
      IFEND;
      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      output_open: boolean,
      string_ptr: ^clt$string_value;


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

    RESET work_area;

    output_open := FALSE;
    osp$establish_block_exit_hndlr (^abort_handler);

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);
    clp$open_display_reference (pvt [p$output].value^.file_value^, NIL, fsc$list, default_ring_attributes,
          display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    output_open := TRUE;

    clp$sp_convert_to_string (pvt [p$string_pattern].value^.string_pattern_value, work_area, string_ptr,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$put_display (display_control, string_ptr^, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$close_display (display_control, status);
    output_open := FALSE;

    osp$disestablish_cond_handler;

  PROCEND display_string_pattern;

MODEND clm$test_utility;
