?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter: String Pattern Procedures' ??
MODULE clm$string_pattern_handlers;

{
{ PURPOSE:
{
{   This module contains the procedures that build string patterns and use them
{   to perform matching operations on strings.
{
{   A string pattern is a data structure that drives the string matching
{   process and is contained within a CLT$STRING_PATTERN sequence.  It
{   represents a pattern of characters which can be as simple as "any 3
{   characters" or "the string 'abc'", or can be very complex.
{
{   The matching process consists of attempting to find a sequence of
{   characters in a SUBJECT string that are MATCHed by the PATTERN.  The RESULT
{   of this process may be FAILURE, i.e.  the pattern could not be found in the
{   subject, or it may be SUCCESS, in which case the INDEX and SIZE of the
{   substring of the subject that matched the pattern are made available.
{
{   A string pattern is composed of any number of PATTERN ELEMENTS.  These
{   elements can be combined in essentially 2 ways:  concatenation and
{   alternation.  When two pattern elements are concatenated, a match for the
{   first must be found in the subject string immediately followed by a match
{   for the second.  The second of the two elements is said to be the SUCCESSOR
{   to the first.
{
{   When two pattern elements are combined via alternation, a match for either
{   the first or the second must be found in the subject string.  The second
{   such element is said to be the ALTERNATIVE to the first.
{
{   Thus, each pattern element has two linkages, one to its successor, and one
{   to its alternative.  Either or both of these linkages may be absent, i.e.
{   an element may have a successor but no alternative, or an alternative but
{   no successor.  An element with no successor is a TERMINAL element or NODE
{   of the pattern.
{
{   The goal of the pattern matching process is to find a sequence of elements
{   within a pattern that match a substring within the subject string.
{
{
{ DESIGN:
{
{   The algorithms and techniques used in this module are derived from those
{   used in the programming language SNOBOL4.  They have been adapted to take
{   advantage of the facilities provided in a modern implementation language,
{   i.e.  CYBIL.  In particular, heavy use is made of the CYBIL run-time stack
{   whereas the original algorithm needed to maintain its own stacks.  This has
{   the effect of simplifying the algorithm considerably, at the expense of
{   increasing its subtlety.
{
{   There are two major steps involved in the use of string patterns.  The
{   first is to build the pattern, either from some form of description of what
{   kinds of strings should be matched, or by combining existing patterns.  The
{   second step is to utilize the pattern to scan a subject string for a match.
{
{   The scanning step iterates through pattern elements following successor
{   links, advancing the subject index past the characters that matched the
{   element, until an element fails to match or a terminal element is reached.
{   In the latter case success is declared.  If an element fails to match, the
{   process backs up until an alternative is found, the subject index is reset
{   to the point where the current element originally matched, then scanning
{   continues by iterating through the alternative and its successors.  When no
{   more alternatives exists, failure is declared.
{
{   During this scanning process, when a point is reached that may require
{   alternatives to be tried, the scanner calls itself recursively in order to
{   make use of the run-time stack to keep track of sufficient information to
{   reset the scan.
{
{   Structurally, the scanning (matching) process consists of a controlling
{   procedure that follows successor links and tries alternatives.  This
{   controlling procedure calls specialized procedures to deal with individual
{   pattern elements, one procedure for each kind of element.  In general the
{   element processors are independent of one another and their only
{   interaction with the controlling procedure is to return success or failure
{   and update the subject index when they succeed.
{
{   However, there are some kinds of elements that are more complex.  Some work
{   in pairs, for example the pattern elements that deal with capturing a piece
{   of the subject during a match (see below).  Some have built-in
{   alternatives, for example the pattern element that matches multiple
{   characters in a row--each time the scan backs up to try an alternative, it
{   increases the number of characters it matches.
{
{   The pattern building process stores extra information in the representation
{   of the pattern to make the matching (scanning) process as efficient as
{   possible.  This causes the building process to be more costly than it would
{   otherwise be.  It is a trade-off based on the idea that a pattern will be
{   used more than once, thereby offsetting the extra cost to build it.  This
{   extra information consists of two pieces of data in each pattern element:
{   1) the minimum number of characters remaining in the subject that are
{   required in order for a match of the current element and all of its
{   successors to be successful, and 2) the minimum number of characters
{   remaining in the subject that are required to match any of the alternatives
{   of the current element along with their corresponding successors.
{
{   This minimum size information is used when the scan backs up to an element
{   to try alternatives after a failure.  If the element is one that advances
{   the subject index and retries its successor, the size information can be
{   used to avoid attempting matches that are doomed to failure.
{
{   An element may fail to match at the current subject index for one of two
{   REASONs:  there are not a sufficient number of characters remaining in the
{   subject for a match to have a chance of success (SIZE FAILure), or the
{   element doesn't correspond to the characters in the subject at that
{   position (MATCH FAILure).  Retrying a match by advancing the subject index
{   after a size failure is (usually) a waste of time.
{
{   Patterns which are recursively defined can be represented using the
{   UNEVALUATED PATTERN element.  A relatively common example of a recursive
{   pattern is one that could match the arithmetic expression of a programming
{   language, since such expressions can have sub-expressions enclosed in
{   parentheses.
{
{   The pattern matching process is not, however, restricted to just looking at
{   a subject string.  With appropriate pattern elements, substrings of the
{   subject that match parts of the pattern can be captured for later use.  The
{   capture can be done either once the entire pattern has been successfully
{   matched, or immediately upon matching the appropriate part of the pattern.
{   The ability to immediately capture part of the subject just matched makes
{   possible some very sophisticated matching.  For example the captured
{   substring could be referred to within an unevaluated pattern.  This
{   provides the capability to match patterns such as:  "pattern A" followed by
{   "pattern B" followed by whatever "pattern A" matched to the left of
{   "pattern B".
{
{   The immediate capture capability in combination with unevaluated patterns
{   is very powerful but requires refining the size information heuristics
{   described above.  If a size failure occurs at or following an unevaluated
{   pattern element, this should be treated the same way as an ordinary size
{   failure unless an immediate capture pattern element is backed into.  When
{   that occurs the size failure should be turned into a match failure, since
{   if in trying alternatives, something different is captured, it may affect
{   what is matched by the subsequent unevaluated pattern, which in turn may
{   yield overall success.
{
{   Attempted matches with some kinds of patterns won't have the intended
{   results if the size information is used during the matching process.  For
{   this reason an option is provided that "shuts off" those checks.  This
{   "full scan" option should only be used when necessary since it can
{   dramatically slow down pattern matching.  The "quick scan" option should
{   normally be used.
{
{   For more details of the pattern building and matching processes see the
{   procedures that implement them.
{
{   How a pattern is represented is private to this module, i.e.  the data
{   structures which describe it are known only within this module.  Outside
{   this module a pattern is simply a CYBIL sequence (CLT$STRING_PATTERN).  The
{   first thing within that sequence is a CLT$STRING_PATTERN_HEADER record
{   which allows the INITIAL_ELEMENT of the pattern to be located.  (The header
{   also contains a VERSION stamp to accommodate future changes that may be
{   binary incompatible.)  The element linkages within the sequence are via
{   relative pointers (CLT$STRING_PATTERN_ELEMENT_LINK).
{
{   There are a number of fields common to all pattern elements
{   (CLT$STRING_PATTERN_ELEMENT).  These are:
{
{   SUCCESSOR:  A link to the successor of this element (NIL if none).
{
{   ALTERNATIVE:  A link to the alternative of this element (NIL if none).
{
{   MIN_SUBJECT_SIZE:  The minimum number of characters that must remain in the
{         subject in order to match this element and all of its successors.
{
{   ALTERNATIVE_MIN_SUBJECT_SIZE:  The minimum number of characters that must
{         remain in the subject in order to match any of this element's
{         alternatives and their corresponding successors.
{
{   COUNT:  The use of this field is dependent on the kind of element.  See the
{         description for each element kind.
{
{   EXTRA_INFO_SIZE:  This field is only used during building a pattern.  It
{         specifies the number of cells occupied by the "extra information'
{         associated with a pattern element.  This information is normally
{         accessed via a relative pointer within the element, but always
{         immediately follows the element itself.  This field is used when
{         sequentially accessing a pattern's elements and provides a
{         convenient means to get to the start of the next element.
{
{   KIND:  The kind of pattern element.
{
{   The individual pattern elements and what they match are described below.
{   For those elements that use the COUNT field, the descriptions indicate its
{   meaning.
{
{   CLC$SP_BALANCED_PAIR:  This element matches any non-null string that is
{         balanced with respect to a pair of characters, usually parentheses,
{         identified by the LEFT_CHARACTER and RIGHT_CHARACTER fields.
{
{   CLC$SP_CAPTURE_BEGIN:  This element works in conjunction with a
{         CLC$SP_CAPTURE_END element to make possible "capturing" part of the
{         subject string during a match.  By itself it matches a null string.
{         The CAPTURE_END_ELEMENT field is a link to the corresponding
{         CLC$SP_CAPTURE_END element and is used by the latter to synchronize
{         its activities with this element.
{
{   CLC$SP_CAPTURE_INDEX:  This element is used to capture the current value
{         of the subject index.  It matches the null string.  The
{         IMMEDIATE_CAPTURE field is ignored.  CLC$SP_CAPTURE_VIA_PROCEDURE
{         passes the subject index, as a string, to the CYBIL procedure pointed
{         to by the CAPTURE_PROCEDURE field.  CLC$SP_CAPTURE_VIA_VARIABLE
{         writes the subject index to an SCL integer variable referred to via
{         the CAPTURE_VARIABLE field.  CLC$SP_CAPTURE_VIA_COMMAND passes the
{         subject index, as a string, to an SCL command referred to via the
{         CAPTURE_COMMAND field.
{
{   CLC$SP_CAPTURE_END:  This element works in conjunction with a
{         CLC$SP_CAPTURE_BEGIN element and does most of the work for capturing
{         matched substrings.  By itself it matches a null string.  The
{         IMMEDIATE_CAPTURE field indicates whether the capture should occur
{         immediately upon reaching this element, or conditionally once the
{         entire pattern has been successfully matched.  The latter is
{         accomplished by the processor for this element delaying the capture
{         until it is backed into with a match result of success.  The
{         CAPTURE_KIND field determines the means by which the matched
{         substring is captured.  CLC$SP_CAPTURE_VIA_PROCEDURE passes the
{         matched substring to the CYBIL procedure pointed to by the
{         CAPTURE_PROCEDURE field.  CLC$SP_CAPTURE_VIA_VARIABLE writes the
{         matched substring to an SCL variable referred to via the
{         CAPTURE_VARIABLE field.  CLC$SP_CAPTURE_VIA_COMMAND passes the
{         matched substring to an SCL command referred to via the
{         CAPTURE_COMMAND field.
{
{   CLC$SP_CHARACTERS:  This element matches COUNT or more of the characters
{         contained in the CHARACTERS set.  (In order to take advantage of the
{         #SCAN procedure of CYBIL, the inverse of the set is actually stored
{         in this pattern element.)
{
{   CLC$SP_COUNT:  This element matches exactly COUNT characters.  Any
{         character contained in the CHARACTERS set is not matched by this
{         element.
{
{   CLC$SP_COUNT_TEST_LEFT:  This element matches the null string if there are
{         exactly COUNT characters to the left of the subject index.  This is
{         most frequently used with a COUNT of zero in order to force its
{         successor to be matched at the left end of the subject.
{
{   CLC$SP_COUNT_TEST_RIGHT:  This element matches the null string if there are
{         exactly COUNT characters to the right of the subject index.  This is
{         most frequently used with a COUNT of zero in order to force its
{         predecessor to be matched at the right end of the subject.
{
{   CLC$SP_FAIL_ELEMENT:  This element always fails to match, causing the
{         scanning process to back up and seek alternatives, i.e. it provides
{         a way to build a structure that does NOT match the pattern to which
{         this element is a successor.
{
{   CLC$SP_FAIL_PATTERN:  This element causes immediate failure termination of
{         the entire matching process.
{
{   CLC$SP_FENCE:  This element matches the null string.  If it is backed into
{         with failure it causes immediate failure termination of the entire
{         matching process.  It can be used to avoid trying alternatives that
{         can't possibly match.  For example consider the pattern "a" or "the"
{         followed by " mousetrap", applied to the subject string "a fleatrap".
{         The first alternative ("a") matches but its successor fails.  There
{         is no point in trying the second alternative, since "the" can't
{         possibly match what "a" matched.  Inserting a CLC$SP_FENCE element
{         after the "a" or "the" alternation pattern avoids attempting the
{         fruitless alternative.
{
{   CLC$SP_MULTIPLE:  This element matches COUNT or more characters.  Any
{         character contained in the CHARACTERS set is not matched by this
{         element.
{
{   CLC$SP_MULTIPLE_PATH_ELEMENTS:  This element is used to represent the
{         special file reference path element $ALL when building a pattern
{         to match an entire file reference.
{
{   CLC$SP_ONE_CHARACTER:  This element matches exactly one of the characters
{         contained in the CHARACTERS set.
{
{   CLC$SP_REPEAT_PATTERN_BEGIN:  This element works in conjunction with a
{         CLC$SP_REPEAT_PATTERN_END element.  They bracket a sub-pattern that
{         must be found at least COUNT times.  By itself this element matches
{         the null string.
{
{   CLC$SP_REPEAT_PATTERN_END:  This element works in conjunction with a
{         CLC$SP_REPEAT_PATTERN_BEGIN element.  They bracket a sub-pattern that
{         must be found at least COUNT times.  By itself this element matches
{         the null string.
{
{   CLC$SP_STRING_LITERAL:  This element matches the string of characters
{         referred to via the STRING_LITERAL field.  If CASE_SENSITIVE is FALSE
{         lower case characters are, in effect, folded to their upper case
{         counterparts prior to attempting the match.  The folding is done
{         according to the SCL option FOLDING_LEVEL.
{
{   CLC$SP_SUCCEED_FORCED:  This element matches the null string.  If it is
{         backed into, it succeeds again, i.e.  it can be thought of as being
{         its own alternative.  Its usefulness is limited but, in combination
{         with immediate capture, the CLC$SP_FAIL_ELEMENT element and the "full
{         scan" option, interesting results can be produced.
{
{   CLC$SP_SUCCEED_PASSIVE:  This element matches the null string.  It is
{         usually employed as a "null node" in a complex pattern, for example a
{         pattern involving nested alternation.
{
{   CLC$SP_TEST:  This element tests the value of the boolean expression
{         referred to via the TEST_EXPRESSION field.  If the result of the
{         expression is TRUE, this element matches the null string.  If the
{         result is FALSE or the expression cannot be evaluated, this element
{         fails.
{
{   CLC$SP_UNEVALUATED_PATTERN:  This element matches the sub-pattern referred
{         to via the UNEVALUATED_PATTERN field, which is in the form of a
{         string pattern expression.  The processor for this element evaluates
{         the expression, i.e.  builds the sub-pattern, then tries to match it.
{
{   CLC$SP_UPTO_CHARACTER:  This element matches up to but not including one of
{         the characters contained in the CHARACTERS set.
{
{   CLC$SP_UPTO_COUNT_LEFT:  This element matches up to and including the
{         COUNT'th character from the left end of the subject.
{
{   CLC$SP_UPTO_COUNT_RIGHT:  This element matches up to and including the
{         COUNT'th character from the right end of the subject.  This is most
{         frequently used with a COUNT of zero in order to match the rest of
{         the subject.
{

?? NEWTITLE := 'Global Declarations' ??
?? NEWTITLE := 'String Pattern Declarations', EJECT ??

{
{ The following string pattern related types are known outside of this module.
{

*copyc clt$string_pattern
*copyc clt$string_pattern_anchor_opt
*copyc clt$string_pattern_build_opts
*copyc clt$string_pattern_match_info
*copyc clt$string_pattern_scan_option
*copyc clt$string_pattern_size
?? SKIP := 6 ??

{
{ The following types are needed for string pattern elements.
{

*copyc clt$command_line
*copyc clt$expression_text
*copyc clt$string_index
*copyc clt$string_size
*copyc clt$string_value
*copyc clt$variable_ref_expression
?? SKIP := 6 ??

{
{ The following string pattern types are known only within this module.
{

  CONST
    clc$string_pattern_version = 1;

  TYPE
    clt$string_pattern_capture = record
      immediate: boolean,
      case kind: clt$string_pattern_capture_kind of
      = clc$sp_capture_via_command =
        command: ^clt$command_line,
      = clc$sp_capture_via_procedure =
        proc: clt$string_pattern_capture_proc,
      = clc$sp_capture_via_variable =
        variable: ^clt$variable_ref_expression,
      casend,
    recend;

  TYPE
    clt$string_pattern_capture_kind = (clc$sp_capture_via_command, clc$sp_capture_via_variable,
          clc$sp_capture_via_procedure);

  TYPE
    clt$string_pattern_capture_proc = ^procedure
           (    matched_string: ^clt$string_value;
            VAR status: ost$status);

  TYPE
    clt$string_pattern_characters = set of char;

  TYPE
    clt$string_pattern_element = record
      successor: clt$string_pattern_element_link,
      alternative: clt$string_pattern_element_link,
      min_subject_size: clt$string_size,
      alternative_min_subject_size: clt$string_size,
      count: clt$string_size,
      extra_info_size: clt$string_size {used only during pattern building} ,
      case kind: clt$string_pattern_element_kind of
      = clc$sp_balanced_pair =
        left_character: char,
        right_character: char,
      = clc$sp_capture_begin =
        capture_end_element: clt$string_pattern_element_link,
      = clc$sp_capture_end, clc$sp_capture_index =
        immediate_capture: boolean,
        case capture_kind: clt$string_pattern_capture_kind of
        = clc$sp_capture_via_command =
          capture_command: REL (clt$string_pattern) ^clt$command_line,
        = clc$sp_capture_via_procedure =
          capture_procedure: clt$string_pattern_capture_proc,
        = clc$sp_capture_via_variable =
          capture_variable: REL (clt$string_pattern) ^clt$variable_ref_expression,
        casend,
      = clc$sp_characters, clc$sp_count, clc$sp_multiple, clc$sp_one_character, clc$sp_upto_character =
        characters: REL (clt$string_pattern) ^clt$string_pattern_characters,

{ the clc$sp_characters and clc$sp_multiple pattern elements use the count field as a minimum count
{ the clc$sp_count pattern element uses the count field as an exact count

      = clc$sp_count_test_left, clc$sp_count_test_right, clc$sp_upto_count_from_left,
            clc$sp_upto_count_from_right =
        { these pattern elements use the count field as an exact count } ,
      = clc$sp_fail_element, clc$sp_fail_pattern, clc$sp_fence, clc$sp_multiple_path_elements,
            clc$sp_succeed_forced, clc$sp_succeed_passive =
        ,
      = clc$sp_repeat_pattern_begin, clc$sp_repeat_pattern_end =
        { these pattern elements use the count field as a minimum count } ,
      = clc$sp_string_literal =
        case_sensitive: boolean,
        string_literal: REL (clt$string_pattern) ^clt$string_value,
      = clc$sp_test =
        test_expression: REL (clt$string_pattern) ^clt$expression_text,
      = clc$sp_unevaluated_pattern =
        unevaluated_pattern: REL (clt$string_pattern) ^clt$expression_text,
      casend,
    recend;

  TYPE
    clt$string_pattern_element_kind = (clc$sp_balanced_pair, clc$sp_capture_begin, clc$sp_capture_end,
          clc$sp_capture_index, clc$sp_characters, clc$sp_count, clc$sp_count_test_left,
          clc$sp_count_test_right, clc$sp_fail_element, clc$sp_fail_pattern, clc$sp_fence, clc$sp_multiple,
          clc$sp_multiple_path_elements, clc$sp_one_character, clc$sp_repeat_pattern_begin,
          clc$sp_repeat_pattern_end, clc$sp_string_literal, clc$sp_succeed_forced, clc$sp_succeed_passive,
          clc$sp_test, clc$sp_unevaluated_pattern, clc$sp_upto_character, clc$sp_upto_count_from_left,
          clc$sp_upto_count_from_right);

  TYPE
    clt$string_pattern_element_link = REL (clt$string_pattern) ^clt$string_pattern_element;

  TYPE
    clt$string_pattern_fail_reason = (clc$sp_fail_size, clc$sp_fail_match, clc$sp_fail_unevaluated,
          clc$sp_fail_immediate_capture);

  TYPE
    clt$string_pattern_header = record
      version: 0 .. 255,
      number_of_elements: clt$string_size,
      initial_element: clt$string_pattern_element_link,
    recend;

?? SKIP := 6 ??

{
{ Constants for wild card characters.
{

  CONST
    clc$wc_alternation_begin = '{',
    clc$wc_alternation_end = '}',
    clc$wc_alternation_separator = '|',
    clc$wc_count_1 = '?',
    clc$wc_multiple = '*',
    clc$wc_path_element_separator = '.',
    clc$wc_quote = '''',
    clc$wc_set_begin = '[',
    clc$wc_set_complement = '^',
    clc$wc_set_end = ']',
    clc$wc_set_range = '-';

?? OLDTITLE, EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$bad_string_pattern
*copyc cle$bad_wild_card_pattern
*copyc cle$string_too_long
*copyc cle$work_area_overflow
*copyc clt$data_value
*copyc clt$parameter_list
*copyc clt$wild_card_pattern_type
*copyc clt$work_area
*IF $true(osv$unix)
*copyc cyt$mips_signal_handler
*ELSE
*copyc osd$virtual_address
*IFEND
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*IF NOT $true(osv$unix)
*copyc clp$change_variable
*IFEND
*copyc clp$convert_char_to_graphic
*copyc clp$convert_integer_to_string
*IF NOT $true(osv$unix)
*copyc clp$create_procedure_variable
*IFEND
*copyc clp$evaluate_expression
*copyc clp$evaluate_parameters
*copyc clp$get_work_area
*IF NOT $true(osv$unix)
*copyc clp$include_line
*IFEND
*copyc clp$make_boolean_value
*copyc clp$make_integer_value
*copyc clp$make_record_value
*copyc clp$make_string_pattern_value
*copyc clp$make_value
*copyc clv$non_graphic
*IF NOT $true(osv$unix)
*copyc i#compare_collated
*IFEND
*copyc i#current_sequence_position
*IF NOT $true(osv$unix)
*copyc osp$establish_block_exit_hndlr
*copyc osp$establish_condition_handler
*copyc osp$disestablish_cond_handler
*IFEND
*copyc osp$set_status_condition
*copyc osv$lower_to_upper
*copyc osv$upper_to_lower
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
*IFEND

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

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

{ FUNCTION (osm$$match) $match (
{   subject: 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$string_type_qualifier,
      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, 1, 11, 18, 13, 28, 158],
    clc$function, 4, 4, 2, 1, 0, 0, 0, 'OSM$$MATCH'], [
    ['ANCHOR_OPTION                  ',clc$nominal_entry, 3],
    ['PATTERN                        ',clc$nominal_entry, 2],
    ['SCAN_OPTION                    ',clc$nominal_entry, 4],
    ['SUBJECT                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [4, 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, 8, 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, 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
    [3, 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$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$subject = 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,
      match_info: clt$string_pattern_match_info,
      node: ^clt$data_value,
      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$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;

    clp$match_string_pattern (pvt [p$subject].value^.string_value^,
          pvt [p$pattern].value^.string_pattern_value, anchor_option, scan_option, match_info, status);

    clp$make_record_value (3, work_area, result);

    result^.field_values^ [1].name := 'MATCHED';
    clp$make_boolean_value (status.normal AND (match_info.result = clc$sp_success), clc$yes_no_boolean,
          work_area, result^.field_values^ [1].value);

    result^.field_values^ [2].name := 'INDEX';
    clp$make_integer_value (1, 10, FALSE, work_area, result^.field_values^ [2].value);
    IF match_info.result = clc$sp_success THEN
      result^.field_values^ [2].value^.integer_value.value := match_info.index;
    IFEND;

    result^.field_values^ [3].name := 'SIZE';
    clp$make_integer_value (0, 10, FALSE, work_area, result^.field_values^ [3].value);
    IF match_info.result = clc$sp_success THEN
      result^.field_values^ [3].value^.integer_value.value := match_info.size;
    IFEND;

  PROCEND clp$$match;
?? TITLE := 'clp$$sp_any', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_any) $sp_any (
{   characters: list rest of any of
{       string
{       range of string 1
{     anyend = $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,
        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$string_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$string_type_qualifier,
            recend,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 1, 17, 9, 3, 18, 767],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$SP_ANY'], [
    ['CHARACTERS                     ',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, 59, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [43, 1, clc$max_list_size, TRUE],
      [[1, 0, clc$union_type], [[clc$range_type, clc$string_type],
      FALSE, 2],
      8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
      15, [[1, 0, clc$range_type], [8],
          [[1, 0, clc$string_type], [1, 1, FALSE]]
        ]
      ]
    ]];

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

    CONST
      p$characters = 1;

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

    VAR
      characters: clt$string_pattern_characters;


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

    build_character_set (pvt [p$characters].value, characters);

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_one_character (characters, work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_any;
?? TITLE := 'clp$$sp_balance', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_balance) $sp_balance (
{   left_character: string 1 = '('
{   right_character: string 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$string_type_qualifier,
        default_value: string (3),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
    recend := [
    [1,
    [89, 9, 29, 15, 57, 41, 325],
    clc$function, 2, 2, 0, 0, 0, 0, 0, 'OSM$$SP_BALANCE'], [
    ['LEFT_CHARACTER                 ',clc$nominal_entry, 1],
    ['RIGHT_CHARACTER                ',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, 8,
  clc$optional_default_parameter, 0, 3],
{ 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, 8,
  clc$optional_default_parameter, 0, 3]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [1, 1, FALSE],
    '''('''],
{ PARAMETER 2
    [[1, 0, clc$string_type], [1, 1, FALSE],
    ''')''']];

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

    CONST
      p$left_character = 1,
      p$right_character = 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_value (clc$string_pattern, work_area, result);

    clp$sp_balanced_pair (pvt [p$left_character].value^.string_value^ (1),
          pvt [p$right_character].value^.string_value^ (1), work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_balance;
?? TITLE := 'clp$$sp_capture', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_capture) $sp_capture (
{   pattern: string_pattern = $required
{   when: key
{       (conditional, c)
{       (unconditional, immediate, i, u)
{     keyend = $required
{   where: string = $required
{   how: key
{       (variable, v)
{       (command, c)
{     keyend = variable
{   )

?? 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,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      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 (8),
      recend,
    recend := [
    [1,
    [89, 9, 22, 16, 57, 38, 778],
    clc$function, 4, 4, 3, 0, 0, 0, 0, 'OSM$$SP_CAPTURE'], [
    ['HOW                            ',clc$nominal_entry, 4],
    ['PATTERN                        ',clc$nominal_entry, 1],
    ['WHEN                           ',clc$nominal_entry, 2],
    ['WHERE                          ',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, 3, 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, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [4, 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, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 4
    [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, 8]],
{ PARAMETER 1
    [[1, 0, clc$string_pattern_type]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [6], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['CONDITIONAL                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['I                              ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['IMMEDIATE                      ', clc$alias_entry, clc$normal_usage_entry, 2],
    ['U                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['UNCONDITIONAL                  ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [4], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['COMMAND                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['V                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['VARIABLE                       ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'variable']];

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

    CONST
      p$pattern = 1,
      p$when = 2,
      p$where = 3,
      p$how = 4;

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

    VAR
      capture: clt$string_pattern_capture;


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

    capture.immediate := pvt [p$when].value^.keyword_value = 'UNCONDITIONAL';
    IF pvt [p$how].value^.keyword_value = 'VARIABLE' THEN
      capture.kind := clc$sp_capture_via_variable;
      capture.variable := pvt [p$where].value^.string_value;
    ELSE {COMMAND}
      capture.kind := clc$sp_capture_via_command;
      capture.command := pvt [p$where].value^.string_value;
    IFEND;

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_capture_substring (pvt [p$pattern].value^.string_pattern_value, capture, work_area,
          result^.string_pattern_value, status);

  PROCEND clp$$sp_capture;
?? TITLE := 'clp$$sp_count', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_count) $sp_count (
{   count: integer 0..clc$max_string_size = $required
{   not_any: list rest of any of
{       string
{       range of string 1
{     anyend = $optional
{   )

?? 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$list_type_qualifier,
        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$string_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$string_type_qualifier,
            recend,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 1, 17, 14, 57, 6, 417],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_COUNT'], [
    ['COUNT                          ',clc$nominal_entry, 1],
    ['NOT_ANY                        ',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, 59, clc$optional_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [43, 1, clc$max_list_size, TRUE],
      [[1, 0, clc$union_type], [[clc$range_type, clc$string_type],
      FALSE, 2],
      8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
      15, [[1, 0, clc$range_type], [8],
          [[1, 0, clc$string_type], [1, 1, FALSE]]
        ]
      ]
    ]];

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

    CONST
      p$count = 1,
      p$not_any = 2;

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

    VAR
      excluded_characters: clt$string_pattern_characters;


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

    IF pvt [p$not_any].specified THEN
      build_character_set (pvt [p$not_any].value, excluded_characters);
    ELSE
      excluded_characters := $clt$string_pattern_characters [];
    IFEND;

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_count (excluded_characters, pvt [p$count].value^.integer_value.value, work_area,
          result^.string_pattern_value, status);

  PROCEND clp$$sp_count;
?? TITLE := 'clp$$sp_defer', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_defer) $sp_defer (
{   pattern: (DEFER) string_pattern = $required
{   minimum_match_size: integer 0..clc$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,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 9, 29, 16, 6, 7, 345],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_DEFER'], [
    ['MINIMUM_MATCH_SIZE             ',clc$nominal_entry, 2],
    ['PATTERN                        ',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$deferred_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$string_pattern_type]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10],
    '1']];

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

    CONST
      p$pattern = 1,
      p$minimum_match_size = 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_value (clc$string_pattern, work_area, result);

    clp$sp_unevaluated_pattern (pvt [p$pattern].value^.deferred_value,
          pvt [p$minimum_match_size].value^.integer_value.value, work_area, result^.string_pattern_value,
          status);

  PROCEND clp$$sp_defer;
?? TITLE := 'clp$$sp_fail', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_fail) $sp_fail

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 9, 29, 16, 7, 0, 11],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SP_FAIL']];

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

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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_fail_element (work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_fail;
?? TITLE := 'clp$$sp_fence', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_fence) $sp_fence

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 9, 22, 18, 1, 24, 196],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SP_FENCE']];

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

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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_fence (work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_fence;
?? TITLE := 'clp$$sp_left', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_left) $sp_left (
{   count: integer 0..clc$max_string_size = 0
{   )

?? 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,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 9, 29, 16, 1, 10, 633],
    clc$function, 1, 1, 0, 0, 0, 0, 0, 'OSM$$SP_LEFT'], [
    ['COUNT                          ',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$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10],
    '0']];

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

    CONST
      p$count = 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_value (clc$string_pattern, work_area, result);

    clp$sp_count_test_left (pvt [p$count].value^.integer_value.value, work_area, result^.string_pattern_value,
          status);

  PROCEND clp$$sp_left;
?? TITLE := 'clp$$sp_index', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_index) $sp_index (
{   where: string = $required
{   how: key
{       (variable, v)
{       (command, c)
{     keyend = variable
{   )

?? 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$string_type_qualifier,
      recend,
      type2: 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,
    recend := [
    [1,
    [90, 1, 20, 16, 28, 41, 449],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_INDEX'], [
    ['HOW                            ',clc$nominal_entry, 2],
    ['WHERE                          ',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, 8, 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, 155,
  clc$optional_default_parameter, 0, 8]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [4], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['COMMAND                        ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['V                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['VARIABLE                       ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'variable']];

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

    CONST
      p$where = 1,
      p$how = 2;

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

    VAR
      capture: clt$string_pattern_capture;


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

    capture.immediate := TRUE;
    IF pvt [p$how].value^.keyword_value = 'VARIABLE' THEN
      capture.kind := clc$sp_capture_via_variable;
      capture.variable := pvt [p$where].value^.string_value;
    ELSE {COMMAND}
      capture.kind := clc$sp_capture_via_command;
      capture.command := pvt [p$where].value^.string_value;
    IFEND;

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_capture_index (capture, work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_index;
?? TITLE := 'clp$$sp_not_any', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_not_any) $sp_not_any (
{   characters: list rest of any of
{       string
{       range of string 1
{     anyend = $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,
        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$string_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$string_type_qualifier,
            recend,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 1, 17, 9, 5, 22, 655],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$SP_NOT_ANY'], [
    ['CHARACTERS                     ',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, 59, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [43, 1, clc$max_list_size, TRUE],
      [[1, 0, clc$union_type], [[clc$range_type, clc$string_type],
      FALSE, 2],
      8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
      15, [[1, 0, clc$range_type], [8],
          [[1, 0, clc$string_type], [1, 1, FALSE]]
        ]
      ]
    ]];

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

    CONST
      p$characters = 1;

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

    VAR
      characters: clt$string_pattern_characters;


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

    build_character_set (pvt [p$characters].value, characters);

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_one_character (-characters, work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_not_any;
?? TITLE := 'clp$$sp_null', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_null) $sp_null

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 9, 29, 15, 53, 58, 101],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SP_NULL']];

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


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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_succeed_passive (work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_null;
?? TITLE := 'clp$$sp_or', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_or) $sp_or (
{   patterns: list rest of string_pattern = $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,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
    recend := [
    [1,
    [90, 1, 17, 9, 7, 35, 3],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$SP_OR'], [
    ['PATTERNS                       ',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, 19, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [3, 1, clc$max_list_size, TRUE],
      [[1, 0, clc$string_pattern_type]]
    ]];

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

    CONST
      p$patterns = 1;

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

    VAR
      left_pattern: ^clt$string_pattern,
      node: ^clt$data_value,
      right_pattern: ^clt$string_pattern;


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

    clp$make_string_pattern_value (pvt [p$patterns].value^.element_value^.string_pattern_value^, work_area,
          result);

    node := pvt [p$patterns].value^.link;
    WHILE node <> NIL DO
      left_pattern := result^.string_pattern_value;
      right_pattern := node^.element_value^.string_pattern_value;
      clp$sp_pattern_or_pattern (left_pattern, right_pattern, work_area, result^.string_pattern_value,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      node := node^.link;
    WHILEND;

  PROCEND clp$$sp_or;
?? TITLE := 'clp$$sp_repeat', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_repeat) $sp_repeat (
{   what: any of
{       record
{         selection: key
{           any, not_any
{         keyend
{         characters: list rest of any of
{           string
{           range of string 1
{         anyend = $optional
{       recend
{       string_pattern
{     anyend = $required
{   minimum_count: integer 0..clc$max_string_size = 0
{   )

?? 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,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: 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$keyword_type_qualifier,
            keyword_specs: array [1 .. 2] of clt$keyword_specification,
          recend,
          field_spec_2: clt$field_specification,
          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$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$range_type_qualifier,
                element_type_spec: record
                  header: clt$type_specification_header,
                  qualifier: clt$string_type_qualifier,
                recend,
              recend,
            recend,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [90, 1, 17, 9, 26, 36, 907],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_REPEAT'], [
    ['MINIMUM_COUNT                  ',clc$nominal_entry, 2],
    ['WHAT                           ',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, 242,
  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, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$record_type, clc$string_pattern_type],
    FALSE, 2],
    219, [[1, 0, clc$record_type], [2],
      ['SELECTION                      ', clc$required_field, 81], [[1, 0, clc$keyword_type], [2], [
        ['ANY                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
        ['NOT_ANY                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
        ],
      ['CHARACTERS                     ', clc$optional_field, 59], [[1, 0, clc$list_type], [43, 0,
  clc$max_list_size, TRUE],
          [[1, 0, clc$union_type], [[clc$range_type, clc$string_type],
          FALSE, 2],
          8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
          15, [[1, 0, clc$range_type], [8],
              [[1, 0, clc$string_type], [1, 1, FALSE]]
            ]
          ]
        ]
      ],
    3, [[1, 0, clc$string_pattern_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10],
    '0']];

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

    CONST
      p$what = 1,
      p$minimum_count = 2;

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

    VAR
      characters: clt$string_pattern_characters;


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

    clp$make_value (clc$string_pattern, work_area, result);
    IF pvt [p$what].value^.kind = clc$record THEN
      IF pvt [p$what].value^.field_values^ [2].value = NIL THEN
        clp$sp_multiple ($clt$string_pattern_characters [], pvt [p$minimum_count].
              value^.integer_value.value, work_area, result^.string_pattern_value, status);
      ELSE
        build_character_set (pvt [p$what].value^.field_values^ [2].value, characters);
        IF pvt [p$what].value^.field_values^ [1].value^.keyword_value = 'ANY' THEN
          clp$sp_characters (characters, pvt [p$minimum_count].value^.integer_value.value, work_area,
                result^.string_pattern_value, status);
        ELSE {NOT_ANY}
          clp$sp_multiple (characters, pvt [p$minimum_count].value^.integer_value.value, work_area,
                result^.string_pattern_value, status);
        IFEND;
      IFEND;
    ELSE {clc$string_pattern}
      clp$sp_repeat_pattern (pvt [p$what].value^.string_pattern_value,
            pvt [p$minimum_count].value^.integer_value.value, work_area, result^.string_pattern_value,
            status);
    IFEND;

  PROCEND clp$$sp_repeat;
?? TITLE := 'clp$$sp_right', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_right) $sp_right (
{   count: integer 0..clc$max_string_size = 0
{   )

?? 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,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 9, 29, 16, 2, 24, 300],
    clc$function, 1, 1, 0, 0, 0, 0, 0, 'OSM$$SP_RIGHT'], [
    ['COUNT                          ',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$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10],
    '0']];

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

    CONST
      p$count = 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_value (clc$string_pattern, work_area, result);

    clp$sp_count_test_right (pvt [p$count].value^.integer_value.value, work_area,
          result^.string_pattern_value, status);

  PROCEND clp$$sp_right;
?? TITLE := 'clp$$sp_stop', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_stop) $sp_stop

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 9, 29, 16, 7, 55, 919],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SP_STOP']];

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

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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_fail_pattern (work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_stop;
?? TITLE := 'clp$$sp_string', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_string) $sp_string (
{   string: string = $required
{   case_option: key
{       (case_sensitive, cs)
{       (ignore_case, ic)
{     keyend = case_sensitive
{   )

?? 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$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (14),
      recend,
    recend := [
    [1,
    [90, 1, 26, 9, 52, 55, 349],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_STRING'], [
    ['CASE_OPTION                    ',clc$nominal_entry, 2],
    ['STRING                         ',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, 8, 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, 155,
  clc$optional_default_parameter, 0, 14]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [4], [
    ['CASE_SENSITIVE                 ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['CS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['IC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['IGNORE_CASE                    ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'case_sensitive']];

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

    CONST
      p$string = 1,
      p$case_option = 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_value (clc$string_pattern, work_area, result);

    clp$sp_string_literal (pvt [p$string].value^.string_value, pvt [p$case_option].value^.keyword_value =
          'CASE_SENSITIVE', work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_string;
?? TITLE := 'clp$$sp_succeed', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_succeed) $sp_succeed

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 9, 22, 18, 1, 24, 196],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SP_SUCCEED']];

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

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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$sp_succeed_forced (work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_succeed;
?? TITLE := 'clp$$sp_test', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_test) $sp_test (
{   test: (DEFER) boolean = $required
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 1, 20, 13, 24, 30, 34],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$SP_TEST'], [
    ['TEST                           ',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$deferred_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0]],
{ PARAMETER 1
    [[1, 0, clc$boolean_type]]];

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

    CONST
      p$test = 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_value (clc$string_pattern, work_area, result);

    clp$sp_test (pvt [p$test].value^.deferred_value, work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_test;
?? TITLE := 'clp$$sp_upto', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_upto) $sp_upto (
{   where: any of
{       key
{         (left, l)
{         (right, r)
{       keyend
{       list of any of
{         string
{         range of string 1
{       anyend
{     anyend = $required
{   count: integer 0..clc$max_string_size = 0
{   )

?? 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,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 4] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$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$range_type_qualifier,
              element_type_spec: record
                header: clt$type_specification_header,
                qualifier: clt$string_type_qualifier,
              recend,
            recend,
          recend,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
    recend := [
    [1,
    [89, 9, 29, 16, 14, 59, 700],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_UPTO'], [
    ['COUNT                          ',clc$nominal_entry, 2],
    ['WHERE                          ',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, 234,
  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, 20,
  clc$optional_default_parameter, 0, 1]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],
    FALSE, 2],
    155, [[1, 0, clc$keyword_type], [4], [
      ['L                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
      ['LEFT                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['RIGHT                          ', clc$nominal_entry, clc$normal_usage_entry, 2]]
      ],
    59, [[1, 0, clc$list_type], [43, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$union_type], [[clc$range_type, clc$string_type],
        FALSE, 2],
        8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
        15, [[1, 0, clc$range_type], [8],
            [[1, 0, clc$string_type], [1, 1, FALSE]]
          ]
        ]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, clc$max_string_size, 10],
    '0']];

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

    CONST
      p$where = 1,
      p$count = 2;

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

    VAR
      characters: clt$string_pattern_characters;


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

    clp$make_value (clc$string_pattern, work_area, result);

    IF pvt [p$where].value^.kind = clc$list THEN
      build_character_set (pvt [p$where].value, characters);
      clp$sp_upto_character (characters, work_area, result^.string_pattern_value, status);

    ELSEIF pvt [p$where].value^.keyword_value = 'LEFT' THEN
      clp$sp_upto_count_from_left (pvt [p$count].value^.integer_value.value, work_area,
            result^.string_pattern_value, status);

    ELSE {RIGHT}
      clp$sp_upto_count_from_right (pvt [p$count].value^.integer_value.value, work_area,
            result^.string_pattern_value, status);
    IFEND;

  PROCEND clp$$sp_upto;
?? TITLE := 'clp$$sp_wild_card', EJECT ??

  PROCEDURE [XDCL] 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);

{ FUNCTION (osm$$sp_wild_card) $sp_wild_card, $sp_wc (
{   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 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: 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,
      type2: 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,
    [89, 9, 22, 16, 23, 37, 463],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$SP_WILD_CARD'], [
    ['PATTERN                        ',clc$nominal_entry, 1],
    ['PATTERN_TYPE                   ',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, 49, 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, 155,
  clc$optional_default_parameter, 0, 35]],
{ PARAMETER 1
    [[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 2
    [[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$pattern = 1,
      p$pattern_type = 2;

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

    VAR
      pattern_source: ^clt$string_value,
      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$pattern].value^.kind = clc$string THEN
      pattern_source := pvt [p$pattern].value^.string_value;
    ELSE {clc$application}
      pattern_source := pvt [p$pattern].value^.application_value;
    IFEND;

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

    clp$make_value (clc$string_pattern, work_area, result);

    clp$build_pattern_for_wild_card (pattern_type, $clt$string_pattern_build_opts [], pattern_source^,
          work_area, result^.string_pattern_value, status);

  PROCEND clp$$sp_wild_card;
?? TITLE := 'clp$build_pattern_for_wild_card', EJECT ??
*copy clh$build_pattern_for_wild_card

{
{ DESIGN:
{
{   Each component of the wild card pattern is represented by a single
{   CLT$STRING_PATTERN_ELEMENT with two exceptions.  The first exception is an
{   optimization that is employed when a "*" is the last thing in the wild card
{   pattern and CLC$SP_IGNORE_MATCHED_SUBSTRING is in the BUILD_OPTIONS set.
{   In this case no pattern element is created for the "*" at all.
{
{   The other exception concerns the representation of an alternation pattern.
{   For this kind of pattern, an element is created for each component of the
{   alternation.  An extra CLC$SP_SUCCESS_PASSIVE element is added when an
{   alternative is empty or begins with another (nested) alternation pattern.
{
{   A contiguous group of non-special character in the wild card pattern is
{   represented by a single CLC$SP_STRING_LITERAL element.  This includes any
{   quoted characters.
{
{   A contiguous group of "?" characters is represented by a single
{   CLC$SP_COUNT element whoose COUNT field specifies the number of "?"
{   characters that appeared in a row.
{
{   A "*" is represented by a CLC$SP_MULTIPLE element if something follows it,
{   or a CLC$SP_UPTO_COUNT_FROM_RIGHT element with a COUNT of zero if it the
{   last thing in the wild card pattern.  As noted above, when the "*" is last
{   and CLC$SP_IGNORE_MATCHED_SUBSTRING is in the BUILD_OPTIONS set, it is
{   entirly ommitted from the representation.
{
{   Both a "[ ]" and "[^ ]" (character class and inverse character class,
{   respectively) are represented by a CLC$SP_ONE_CHARACTER element.
{
{   An alternation pattern is represented by an element for each of its
{   components, as described above.  The first element of each alternative is
{   linked to the next by its ALTERNATIVE field.  (All other linkages are via
{   the SUCCESSOR field.) When alternative is empty or begins with a nested
{   alternation pattern a "place holding" element must be inserted to keep the
{   alternatives properly linked.  The place holder is represented by a
{   CLC$SP_SUCCESS_PASSIVE element.
{
{   A pattern is built by recursive calls to the BUILD_PATTERN_ELEMENT
{   procedure, one call for each element in the resulting pattern.  Recursion
{   is used rather than iteration in order to be able to assign the proper
{   values to the MIN_SUBJECT_SIZE and ALTERNATIVE_MIN_SUBJECT_SIZE fields of
{   the elements.  The MIN_SUBJECT_SIZE is the minimum number of characters
{   remaining in the subject needed to match the current element and its
{   successors.  It is equal to the minimum number of characters needed to match
{   the current element plus the lesser of the successor element's
{   MIN_SUBJECT_SIZE and ALTERNATIVE_MIN_SUBJECT_SIZE fields.  The
{   ALTERNATIVE_MIN_SUBJECT_SIZE is the minimum number of characters remaining
{   in the subject needed to match any of the current element's alternatives
{   along with their corresponding successors.  It is equal to the lesser of the
{   alternative element's MIN_SUBJECT_SIZE and ALTERNATIVE_MIN_SUBJECT_SIZE
{   fields.  If an element has no alternative its ALTERNATIVE_MIN_SUBJECT_SIZE
{   field is set to its MIN_SUBJECT_SIZE field to simplify the above
{   calculations.
{
{   Once the representation for all of the components of the alternation have
{   been built, all of the terminal nodes within the alternation must be linked
{   to the same successor element and the MIN_SUBJECT_SIZE and
{   ALTERNATIVE_MIN_SUBJECT_SIZE fields incremented by the minimum subject size
{   for that successor.
{
{   Were it not for alternation, the pattern builing process would be fairly
{   straightforward.  The complexity at the end of the BUILD_PATTERN_ELEMENT
{   procedure is entirely due to having to deal with alternations.
{
{   If CLC$SP_MATCH_AT_LEFT is in the BUILD_OPTIONS set, a
{   CLC$SP_COUNT_TEST_FROM_LEFT element is added to the front of the pattern.
{   IF CLC$SP_MATCH_AT_RIGHT is in the BUILD_OPTIONS set, a
{   CLC$SP_COUNT_TEST_FROM_RIGHT element is added to the end of the pattern.
{   In both cases the COUNT field of these elements is zero.
{

  PROCEDURE [XDCL, #GATE] clp$build_pattern_for_wild_card
    (    wild_card_pattern_type: clt$wild_card_pattern_type;
         build_options: clt$string_pattern_build_opts;
         source: clt$string_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      new_source_index: clt$string_index,
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header,
      pattern_size: clt$string_pattern_size,
      source_index: clt$string_index;

?? NEWTITLE := 'bad_wild_card_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure is called when an error in the specification of a wild card
{   pattern is detected.  It causes an abnormal status exit from the entire
{   pattern building process.
{

    PROCEDURE [INLINE] bad_wild_card_pattern;


      osp$set_status_condition (cle$bad_wild_card_pattern, status);
      EXIT clp$build_pattern_for_wild_card;

    PROCEND bad_wild_card_pattern;
?? TITLE := 'build_left_end_element', EJECT ??

{
{ PURPOSE:
{   This procedure adds a CLC$SP_COUNT_TEST_LEFT element with a COUNT of zero
{   to the front of the pattern.  This forces the pattern to be matched at the
{   left end of the subject.
{

    PROCEDURE [INLINE] build_left_end_element;

      VAR
        initial_element_link: clt$string_pattern_element_link,
        successor_pattern_element: ^clt$string_pattern_element;


      initial_element_link := pattern_header^.initial_element;
      initialize_pattern_element (pattern, work_area, pattern_header^.number_of_elements,
            pattern_header^.initial_element, pattern_element);
      IF pattern_element = NIL THEN
        work_area_overflow;
      IFEND;
      pattern_element^.successor := initial_element_link;

      IF initial_element_link <> NIL THEN
        successor_pattern_element := #PTR (initial_element_link, pattern^);
        pattern_element^.min_subject_size := min_subject_size (successor_pattern_element);
      IFEND;

      pattern_element^.kind := clc$sp_count_test_left;

    PROCEND build_left_end_element;
?? TITLE := 'build_pattern_element', EJECT ??

{
{ PURPOSE:
{   This procedure builds an individual element of the string pattern.
{
{ DESIGN:
{   It calls itself recursively to build the successor and alternative for an
{   element.  Upon return from these recursive calls the links to the successor
{   and alternatives are added and the minimum subject size for the current
{   element and its alternatives are calculated (see above).
{
{ BUILDING_ALTERNTIVE: (input)  This parameter indicates whether the caller
{       started or continued the building of an alternation pattern group.
{
{ PATTERN_ELEMENT_LINK: (output)  This parameter specifies the linkage field to
{       the element to be built by this call.  This linkage field is set by
{       this call once space for the new pattern element has been allocated.
{
{ PATTERN_ELEMENT: (output)  This parameter is set to point to the new pattern
{       element.
{

    PROCEDURE build_pattern_element
      (    building_alternative: boolean;
       VAR pattern_element_link: clt$string_pattern_element_link;
       VAR pattern_element: ^clt$string_pattern_element);

      VAR
        alternation_successor_link: clt$string_pattern_element_link,
        alternative_pattern_element: ^clt$string_pattern_element,
        element_is_alternative: boolean,
        element_is_first_alternative: boolean,
        element_source_index: clt$string_index,
        group_element_count: clt$string_size,
        previous_element_count: clt$string_size,
        successor_pattern_element: ^clt$string_pattern_element;

?? NEWTITLE := 'build_character_set', EJECT ??

{
{ PURPOSE:
{   This procedure interprets the wild card "character class" notation and
{   builds a set of characters to represent it.  If an "inverse character
{   class" is given, the set is complemented before returning.
{
{ CHARACTERS: (output)  This parameter specifies the set of characters that
{       constitute the "character class" or "inverse character class".
{

      PROCEDURE build_character_set
        (VAR characters: clt$string_pattern_characters);

        VAR
          c: char,
          complement_set: boolean,
          found_end_of_set: boolean,
          in_quotes: boolean,
          range: record
            case state: (no_range, got_low, got_separator) of
            = no_range =
              ,
            = got_low, got_separator =
              low: char,
            casend,
          recend;


        characters := $clt$string_pattern_characters [];

        found_end_of_set := FALSE;
        complement_set := FALSE;
        range.state := no_range;
        in_quotes := FALSE;
        source_index := source_index + 1;

      /scan_set/
        WHILE source_index <= STRLENGTH (source) DO
          CASE source (source_index) OF
          = clc$wc_quote =
            source_index := source_index + 1;
            IF (source_index > STRLENGTH (source)) OR (source (source_index) <> clc$wc_quote) THEN
              in_quotes := NOT in_quotes;
              CYCLE /scan_set/;
            IFEND;
          = clc$wc_set_begin =
            IF NOT in_quotes THEN
              bad_wild_card_pattern;
            IFEND;
          = clc$wc_set_complement =
            IF source_index = (element_source_index + 1) THEN
              complement_set := TRUE;
              source_index := source_index + 1;
              CYCLE /scan_set/;
            IFEND;
          = clc$wc_set_end =
            IF NOT in_quotes THEN
              found_end_of_set := TRUE;
              source_index := source_index + 1;
              EXIT /scan_set/;
            IFEND;
          = clc$wc_set_range =
            IF (NOT in_quotes) AND (range.state = got_low) THEN
              range.state := got_separator;
              source_index := source_index + 1;
              CYCLE /scan_set/;
            IFEND;
          ELSE
            ;
          CASEND;

          IF range.state = got_separator THEN
            IF range.low <= source (source_index) THEN
              FOR c := SUCC (range.low) TO source (source_index) DO
                characters := characters + $clt$string_pattern_characters [c];
              FOREND;
            ELSE
              FOR c := PRED (range.low) DOWNTO source (source_index) DO
                characters := characters + $clt$string_pattern_characters [c];
              FOREND;
            IFEND;
            range.state := no_range;
          ELSE
            range.state := got_low;
            range.low := source (source_index);
            characters := characters + $clt$string_pattern_characters [source (source_index)];
          IFEND;

          source_index := source_index + 1;
        WHILEND /scan_set/;

        IF (NOT found_end_of_set) OR (characters = $clt$string_pattern_characters []) THEN
          bad_wild_card_pattern;
        ELSEIF range.state = got_separator THEN
          characters := characters + $clt$string_pattern_characters [clc$wc_set_range];
        IFEND;

        IF complement_set THEN
          characters := -characters;
        IFEND;

      PROCEND build_character_set;
?? TITLE := 'build_count', EJECT ??

{
{ PURPOSE:
{   This procedure builds a CLC$SP_COUNT element to represent one or more
{   "?" wild cards in a row.
{

      PROCEDURE [INLINE] build_count;

        VAR
          characters: ^clt$string_pattern_characters;


        pattern_element^.kind := clc$sp_count;

        REPEAT
          source_index := source_index + 1;
        UNTIL (source_index > STRLENGTH (source)) OR (source (source_index) <> clc$wc_count_1);

        pattern_element^.count := source_index - element_source_index;
        pattern_element^.min_subject_size := pattern_element^.count;

        WHILE (source_index <= STRLENGTH (source)) AND (source (source_index) = clc$wc_multiple) DO
          pattern_element^.kind := clc$sp_multiple;
          source_index := source_index + 1;
        WHILEND;

        IF clc$sp_file_reference_pattern IN build_options THEN
          NEXT characters IN work_area;
          IF characters = NIL THEN
            work_area_overflow;
          IFEND;
          characters^ := $clt$string_pattern_characters [clc$wc_path_element_separator];
          pattern_element^.characters := #REL (characters, pattern^);
          pattern_element^.extra_info_size := #SIZE (characters^);
        ELSE
          pattern_element^.characters := NIL;
        IFEND;

      PROCEND build_count;
?? TITLE := 'build_multiple', EJECT ??

{
{ PURPOSE:
{   This procedure builds a pattern element to represent the "*" wild card.
{
{ DESIGN:
{   If the "*" is not the last thing in the wild card pattern or
{   CLC$SP_MATCH_AT_RIGHT is not in the BUILD_OPTIONS set, a CLC$SP_MULTIPLE
{   element is built.
{   If the "*" is the last thing in the wild card pattern and
{   CLC$SP_MATCH_AT_RIGHT is in the BUILD_OPTIONS set, what is built depends on
{   whether CLC$SP_IGNORE_MATCHED_SUBSTRING is in the BUILD_OPTIONS set. If it
{   is not, i.e. the INDEX and SIZE fields of the CLT$STRING_PATTERN_MATCH_INFO
{   will be important when the pattern is used in a match operation, a
{   CLC$MATCH_UPTO_RIGHT_END pattern is built.
{   Otherwise no pattern element at all is built and NIL is returned.
{

      PROCEDURE [INLINE] build_multiple;

        VAR
          characters: ^clt$string_pattern_characters;


        REPEAT
          source_index := source_index + 1;
        UNTIL (source_index > STRLENGTH (source)) OR (source (source_index) <> clc$wc_multiple);

        IF (source_index <= STRLENGTH (source)) OR (NOT (clc$sp_match_at_right IN build_options)) OR
              (clc$sp_file_reference_pattern IN build_options) THEN
          pattern_element^.kind := clc$sp_multiple;
          IF clc$sp_file_reference_pattern IN build_options THEN
            NEXT characters IN work_area;
            IF characters = NIL THEN
              work_area_overflow;
            IFEND;
            characters^ := $clt$string_pattern_characters [clc$wc_path_element_separator];
            pattern_element^.characters := #REL (characters, pattern^);
            pattern_element^.extra_info_size := #SIZE (characters^);
          ELSE
            pattern_element^.characters := NIL;
          IFEND;
        ELSEIF NOT (clc$sp_ignore_matched_substring IN build_options) THEN
          pattern_element^.kind := clc$sp_upto_count_from_right;
        ELSE
          RESET work_area TO pattern_element;
          pattern_element := NIL;
          pattern_element_link := NIL;
          pattern_header^.number_of_elements := pattern_header^.number_of_elements + 1;
        IFEND;

      PROCEND build_multiple;
?? TITLE := 'build_multiple_path_elements', EJECT ??

{
{ PURPOSE:
{   This procedure builds a pattern element to represent the special path
{   element $ALL for a file reference pattern.
{
{ NEW_SOURCE_INDEX: (input)  This parameter specifies the value for the
{       SOURCE_INDEX once the pattern element has been built.  If it is
{       beyond the end of the SOURCE string, the pattern element will
{       represent ".$ALL" at the end of a file reference.  Otherwise it
{       will represent ".$ALL." in the middle of a file reference.
{

      PROCEDURE [INLINE] build_multiple_path_elements
        (    new_source_index: clt$string_index);


        pattern_element^.kind := clc$sp_multiple_path_elements;

        pattern_element^.min_subject_size := $INTEGER (new_source_index <= STRLENGTH (source));

        source_index := new_source_index;

      PROCEND build_multiple_path_elements;
?? TITLE := 'build_one_character', EJECT ??

{
{ PURPOSE:
{   This procedure builds a CLC$SP_ONE_CHARACTER element to represent a
{   "character class" or "inverse character class" wild card.
{

      PROCEDURE [INLINE] build_one_character;

        VAR
          characters: ^clt$string_pattern_characters;


        pattern_element^.kind := clc$sp_one_character;

        NEXT characters IN work_area;
        IF characters = NIL THEN
          work_area_overflow;
        IFEND;

        build_character_set (characters^);

        pattern_element^.characters := #REL (characters, pattern^);
        pattern_element^.extra_info_size := #SIZE (characters^);

        pattern_element^.min_subject_size := 1;

      PROCEND build_one_character;
?? TITLE := 'build_string_literal', EJECT ??

{
{ PURPOSE:
{   This procedure builds a CLC$SP_STRING_LITERAL element to represent one or
{   more "non-special" characters in a row from the wild card pattern.  It
{   deals with quoted sequences of characters and stops collecting literal
{   characters when it encounters a "special" character.
{
{ NOTES:
{   This procedure deals with recognizing the special path element $ALL when
{   building a pattern to used for matching file refernces.
{

      PROCEDURE [INLINE] build_string_literal;

        VAR
          in_quotes: boolean,
          string_literal: ^clt$string_value,
          string_literal_index: clt$string_index;


        pattern_element^.kind := clc$sp_string_literal;
        pattern_element^.case_sensitive := TRUE;

        NEXT string_literal: [STRLENGTH (source) - source_index + 1] IN work_area;
        IF string_literal = NIL THEN
          work_area_overflow;
        IFEND;

        string_literal_index := 1;
        in_quotes := FALSE;

      /scan_literal/
        WHILE source_index <= STRLENGTH (source) DO
          CASE source (source_index) OF
          = clc$wc_alternation_begin, clc$wc_set_begin =
            IF (NOT in_quotes) AND (wild_card_pattern_type = clc$wc_extended_pattern) THEN
              EXIT /scan_literal/;
            IFEND;
          = clc$wc_alternation_end =
            IF NOT in_quotes THEN
              IF building_alternative OR element_is_alternative THEN
                EXIT /scan_literal/;
              ELSEIF wild_card_pattern_type = clc$wc_extended_pattern THEN
                bad_wild_card_pattern;
              IFEND;
            IFEND;
          = clc$wc_alternation_separator =
            IF (NOT in_quotes) AND (building_alternative OR element_is_alternative) THEN
              EXIT /scan_literal/;
            IFEND;
          = clc$wc_count_1, clc$wc_multiple =
            IF NOT in_quotes THEN
              EXIT /scan_literal/;
            IFEND;
          = clc$wc_path_element_separator =
            IF (NOT in_quotes) AND (clc$sp_file_reference_pattern IN build_options) THEN
              check_for_multiple_path_element (new_source_index);
              IF new_source_index > source_index THEN
                EXIT /scan_literal/;
              IFEND;
            IFEND;
          = clc$wc_quote =
            source_index := source_index + 1;
            IF (source_index > STRLENGTH (source)) OR (source (source_index) <> clc$wc_quote) THEN
              in_quotes := NOT in_quotes;
              CYCLE /scan_literal/;
            IFEND;
          = clc$wc_set_end =
            IF (NOT in_quotes) AND (wild_card_pattern_type = clc$wc_extended_pattern) THEN
              bad_wild_card_pattern;
            IFEND;
          ELSE
            ;
          CASEND;

          string_literal^ (string_literal_index) := source (source_index);
          string_literal_index := string_literal_index + 1;
          source_index := source_index + 1;
        WHILEND /scan_literal/;

        IF in_quotes THEN
          bad_wild_card_pattern;
        IFEND;

        RESET work_area TO string_literal;
        NEXT string_literal: [string_literal_index - 1] IN work_area;
        pattern_element^.string_literal := #REL (string_literal, pattern^);
        pattern_element^.extra_info_size := #SIZE (string_literal^);

        pattern_element^.min_subject_size := STRLENGTH (string_literal^);

      PROCEND build_string_literal;
?? TITLE := 'build_succeed_passive', EJECT ??

{
{ PURPOSE:
{   This procedure builds a CLC$SP_SUCCEED_PASSIVE element.
{

      PROCEDURE [INLINE] build_succeed_passive;


        pattern_element^.kind := clc$sp_succeed_passive;

      PROCEND build_succeed_passive;
?? TITLE := 'check_for_multiple_path_element', EJECT ??

{
{ PURPOSE:
{   This procedure checks for the presence of the special path element $ALL
{   for a file reference pattern.  It assumes that the current source character
{   is a clc$wc_path_element_separator (".").
{

      PROCEDURE [INLINE] check_for_multiple_path_element
        (VAR new_source_index: clt$string_index);

        CONST
          clc$wc_multiple_path_elements = '$ALL';

        VAR
          remaining_source_size: clt$string_size;


        new_source_index := source_index;
        remaining_source_size := STRLENGTH (source) - source_index;
        IF (remaining_source_size >= STRLENGTH (clc$wc_multiple_path_elements)) AND
              (source (source_index + 1, STRLENGTH (clc$wc_multiple_path_elements)) =
              clc$wc_multiple_path_elements) THEN
          IF remaining_source_size = STRLENGTH (clc$wc_multiple_path_elements) THEN
            new_source_index := STRLENGTH (source) + 1;
          ELSEIF source (source_index + 1 + STRLENGTH (clc$wc_multiple_path_elements)) =
                clc$wc_path_element_separator THEN
            new_source_index := source_index + 1 + STRLENGTH (clc$wc_multiple_path_elements) + 1;
          IFEND;
        IFEND;

      PROCEND check_for_multiple_path_element;
?? OLDTITLE, EJECT ??

{
{ Upon entry to BUILD_PATTERN_ELEMENT, if the current SOURCE character signals
{ The start of an alternation group or the start of an alternative within a
{ group, flags are set to so indicate and the SOURCE_INDEX is incremented past
{ that character.
{
{ ELEMENT_IS_FIRST_ALTERNATIVE is set to TRUE if we're about to build the first
{ element of an alternation pattern gorup.
{ ELEMENT_IS_ALTERNATIVE is set to TRUE if we're about the build the first
{ element of an alternative within an alternation pattern gorup.
{ (ELEMENT_IS_FIRST_ALTERNATIVE implies ELEMENT_IS_ALTERNATIVE.)
{

      element_is_first_alternative := FALSE;
      element_is_alternative := FALSE;
      CASE source (source_index) OF
      = clc$wc_alternation_begin =
        IF wild_card_pattern_type = clc$wc_extended_pattern THEN
          IF source_index = STRLENGTH (source) THEN
            bad_wild_card_pattern;
          IFEND;
          element_is_first_alternative := TRUE;
          element_is_alternative := TRUE;
          source_index := source_index + 1;
        IFEND;
      = clc$wc_alternation_separator =
        IF building_alternative THEN
          IF source_index = STRLENGTH (source) THEN
            bad_wild_card_pattern;
          IFEND;
          element_is_alternative := TRUE;
          source_index := source_index + 1;
        IFEND;
      ELSE
        ;
      CASEND;

{ Remember where the source for this element began.

      element_source_index := source_index;

{ Remember the number of elements that preceded the new one.

      previous_element_count := pattern_header^.number_of_elements;

{ Allocate space for and initialize the new pattern element.

      initialize_pattern_element (pattern, work_area, pattern_header^.number_of_elements,
            pattern_element_link, pattern_element);
      IF pattern_element = NIL THEN
        work_area_overflow;
      IFEND;

{ Check for special wild card characters and select the appropriate pattern
{ element builder.  Some characters are only special when building a
{ CLC$WC_EXTENDED_PATTERN.  If the current SOURCE character is not special in
{ the current context, build a string literal element.

    /build_element/
      BEGIN
        CASE source (source_index) OF
        = clc$wc_alternation_begin =
          IF wild_card_pattern_type = clc$wc_extended_pattern THEN
            build_succeed_passive;
            EXIT /build_element/;
          IFEND;
        = clc$wc_alternation_end, clc$wc_alternation_separator =
          IF building_alternative OR element_is_alternative THEN
            build_succeed_passive;
            EXIT /build_element/;
          IFEND;
        = clc$wc_count_1 =
          build_count;
          EXIT /build_element/;
        = clc$wc_multiple =
          build_multiple;
          EXIT /build_element/;
        = clc$wc_path_element_separator =
          IF clc$sp_file_reference_pattern IN build_options THEN
            check_for_multiple_path_element (new_source_index);
            IF new_source_index > source_index THEN
              build_multiple_path_elements (new_source_index);
              EXIT /build_element/;
            IFEND;
          IFEND;
        = clc$wc_set_begin =
          IF wild_card_pattern_type = clc$wc_extended_pattern THEN
            build_one_character;
            EXIT /build_element/;
          IFEND;
        ELSE
          ;
        CASEND;
        build_string_literal;
      END /build_element/;

{ Pattern_element will be non-NIL unless BUILD_MULTIPLE was called and it
{ determined that no element was needed.

      IF pattern_element <> NIL THEN
        pattern_element^.alternative_min_subject_size := pattern_element^.min_subject_size;
      IFEND;

      IF source_index > STRLENGTH (source) THEN

{ We've reached end of the source of the wild card pattern.

        IF building_alternative OR element_is_alternative THEN
          bad_wild_card_pattern;
        ELSEIF pattern_element <> NIL THEN
          IF (clc$sp_match_at_right IN build_options) AND (pattern_element^.kind <>
                clc$sp_upto_count_from_right) THEN
            build_right_end_element (pattern_element^.successor, successor_pattern_element);
            pattern_element^.min_subject_size := pattern_element^.min_subject_size +
                  min_subject_size (successor_pattern_element);
            pattern_element^.alternative_min_subject_size := pattern_element^.min_subject_size;
          IFEND;
        IFEND;
        RETURN;
      IFEND;

      IF NOT ((building_alternative OR element_is_alternative) AND
            ((source (source_index) = clc$wc_alternation_separator) OR
            (source (source_index) = clc$wc_alternation_end))) THEN

{ Build the successor to this element (if any).

        build_pattern_element (building_alternative OR element_is_alternative, pattern_element^.successor,
              successor_pattern_element);
        IF successor_pattern_element <> NIL THEN
          pattern_element^.min_subject_size := pattern_element^.min_subject_size +
                min_subject_size (successor_pattern_element);
          pattern_element^.alternative_min_subject_size := pattern_element^.min_subject_size;
        IFEND;

        IF source_index > STRLENGTH (source) THEN

{ We've reached end of the source of the wild card pattern.

          IF building_alternative OR element_is_alternative THEN
            bad_wild_card_pattern;
          IFEND;
          RETURN;

        ELSEIF NOT ((building_alternative OR element_is_alternative) AND
              ((source (source_index) = clc$wc_alternation_separator) OR
              (source (source_index) = clc$wc_alternation_end))) THEN
          RETURN;
        IFEND;
      IFEND;

{ We've reached the end of an alternative pattern group.

      IF NOT element_is_alternative THEN

{ Finishing up an alternative pattern must be done in the context of the
{ first pattern element of that alternative.

        RETURN;
      IFEND;

      IF source (source_index) = clc$wc_alternation_separator THEN

{ Build the next alternative within the alternation pattern.

        build_pattern_element (TRUE {building_alternative} , pattern_element^.alternative,
              alternative_pattern_element);
        pattern_element^.alternative_min_subject_size := min_subject_size (alternative_pattern_element);
      IFEND;

{ We should now have reached the end of the entire alternation pattern.

      IF source (source_index) <> clc$wc_alternation_end THEN
        bad_wild_card_pattern;
      ELSEIF NOT element_is_first_alternative THEN
        RETURN;
      IFEND;

{ The entire group of elements that form the alternation pattern must be
{ finished up in the context of the first pattern element of the alternation.

      source_index := source_index + 1;

      group_element_count := pattern_header^.number_of_elements - previous_element_count;

{ Build the successor to the entire alternation pattern (if any).

      IF source_index <= STRLENGTH (source) THEN
        IF building_alternative AND ((source (source_index) = clc$wc_alternation_separator) OR
              (source (source_index) = clc$wc_alternation_end)) THEN
          successor_pattern_element := NIL;
        ELSE
          build_pattern_element (building_alternative, alternation_successor_link, successor_pattern_element);
        IFEND;
      ELSEIF clc$sp_match_at_right IN build_options THEN
        build_right_end_element (alternation_successor_link, successor_pattern_element);
      ELSE
        successor_pattern_element := NIL;
      IFEND;

      IF successor_pattern_element = NIL THEN
        RETURN;
      IFEND;

{ Link the successor to the alternation pattern group to all of the terminal
{ elements within the group.

      link_successor_to_pattern (pattern, pattern_element, group_element_count,
            #REL (successor_pattern_element, pattern^), min_subject_size (successor_pattern_element));

    PROCEND build_pattern_element;
?? TITLE := 'build_right_end_element', EJECT ??

{
{ PURPOSE:
{   This procedure builds a CLC$SP_COUNT_TEST_RIGHT with a COUNT of zero.  It
{   is assumed to be called by the procedure that built the last specified
{   piece of the wild card pattern.
{
{ PATTERN_ELEMENT_LINK: (input)  This parameter points to the linkage field to
{       element to be built by this call.  This linkage field is set by this
{       call once space for the new pattern element has been allocated.
{
{ PATTERN_ELEMENT: (output)  This parameter is set to point to the new pattern
{       element.
{

    PROCEDURE [INLINE] build_right_end_element
      (VAR pattern_element_link: clt$string_pattern_element_link;
       VAR pattern_element: ^clt$string_pattern_element);


      initialize_pattern_element (pattern, work_area, pattern_header^.number_of_elements,
            pattern_element_link, pattern_element);
      IF pattern_element = NIL THEN
        work_area_overflow;
      IFEND;

      pattern_element^.kind := clc$sp_count_test_right;

    PROCEND build_right_end_element;
?? TITLE := 'work_area_overflow', EJECT ??

{
{ PURPOSE:
{   This procedure is called when there is not enough space in the work area to
{   build the representation of the wild card pattern.  It causes an abnormal
{   status exit from the entire pattern building process.
{

    PROCEDURE [INLINE] work_area_overflow;


      osp$set_status_condition (cle$work_area_overflow, status);
      EXIT clp$build_pattern_for_wild_card;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

{ Set up for building the pattern.  Initially the PATTERN sequence is
{ to "cover" all of the remaining space in the work area, then the WORK_AREA
{ pointer is immediately reset to its initial position.  This is done solely so
{ that correct values for relative pointers within the resulting pattern can be
{ generated.

    NEXT pattern: [[REP #SIZE (work_area^) - i#current_sequence_position (work_area) OF cell]] IN work_area;
    IF pattern = NIL THEN
      work_area_overflow;
    IFEND;
    RESET work_area TO pattern;

    initialize_pattern_header (work_area, pattern_header);
    IF pattern_header = NIL THEN
      work_area_overflow;
    IFEND;

    source_index := 1;

{ BUILD_PATTERN_ELEMENT must only be called if there's anything in the SOURCE
{ of the wild card pattern.  BUILD_RIGHT_END_ELEMENT may still have to be
{ called even if SOURCE is empty.

    IF STRLENGTH (source) > 0 THEN
      build_pattern_element (FALSE {NOT building_alternative} , pattern_header^.initial_element,
            pattern_element);
    ELSEIF clc$sp_match_at_right IN build_options THEN
      build_right_end_element (pattern_header^.initial_element, pattern_element);
    IFEND;

{ Call BUILD_LEFT_END_ELEMENT if requested.

    IF clc$sp_match_at_left IN build_options THEN
      build_left_end_element;
    IFEND;

{ Rebuild the sequence pointer to the resulting pattern in order to get the
{ correct size information into it.

    pattern_size := i#current_sequence_position (work_area);
    RESET work_area TO pattern;
    pattern_size := pattern_size - i#current_sequence_position (work_area);
    NEXT pattern: [[REP pattern_size OF cell]] IN work_area;
    RESET pattern;

  PROCEND clp$build_pattern_for_wild_card;
?? TITLE := 'clp$match_string_pattern', EJECT ??
*copy clh$match_string_pattern

{
{ DESIGN:
{
{   For an overview of the string pattern matching algorithm, see the
{   description at the beginning of the modules.
{
{   The processors for the CLC$SP_CAPTURE_BEGIN and CLC$SP_CAPTURE_END elements
{   synchronize their actions through the "capture stack".  The pointer to this
{   stack is kept in the "global" variable CAPTURE_STACK which is initially
{   NIL.  The processor for the CLC$SP_CAPTURE_BEGIN element has a local
{   variable called CAPTURE_STACK_ENTRY.  When that processor is called it
{   "pushes" its entry onto the capture stack and initializes it to hold the
{   SUBJECT_INDEX at the point where the CLC$SP_CAPTURE_BEGIN element was
{   encountered.  When the processor for the CLC$SP_CAPTURE_END element is
{   called, it searches the "capture stack" for the entry created for the
{   corresponding CLC$SP_CAPTURE_BEGIN element.  The substring of the SUBJECT
{   to capture starts at the SUBJECT_INDEX in the stack entry and goes up to,
{   but not including, the SUBJECT_INDEX when the CLC$SP_CAPTURE_END processor
{   was called.  A capture stack entry is "popped" off the capture stack by the
{   CLC$SP_CAPTURE_BEGIN processor that "pushed" it onto the stack.
{
{   The processors for the CLC$SP_REPEAT_PATTERN_BEGIN and
{   CLC$SP_REPEAT_PATTERN_END elements use the "repeat pattern stack" in a
{   similar way.  The pointer to this stack is kept in the "global" variable
{   REPEAT_PATTERN_STACK which is initially NIL.  The processor for the
{   CLC$SP_REPEAT_PATTERN_BEGIN has a local variable called
{   REPEAT_PATTERN_STACK_ENTRY.  When that processor is called it "pushes" its
{   entry onto the repeat pattern stack and initializes it.  The COUNT field
{   indicates the number of times the pattern to be matched repeatedly has
{   actually been matched.  The MATCH_ATTEMPTED field is used to help detect
{   when the pattern to be repeated has matched the null string.  (If it
{   matched the null string once, the chances are good that it will match the
{   null string again.) The SUBJECT_INDEX field keeps track of where the last
{   attempt to match the repeated pattern started.  When the processor for the
{   CLC$SP_REPEAT_PATTERN_END element is called, it searches the "repeat
{   pattern stack" for the entry created for the corresponding
{   CLC$SP_REPEAT_PATTERN_BEGIN element.  It is the CLC$SP_REPEAT_PATTERN_END
{   processor that drives the repeated matching attempts.  A repeat pattern
{   stack entry is "popped" off the repeat pattern stack by the
{   CLC$SP_REPEAT_PATTERN_BEGIN processor that "pushed" it onto the stack.
{
{   For both of the above element pairs, the maintenance of the stacks requires
{   that CYBIL's "rules" about the lifetime of pointers be ignored since the
{   pointers to the stacks must be able to point at variables local to nested
{   procedures.  The points where this ignoring of the "rules" take place are
{   noted in the code.
{
{   The processor for the CLC$SP_UNEVALUATED_PATTERN element requires a stack
{   similar to those for repeating and capturing, described above.  In this
{   case the SUCCESSOR_STACK_ENTRYs keep track of the elements that are the
{   successors of the unevalauted elements.  These successors must be scanned
{   immediately following the corresponding evaluated sub-patterns in order to
{   maintain proper context.
{
{   The other pattern element processors are comparatively straight forward.
{   The processor for CLC$SP_MULTIPLE does look at its successor in an attempt
{   to optimize its own processing.  This same optimization is done when the
{   CLC$SP_UNANCHORED option is specified.
{

  PROCEDURE [XDCL, #GATE] clp$match_string_pattern
    (    subject: clt$string_value;
         pattern: ^clt$string_pattern;
         anchor_option: clt$string_pattern_anchor_opt;
         scan_option: clt$string_pattern_scan_option;
     VAR match_info: clt$string_pattern_match_info;
     VAR status: ost$status);


    TYPE
      clt$capture_stack_entry = record
        link: ^clt$capture_stack_entry,
        end_element: clt$string_pattern_element_link,
        subject_index: clt$string_index,
      recend;

    TYPE
      clt$repeat_pattern_stack_entry = record
        link: ^clt$repeat_pattern_stack_entry,
        end_element: clt$string_pattern_element_link,
        count: clt$string_size,
        match_attempted: boolean,
        subject_index: clt$string_index,
      recend;

    TYPE
      clt$successor_stack_entry = record
        link: ^clt$successor_stack_entry,
        process: boolean,
        pattern: ^clt$string_pattern,
        element: clt$string_pattern_element_link,
      recend;


    VAR
      capture_stack: ^clt$capture_stack_entry,
      initial_characters: ^clt$string_pattern_characters,
      initial_pattern_element: ^clt$string_pattern_element,
      initial_string_literal: ^clt$string_value,
      look_for_initial_characters: ^clt$string_pattern_characters,
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header,
      repeat_pattern_stack: ^clt$repeat_pattern_stack_entry,
      scan_failure_reason: clt$string_pattern_fail_reason,
      scan_found_char: boolean,
      scan_index: clt$string_index,
      subject_index: clt$string_index,
      successor_stack: ^clt$successor_stack_entry;

?? NEWTITLE := 'bad_string_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure is called when an inconsistency in the structure of a string
{   pattern is detected.  It causes an abnormal status exit from the entire
{   pattern matching process.
{

    PROCEDURE [INLINE] bad_string_pattern;


      osp$set_status_condition (cle$bad_string_pattern, status);
      EXIT clp$match_string_pattern;

    PROCEND bad_string_pattern;
?? TITLE := 'scan_string_pattern', EJECT ??

{
{ PURPOSE:
{
{   This procedure controls the matching for one or more pattern elements.
{
{ DESIGN:
{
{   It calls individual processors for each kind of pattern element.  Upon
{   return from one of these, it procedes to the element's successor if the
{   element matched.  If the element failed to match and has an alternative,
{   an attempt to match the alternative is made.
{
{   Whenever this main controlling procedure or one of the individual matching
{   processors might be backed into to try an alternative, this procedure is
{   called recursivly in order to be able to restart the scan in the proper
{   context with the alternative.
{
{ PATTERN: (input)  This parameter specifies the CLT$STRING_PATTERN containing
{       the PATTERN_ELEMENT to be processed.  This is needed to support the
{       processing for the CLC$SP_UNEVALUATED_PATTERN element.
{
{ SUBJECT_INDEX: (input, output)  This parameter specifies the index within the
{       SUBJECT string at which the scanning (matching) process should start.
{       If the match was successful, this value is updated to indicate how much
{       of the SUBJECT was matched.
{
{ PATTERN_ELEMENT: (input, output)  This parameter specifies the elment of the
{       PATTERN to be matched next.  This pointer is updated to designate the
{       last element for which a match attempt was made.
{
{ SCAN_FAILURE_REASON: (output)  This parameter is meaningful only if the match
{       attempt failed, i.e. if SCAN_MATCH_INFO.RESULT is CLC$SP_FAILURE.  In
{       case it indicates the reason for the failure.  See the discussion at
{       beginning of this module for an explanation of the various reasons for
{       failure.
{
{ SCAN_MATCH_INFO: (output)  This parameter specifies the whether the RESULT of
{       the match attempt was CLC$SP_SUCCESS or CLC$SP_FAILURE.  If success,
{       the INDEX and SIZE fields can be used to extract the substring of the
{       SUBJECT which matched the PATTERN.
{

    PROCEDURE scan_string_pattern
      (    pattern: ^clt$string_pattern;
       VAR subject_index {input, output} : clt$string_index;
       VAR pattern_element {input, output} : ^clt$string_pattern_element;
       VAR scan_failure_reason: clt$string_pattern_fail_reason;
       VAR scan_match_info: clt$string_pattern_match_info);

      VAR
        alternative_pattern_element: ^clt$string_pattern_element,
        element_failure_reason: clt$string_pattern_fail_reason,
        element_match_result: clt$string_pattern_match_result,
        local_match_info: clt$string_pattern_match_info,
        local_subject_index: clt$string_index,
        original_subject_index: clt$string_index,
        remaining_subject_size: clt$string_size;

?? NEWTITLE := 'process_balanced_pair', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_BALANCED_PAIR element.
{
{ NOTE:
{   This element has implied alternatives.  If it is backed into with failure
{   it increases the number of characters it matches and retries its
{   successors.
{

      PROCEDURE process_balanced_pair;

        VAR
          found_balanced_pair: boolean,
          left_character: char,
          local_failure_reason: clt$string_pattern_fail_reason,
          local_match_info: clt$string_pattern_match_info,
          local_subject_index: clt$string_index,
          min_successor_size: clt$string_size,
          nesting_count: clt$string_size,
          right_character: char,
          successor_pattern_element: ^clt$string_pattern_element;


        IF remaining_subject_size < pattern_element^.min_subject_size THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
          RETURN;
        ELSEIF subject (subject_index) = pattern_element^.right_character THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
          RETURN;
        ELSEIF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;
          subject_index := subject_index + 1;
          RETURN;
        IFEND;

        successor_pattern_element := #PTR (pattern_element^.successor, pattern^);
        min_successor_size := min_subject_size (successor_pattern_element);
        left_character := pattern_element^.left_character;
        right_character := pattern_element^.right_character;

        found_balanced_pair := FALSE;
        local_subject_index := subject_index;

        WHILE TRUE DO
          nesting_count := 0;

        /match_characters/
          REPEAT
            IF subject (local_subject_index) = left_character THEN
              nesting_count := nesting_count + 1;
              found_balanced_pair := TRUE;
            ELSEIF subject (local_subject_index) = right_character THEN
              IF nesting_count = 0 THEN
                EXIT /match_characters/;
              IFEND;
              nesting_count := nesting_count - 1;
            IFEND;
            local_subject_index := local_subject_index + 1;
          UNTIL (nesting_count = 0) OR (local_subject_index > STRLENGTH (subject)) {/match_characters/} ;

          IF (STRLENGTH (subject) - local_subject_index + 1) < min_successor_size THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_size;
            RETURN;
          ELSEIF nesting_count <> 0 THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := successor_pattern_element;
          scan_string_pattern (pattern, local_subject_index, pattern_element, local_failure_reason,
                local_match_info);

          IF local_match_info.result = clc$sp_success THEN
            element_match_result := clc$sp_success;
            subject_index := local_subject_index;
            RETURN;
          ELSEIF scan_option = clc$sp_quick_scan THEN
            IF local_failure_reason <> clc$sp_fail_match THEN
              element_match_result := clc$sp_failure;
              IF found_balanced_pair THEN
                element_failure_reason := clc$sp_fail_match;
              ELSE
                element_failure_reason := local_failure_reason;
              IFEND;
              RETURN;
            IFEND;
          IFEND;

          IF (local_subject_index > STRLENGTH (subject)) OR (subject (local_subject_index) =
                right_character) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;
        WHILEND;

      PROCEND process_balanced_pair;
?? TITLE := 'process_capture_begin', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_CAPTURE_BEGIN element.
{
{ DESIGN:
{   See the discussion at the beginning of CLP$MATCH_STRING_PATTERN for an
{   explanation of how this processor works in conjunction with the one for
{   a CLC$SP_CAPTURE_END element.
{

      PROCEDURE process_capture_begin;

        VAR
          capture_stack_entry: clt$capture_stack_entry;


{ "Push" an entry onto the capture stack.

        capture_stack_entry.link := capture_stack;
        capture_stack_entry.end_element := pattern_element^.capture_end_element;
        capture_stack_entry.subject_index := subject_index;

{ The following assignment will cause a "pointer lifetime" warning from CYBIL.
{ This is OK!

        capture_stack := ^capture_stack_entry;

        IF pattern_element^.successor = NIL THEN
          bad_string_pattern;
        IFEND;

{ Call the main scan procedure to deal with element's successors in order to
{ gain control when the scanning process backs up.

        pattern_element := #PTR (pattern_element^.successor, pattern^);
        scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

        element_match_result := scan_match_info.result;
        IF element_match_result = clc$sp_failure THEN
          element_failure_reason := scan_failure_reason;
          IF element_failure_reason = clc$sp_fail_immediate_capture THEN

{ See the discussion at the beginning of the module for how the failure reason
{ information is used.

            element_failure_reason := clc$sp_fail_match;
          IFEND;
        IFEND;

      PROCEND process_capture_begin;
?? TITLE := 'process_capture_end', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_CAPTURE_END element.
{
{ DESIGN:
{   See the discussion at the beginning of CLP$MATCH_STRING_PATTERN for an
{   explanation of how this processor works in conjunction with the one for
{   a CLC$SP_CAPTURE_BEGIN element.
{

      PROCEDURE process_capture_end;

        VAR
          capture_index: clt$string_index,
          capture_size: clt$string_size,
          capture_stack_entry: ^clt$capture_stack_entry,
          this_element: ^clt$string_pattern_element,
          this_element_link: clt$string_pattern_element_link,
          immediate_capture: boolean;

?? NEWTITLE := 'capture', EJECT ??

{
{ PURPOSE:
{   This procedure does the actual work of capturing a matched substring.
{

        PROCEDURE capture
          (    matched_substring: clt$string_value);

{ TYPE
{   string = string

          VAR
            type_specification: [STATIC, READ, cls$declaration_section] record
              header: clt$type_specification_header,
              qualifier: clt$string_type_qualifier,
            recend := [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]];

{ TYPEND

          VAR
            c: clt$string_index,
*IF NOT $true(osv$unix)
            callers_save_area: ^ost$stack_frame_save_area,
*IFEND
            capture_command: ^clt$command_line,
            capture_command_line: ^clt$command_line,
            capture_command_line_size: integer,
            capture_value: clt$data_value,
            capture_variable: ^clt$variable_ref_expression,
            create_status: ^ost$status,
            m: clt$string_index,
            quote_count: clt$string_size;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'bad_capture_procedure_handler', EJECT ??

{
{ PURPOSE:
{   This condition handler intercepts the conditions that result from trying to
{   use a bad procedure pointer.  If one of these conditions occurs, it is
{   assumed that the CLT$STRING_PATTERN is garbled.
{

          PROCEDURE bad_capture_procedure_handler
            (    condition: pmt$condition;
                 ignore_info: ^pmt$condition_information;
                 save_area: ^ost$stack_frame_save_area;
             VAR handler_status: ost$status);


            IF (condition.selector = pmc$system_conditions) AND
                  (($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
                  pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
                  pmc$out_call_in_return] * condition.system_conditions) <> $pmt$system_conditions []) THEN
              IF save_area^.minimum_save_area.a2_previous_save_area = callers_save_area THEN
                bad_string_pattern;
              IFEND;
            IFEND;

            pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
            handler_status.normal := TRUE;

          PROCEND bad_capture_procedure_handler;
?? OLDTITLE, EJECT ??
*IFEND

          CASE this_element^.capture_kind OF

          = clc$sp_capture_via_command =
            quote_count := 0;
            FOR m := 1 TO STRLENGTH (matched_substring) DO
              IF matched_substring (m) = '''' THEN
                quote_count := quote_count + 1;
              IFEND;
            FOREND;
            capture_command := #PTR (this_element^.capture_command, pattern^);
            capture_command_line_size := STRLENGTH (capture_command^) + 2 + STRLENGTH (matched_substring) +
                  quote_count + 1;
            IF capture_command_line_size > clc$max_command_line_size THEN
              osp$set_status_condition (cle$string_too_long, status);
              EXIT clp$match_string_pattern;
            IFEND;
            PUSH capture_command_line: [capture_command_line_size];
            capture_command_line^ (1, STRLENGTH (capture_command^)) := capture_command^;
            c := STRLENGTH (capture_command^) + 1;
            capture_command_line^ (c, 2) := ' ''';
            c := c + 2;
            FOR m := 1 TO STRLENGTH (matched_substring) DO
              IF matched_substring (m) = '''' THEN
                capture_command_line^ (c) := '''';
                c := c + 1;
              IFEND;
              capture_command_line^ (c) := matched_substring (m);
              c := c + 1;
            FOREND;
            capture_command_line^ (capture_command_line_size) := '''';

*IF NOT $true(osv$unix)
            clp$include_line (capture_command_line^, FALSE {disable echoing} , osc$null_name, status);
            IF NOT status.normal THEN
              EXIT clp$match_string_pattern;
            IFEND;
*IFEND

          = clc$sp_capture_via_procedure =
*IF NOT $true(osv$unix)
            callers_save_area := #PREVIOUS_SAVE_AREA ();
            osp$establish_condition_handler (^bad_capture_procedure_handler, FALSE);
*IFEND

            this_element^.capture_procedure^ (^matched_substring, status);
            IF NOT status.normal THEN
              EXIT clp$match_string_pattern;
            IFEND;

          = clc$sp_capture_via_variable =
            capture_value.kind := clc$string;
            capture_value.string_value := ^matched_substring;
            capture_variable := #PTR (this_element^.capture_variable, pattern^);

*IF NOT $true(osv$unix)
            clp$change_variable (capture_variable^, ^capture_value, status);
            IF NOT status.normal THEN
              IF status.condition <> cle$unknown_variable THEN
                EXIT clp$match_string_pattern;
              IFEND;
              PUSH create_status;
              clp$create_procedure_variable (capture_variable^, clc$local_scope, clc$read_write,
                    clc$immediate_evaluation, #SEQ (type_specification), ^capture_value, create_status^);
              IF NOT create_status^.normal THEN
                EXIT clp$match_string_pattern;
              IFEND;
              status.normal := TRUE;
            IFEND;
*IFEND

          ELSE
            bad_string_pattern;
          CASEND;

        PROCEND capture;
?? OLDTITLE, EJECT ??

{ Search the capture stack for the entry that corresponds to this elment.

        capture_stack_entry := capture_stack;
        this_element := pattern_element;
        this_element_link := #REL (this_element, pattern^);
        WHILE (capture_stack_entry <> NIL) AND (capture_stack_entry^.end_element <> this_element_link) DO
          capture_stack_entry := capture_stack_entry^.link;
        WHILEND;

        IF capture_stack_entry = NIL THEN
          bad_string_pattern;
        IFEND;

{ Determine the index and size of the substring of the SUBJECT to be captured.

        capture_index := capture_stack_entry^.subject_index;
        capture_size := subject_index - capture_index;

        immediate_capture := pattern_element^.immediate_capture;

        IF immediate_capture THEN

{ An "immediate capture" is performed as soon as this element is reached.

          capture (subject (capture_index, capture_size));
        IFEND;

        IF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;
        ELSE

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := #PTR (pattern_element^.successor, pattern^);
          scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

          element_match_result := scan_match_info.result;
          IF element_match_result = clc$sp_failure THEN
            element_failure_reason := scan_failure_reason;
            IF (element_failure_reason = clc$sp_fail_unevaluated) AND immediate_capture THEN

{ See the discussion at the beginning of the module for how the failure reason
{ information is used.

              element_failure_reason := clc$sp_fail_immediate_capture;
            IFEND;
          IFEND;
        IFEND;

        IF (element_match_result = clc$sp_success) AND (NOT immediate_capture) THEN

{ A "conditional capture" is performed after the entire pattern has been
{ successfully matched.

          capture (subject (capture_index, capture_size));
        IFEND;

      PROCEND process_capture_end;
?? TITLE := 'process_capture_index', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_CAPTURE_INDEX element.
{

      PROCEDURE process_capture_index;

{ TYPE
{   index = integer 1..clc$max_string_size+1

        VAR
          type_specification: [STATIC, READ, cls$declaration_section] record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend := [[1, 0, clc$integer_type], [1, clc$max_string_size + 1, 10]];

{ TYPEND

        VAR
*IF NOT $true(osv$unix)
          callers_save_area: ^ost$stack_frame_save_area,
*IFEND
          capture_command: ^clt$command_line,
          capture_command_line: ^clt$command_line,
          capture_command_line_size: integer,
          capture_value: clt$data_value,
          capture_variable: ^clt$variable_ref_expression,
          create_status: ^ost$status,
          index_string: ost$string;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'bad_capture_procedure_handler', EJECT ??

{
{ PURPOSE:
{   This condition handler intercepts the conditions that result from trying to
{   use a bad procedure pointer.  If one of these conditions occurs, it is
{   assumed that the CLT$STRING_PATTERN is garbled.
{

        PROCEDURE bad_capture_procedure_handler
          (    condition: pmt$condition;
               ignore_info: ^pmt$condition_information;
               save_area: ^ost$stack_frame_save_area;
           VAR handler_status: ost$status);


          IF (condition.selector = pmc$system_conditions) AND
                (($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
                pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
                pmc$out_call_in_return] * condition.system_conditions) <> $pmt$system_conditions []) THEN
            IF save_area^.minimum_save_area.a2_previous_save_area = callers_save_area THEN
              bad_string_pattern;
            IFEND;
          IFEND;

          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
          handler_status.normal := TRUE;

        PROCEND bad_capture_procedure_handler;
?? OLDTITLE, EJECT ??
*IFEND

        CASE pattern_element^.capture_kind OF

        = clc$sp_capture_via_command =
          clp$convert_integer_to_string (subject_index, 10, FALSE, index_string, status);
          IF NOT status.normal THEN
            EXIT clp$match_string_pattern;
          IFEND;

          capture_command := #PTR (pattern_element^.capture_command, pattern^);
          capture_command_line_size := STRLENGTH (capture_command^) + 2 + index_string.size + 1;
          IF capture_command_line_size > clc$max_command_line_size THEN
            osp$set_status_condition (cle$string_too_long, status);
            EXIT clp$match_string_pattern;
          IFEND;
          PUSH capture_command_line: [capture_command_line_size];
          capture_command_line^ (1, STRLENGTH (capture_command^)) := capture_command^;
          capture_command_line^ (STRLENGTH (capture_command^) + 1, 2) := ' ''';
          capture_command_line^ (STRLENGTH (capture_command^) + 3, index_string.size) :=
                index_string.value (1, index_string.size);
          capture_command_line^ (capture_command_line_size) := '''';

*IF NOT $true(osv$unix)
          clp$include_line (capture_command_line^, FALSE {disable echoing} , osc$null_name, status);
          IF NOT status.normal THEN
            EXIT clp$match_string_pattern;
          IFEND;
*IFEND

        = clc$sp_capture_via_procedure =
          clp$convert_integer_to_string (subject_index, 10, FALSE, index_string, status);
          IF NOT status.normal THEN
            EXIT clp$match_string_pattern;
          IFEND;

*IF NOT $true(osv$unix)
          callers_save_area := #PREVIOUS_SAVE_AREA ();
          osp$establish_condition_handler (^bad_capture_procedure_handler, FALSE);
*IFEND

          pattern_element^.capture_procedure^ (^index_string.value (1, index_string.size), status);
          IF NOT status.normal THEN
            EXIT clp$match_string_pattern;
          IFEND;

        = clc$sp_capture_via_variable =
          capture_value.kind := clc$integer;
          capture_value.integer_value.value := subject_index;
          capture_value.integer_value.radix := 10;
          capture_value.integer_value.radix_specified := FALSE;
          capture_variable := #PTR (pattern_element^.capture_variable, pattern^);

*IF NOT $true(osv$unix)
          clp$change_variable (capture_variable^, ^capture_value, status);
          IF NOT status.normal THEN
            IF status.condition <> cle$unknown_variable THEN
              EXIT clp$match_string_pattern;
            IFEND;
            PUSH create_status;
            clp$create_procedure_variable (capture_variable^, clc$local_scope, clc$read_write,
                  clc$immediate_evaluation, #SEQ (type_specification), ^capture_value, create_status^);
            IF NOT create_status^.normal THEN
              EXIT clp$match_string_pattern;
            IFEND;
            status.normal := TRUE;
          IFEND;
*IFEND

        ELSE
          bad_string_pattern;
        CASEND;

        element_match_result := clc$sp_success;

      PROCEND process_capture_index;
?? TITLE := 'process_characters', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_CHARACTERS element.
{
{ NOTE:
{   The character set for this pattern element must actually be the complement
{   of the set originally specified.  This is because the #SCAN intrinsic is
{   used to skip over characters which are not in the set.
{

      PROCEDURE [INLINE] process_characters;

        VAR
          characters: ^clt$string_pattern_characters,
          scan_found_char: boolean,
          scan_index: clt$string_index;


        IF remaining_subject_size < pattern_element^.count THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          characters := #PTR (pattern_element^.characters, pattern^);
          #SCAN (characters^, subject (subject_index, * ), scan_index, scan_found_char);
          IF scan_index > pattern_element^.count THEN
            element_match_result := clc$sp_success;
            subject_index := subject_index + scan_index - 1;
          ELSE
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
          IFEND;
        IFEND;

      PROCEND process_characters;
?? TITLE := 'process_count', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_COUNT element.
{

      PROCEDURE [INLINE] process_count;

        VAR
          excluded_characters: ^clt$string_pattern_characters,
          max_subject_index: clt$string_index;


        IF pattern_element^.characters = NIL THEN
          max_subject_index := STRLENGTH (subject) + 1;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          excluded_characters := #PTR (pattern_element^.characters, pattern^);
          #SCAN (excluded_characters^, subject (subject_index, * ), scan_index, scan_found_char);
          max_subject_index := subject_index + scan_index - 1;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

        IF (max_subject_index - subject_index) < pattern_element^.count THEN
          element_match_result := clc$sp_failure;

{ element_failure_reason established above

        ELSE
          element_match_result := clc$sp_success;
          subject_index := subject_index + pattern_element^.count;
        IFEND;

      PROCEND process_count;
?? TITLE := 'process_count_test_left', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_COUNT_TEST_LEFT element.
{

      PROCEDURE [INLINE] process_count_test_left;


        IF (subject_index - 1) = pattern_element^.count THEN
          element_match_result := clc$sp_success;
        ELSEIF (subject_index - 1) > pattern_element^.count THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

      PROCEND process_count_test_left;
?? TITLE := 'process_count_test_right', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_COUNT_TEST_RIGHT element.
{

      PROCEDURE [INLINE] process_count_test_right;


        IF remaining_subject_size = pattern_element^.count THEN
          element_match_result := clc$sp_success;
        ELSEIF remaining_subject_size < pattern_element^.count THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

      PROCEND process_count_test_right;
?? TITLE := 'process_fail_element', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_FAIL_ELEMENT element.
{

      PROCEDURE [INLINE] process_fail_element;


        element_match_result := clc$sp_failure;
        element_failure_reason := clc$sp_fail_match;

      PROCEND process_fail_element;
?? TITLE := 'process_fail_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_FAIL_PATTERN element.
{
{ NOTE:
{   This element terminates the entire string matching process.
{

      PROCEDURE [INLINE] process_fail_pattern;


        match_info.result := clc$sp_failure;
        EXIT clp$match_string_pattern;

      PROCEND process_fail_pattern;
?? TITLE := 'process_fence', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_FENCE element.
{
{ NOTE:
{   This element terminates the entire string matching process if it is
{   backed into with failure.
{

      PROCEDURE process_fence;


        IF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;
          RETURN;
        IFEND;

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

        pattern_element := #PTR (pattern_element^.successor, pattern^);
        scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

        IF scan_match_info.result = clc$sp_success THEN
          element_match_result := clc$sp_success;
          RETURN;
        IFEND;

        match_info.result := clc$sp_failure;
        EXIT clp$match_string_pattern;

      PROCEND process_fence;
?? TITLE := 'process_multiple', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_MULTIPLE element.
{
{ NOTE:
{   This element has implied alternatives.  If it is backed into with failure
{   it increases the number of characters it matches and retries its
{   successors.
{

      PROCEDURE process_multiple;

        VAR
          excluded_characters: ^clt$string_pattern_characters,
          local_failure_reason: clt$string_pattern_fail_reason,
          local_match_info: clt$string_pattern_match_info,
          local_subject_index: clt$string_index,
          look_for_characters: ^clt$string_pattern_characters,
          max_subject_index: clt$string_index,
          min_count: clt$string_size,
          min_successor_size: clt$string_size,
          successor_characters: ^clt$string_pattern_characters,
          successor_pattern_element: ^clt$string_pattern_element,
          successor_string_literal: ^clt$string_value;


        min_count := pattern_element^.count;

        IF pattern_element^.characters = NIL THEN
          max_subject_index := STRLENGTH (subject) + 1;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          excluded_characters := #PTR (pattern_element^.characters, pattern^);
          #SCAN (excluded_characters^, subject (subject_index, * ), scan_index, scan_found_char);
          max_subject_index := subject_index + scan_index - 1;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

        IF (max_subject_index - subject_index) < min_count THEN
          element_match_result := clc$sp_failure;

{ element_failure_reason established above

          RETURN;
        ELSEIF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;
          subject_index := max_subject_index;
          RETURN;
        IFEND;

        successor_pattern_element := #PTR (pattern_element^.successor, pattern^);
        min_successor_size := min_subject_size (successor_pattern_element);

{ Examine the successor element to determine whether a look ahead can be done
{ for the first character matched by the successor.

        look_for_characters := NIL;
        IF successor_pattern_element^.alternative = NIL THEN
          CASE successor_pattern_element^.kind OF
          = clc$sp_characters =
            IF successor_pattern_element^.count >= 1 THEN
              PUSH look_for_characters;
              successor_characters := #PTR (successor_pattern_element^.characters, pattern^);
              look_for_characters^ := -successor_characters^;
            IFEND;
          = clc$sp_one_character =
            look_for_characters := #PTR (successor_pattern_element^.characters, pattern^);
          = clc$sp_string_literal =
            PUSH look_for_characters;
            successor_string_literal := #PTR (successor_pattern_element^.string_literal, pattern^);
            IF successor_pattern_element^.case_sensitive THEN
              look_for_characters^ := $clt$string_pattern_characters [successor_string_literal^ (1)];
            ELSE
              look_for_characters^ := $clt$string_pattern_characters
                    [osv$lower_to_upper ($INTEGER (successor_string_literal^ (1)) + 1),
                    osv$upper_to_lower ($INTEGER (successor_string_literal^ (1)) + 1)];
            IFEND;
          ELSE
            ;
          CASEND;
        IFEND;

        local_subject_index := subject_index + min_count;
        IF look_for_characters <> NIL THEN

{ If the look ahead can be done, use the #SCAN intrinsic to do it.

          #SCAN (look_for_characters^, subject (local_subject_index, * ), scan_index, scan_found_char);
          local_subject_index := local_subject_index + scan_index - 1;
          IF (NOT scan_found_char) OR (local_subject_index > max_subject_index) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;
        IFEND;

        WHILE TRUE DO
          IF (scan_option = clc$sp_quick_scan) AND ((max_subject_index - local_subject_index + 1) <
                min_successor_size) THEN
            element_match_result := clc$sp_failure;

{ element_failure_reason established above

            RETURN;
          IFEND;

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := successor_pattern_element;
          scan_string_pattern (pattern, local_subject_index, pattern_element, local_failure_reason,
                local_match_info);

          IF local_match_info.result = clc$sp_success THEN
            element_match_result := clc$sp_success;
            subject_index := local_subject_index;
            RETURN;
          ELSEIF scan_option = clc$sp_quick_scan THEN
            IF local_failure_reason <> clc$sp_fail_match THEN
              element_match_result := clc$sp_failure;
              element_failure_reason := local_failure_reason;
              RETURN;
            IFEND;
          IFEND;
          IF local_subject_index >= max_subject_index THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;

{ Match more characters then retry the successor.

          local_subject_index := local_subject_index + 1;
          IF look_for_characters <> NIL THEN
            #SCAN (look_for_characters^, subject (local_subject_index, * ), scan_index, scan_found_char);
            local_subject_index := local_subject_index + scan_index - 1;
            IF (NOT scan_found_char) OR (local_subject_index > max_subject_index) THEN
              element_match_result := clc$sp_failure;
              element_failure_reason := clc$sp_fail_match;
              RETURN;
            IFEND;
          IFEND;
        WHILEND;

      PROCEND process_multiple;
?? TITLE := 'process_multiple_path_elements', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_MULTIPLE_PATH_ELEMENTS element.
{
{ NOTE:
{   If this element is used at the end of a pattern, its MIN_SUBJECT_SIZE
{   is zero and it matches the null string or a "." followed by anything.
{   When it used other than at the end of a pattern, it has implied
{   alternatives.  Initially is matches a single ".".  If it is backed into
{   with failure it matches up to and including the next "." and retries its
{   successors.
{

      PROCEDURE process_multiple_path_elements;

        VAR
          local_failure_reason: clt$string_pattern_fail_reason,
          local_match_info: clt$string_pattern_match_info,
          local_subject_index: clt$string_index,
          min_successor_size: clt$string_size,
          path_element_separator: [STATIC, READ, oss$job_paged_literal] clt$string_pattern_characters :=
                [clc$wc_path_element_separator],
          successor_pattern_element: ^clt$string_pattern_element;


        IF pattern_element^.min_subject_size = 0 THEN
          IF (remaining_subject_size = 0) OR (subject (subject_index) = '.') THEN
            element_match_result := clc$sp_success;
            subject_index := STRLENGTH (subject) + 1;
          ELSE
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
          IFEND;
          RETURN;
        ELSEIF remaining_subject_size = 0 THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
          RETURN;
        ELSEIF subject (subject_index) <> clc$wc_path_element_separator THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
          RETURN;
        IFEND;

        successor_pattern_element := #PTR (pattern_element^.successor, pattern^);
        min_successor_size := min_subject_size (successor_pattern_element);

        local_subject_index := subject_index + 1;

        WHILE TRUE DO
          IF (scan_option = clc$sp_quick_scan) AND ((STRLENGTH (subject) - local_subject_index + 1) <
                min_successor_size) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_size;
            RETURN;
          IFEND;

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := successor_pattern_element;
          scan_string_pattern (pattern, local_subject_index, pattern_element, local_failure_reason,
                local_match_info);

          IF local_match_info.result = clc$sp_success THEN
            element_match_result := clc$sp_success;
            subject_index := local_subject_index;
            RETURN;
          ELSEIF scan_option = clc$sp_quick_scan THEN
            IF local_failure_reason <> clc$sp_fail_match THEN
              element_match_result := clc$sp_failure;
              element_failure_reason := local_failure_reason;
              RETURN;
            IFEND;
          ELSEIF local_subject_index >= STRLENGTH (subject) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;

{ Match next path element then retry the successor.

          #SCAN (path_element_separator, subject (local_subject_index, * ), scan_index, scan_found_char);
          IF NOT scan_found_char THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;
          local_subject_index := local_subject_index + scan_index;
        WHILEND;

      PROCEND process_multiple_path_elements;
?? TITLE := 'process_one_character', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_ONE_CHARACTER element.
{

      PROCEDURE [INLINE] process_one_character;

        VAR
          characters: ^clt$string_pattern_characters;


        IF remaining_subject_size < 1 THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          characters := #PTR (pattern_element^.characters, pattern^);
          IF subject (subject_index) IN characters^ THEN
            element_match_result := clc$sp_success;
            subject_index := subject_index + 1;
          ELSE
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
          IFEND;
        IFEND;

      PROCEND process_one_character;
?? TITLE := 'process_repeat_pattern_begin', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_REPEAT_PATTERN_BEGIN element.
{
{ DESIGN:
{   See the discussion at the beginning of CLP$MATCH_STRING_PATTERN for
{   information on how this processor works in conjunction with the processor
{   for the CLC$SP_REPEAT_PATTERN_END element.
{
{ NOTE:
{   The SUCCESSOR of a CLC$SP_REPEAT_PATTERN_BEGIN element is the corresponding
{   CLC$SP_REPEAT_PATTERN_END element.  The first element of the pattern to be
{   repeated is the ALTERNATIVE of the CLC$SP_REPEAT_PATTERN_END element.  The
{   CLC$SP_REPEAT_PATTERN_END element is also the successor of the repeatable
{   pattern.
{

      PROCEDURE process_repeat_pattern_begin;

        VAR
          repeat_pattern_stack_entry: clt$repeat_pattern_stack_entry;


{ "Push" an entry onto the repeat pattern stack.

        repeat_pattern_stack_entry.link := repeat_pattern_stack;
        repeat_pattern_stack_entry.end_element := pattern_element^.successor;
        repeat_pattern_stack_entry.count := 0;
        repeat_pattern_stack_entry.match_attempted := FALSE;
        repeat_pattern_stack_entry.subject_index := subject_index;

{ The following assignment will cause a "pointer lifetime" warning from CYBIL.
{ This is OK!

        repeat_pattern_stack := ^repeat_pattern_stack_entry;

        IF pattern_element^.successor = NIL THEN
          bad_string_pattern;
        IFEND;
        pattern_element := #PTR (pattern_element^.successor, pattern^);
        IF pattern_element^.kind <> clc$sp_repeat_pattern_end THEN
          bad_string_pattern;
        IFEND;

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

        scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

        element_match_result := scan_match_info.result;
        IF element_match_result = clc$sp_failure THEN
          element_failure_reason := scan_failure_reason;
        IFEND;

{ "Pop" the repeat pattern stack entry that was "pushed" above.

        repeat_pattern_stack := repeat_pattern_stack_entry.link;

      PROCEND process_repeat_pattern_begin;
?? TITLE := 'process_repeat_pattern_end', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_REPEAT_PATTERN_END element.
{
{ DESIGN:
{   See the discussion at the beginning of CLP$MATCH_STRING_PATTERN for
{   information on how this processor works in conjunction with the processor
{   for the CLC$SP_REPEAT_PATTERN_BEGIN element.
{
{ NOTE:
{   The SUCCESSOR of a CLC$SP_REPEAT_PATTERN_BEGIN element is the corresponding
{   CLC$SP_REPEAT_PATTERN_END element.  The first element of the pattern to be
{   repeated is the ALTERNATIVE of the CLC$SP_REPEAT_PATTERN_END element.  The
{   CLC$SP_REPEAT_PATTERN_END element is also the successor of the repeatable
{   pattern.
{

      PROCEDURE process_repeat_pattern_end;

        VAR
          this_element_link: clt$string_pattern_element_link,
          repeat_pattern_stack_entry: ^clt$repeat_pattern_stack_entry;


{ Search the repeat pattern stack for the entry that corresponds to this elment.

        IF pattern_element^.alternative = NIL THEN
          bad_string_pattern;
        IFEND;

        this_element_link := #REL (pattern_element, pattern^);
        repeat_pattern_stack_entry := repeat_pattern_stack;
        WHILE (repeat_pattern_stack_entry <> NIL) AND (repeat_pattern_stack_entry^.end_element <>
              this_element_link) DO
          repeat_pattern_stack_entry := repeat_pattern_stack_entry^.link;
        WHILEND;

        IF repeat_pattern_stack_entry = NIL THEN
          bad_string_pattern;
        IFEND;

        IF repeat_pattern_stack_entry^.count < pattern_element^.count THEN

{ The repeatable pattern hasn't yet been matched the minimum number of times
{ so try to match it again.

          IF (alternative_pattern_element = NIL) OR (repeat_pattern_stack_entry^.match_attempted AND
                (scan_option = clc$sp_quick_scan) AND (subject_index =
                repeat_pattern_stack_entry^.subject_index)) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            alternative_pattern_element := NIL;

          ELSE
            repeat_pattern_stack_entry^.match_attempted := TRUE;
            repeat_pattern_stack_entry^.subject_index := subject_index;
            repeat_pattern_stack_entry^.count := repeat_pattern_stack_entry^.count + 1;

{ Call the main scan procedure to deal with this element's alternative which is
{ the first element of the repeatable pattern.

            pattern_element := alternative_pattern_element;
            scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason,
                  scan_match_info);

            element_match_result := scan_match_info.result;
            IF element_match_result = clc$sp_failure THEN
              element_failure_reason := scan_failure_reason;
              repeat_pattern_stack_entry^.count := repeat_pattern_stack_entry^.count - 1;
            IFEND;
          IFEND;

        ELSEIF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;

        ELSE

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := #PTR (pattern_element^.successor, pattern^);
          scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

          IF scan_match_info.result = clc$sp_success THEN
            element_match_result := clc$sp_success;
            RETURN;
          ELSEIF scan_option = clc$sp_quick_scan THEN
            IF scan_failure_reason <> clc$sp_fail_match THEN
              element_match_result := clc$sp_failure;
              element_failure_reason := scan_failure_reason;
              RETURN;
            IFEND;
          ELSEIF subject_index > STRLENGTH (subject) THEN
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
            RETURN;
          IFEND;

          repeat_pattern_stack_entry^.match_attempted := TRUE;
          repeat_pattern_stack_entry^.subject_index := subject_index;
          repeat_pattern_stack_entry^.count := repeat_pattern_stack_entry^.count + 1;

{ Call the main scan procedure to deal with this element's alternative which is
{ the first element of the repeatable pattern.

          pattern_element := alternative_pattern_element;
          scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);

          element_match_result := scan_match_info.result;
          IF element_match_result = clc$sp_failure THEN
            element_failure_reason := scan_failure_reason;
            repeat_pattern_stack_entry^.count := repeat_pattern_stack_entry^.count - 1;
          IFEND;
        IFEND;

      PROCEND process_repeat_pattern_end;
?? TITLE := 'process_stacked_successor', EJECT ??

{
{ PURPOSE:
{   This procedure deals with scanning the successor of a
{   CLC$SP_UNEVALUATED_PATTERN element.
{

      PROCEDURE process_stacked_successor;

        VAR
          local_match_info: clt$string_pattern_match_info,
          successor_element: ^clt$string_pattern_element,
          successor_pattern: ^clt$string_pattern;


        IF (successor_stack = NIL) OR (NOT successor_stack^.process) THEN
          RETURN;
        IFEND;

        successor_pattern := successor_stack^.pattern;
        successor_element := #PTR (successor_stack^.element, successor_pattern^);
        successor_stack^.process := FALSE;

        scan_string_pattern (successor_pattern, subject_index, successor_element, element_failure_reason,
              local_match_info);
        element_match_result := local_match_info.result;

        successor_stack^.process := element_match_result = clc$sp_failure;

      PROCEND process_stacked_successor;
?? TITLE := 'process_string_literal', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_STRING_LITERAL element.
{

      PROCEDURE [INLINE] process_string_literal;

        VAR
          string_literal: ^clt$string_value;


        string_literal := #PTR (pattern_element^.string_literal, pattern^);
        IF remaining_subject_size < STRLENGTH (string_literal^) THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSEIF pattern_element^.case_sensitive THEN
          IF subject (subject_index, STRLENGTH (string_literal^)) = string_literal^ THEN
            element_match_result := clc$sp_success;
            subject_index := subject_index + STRLENGTH (string_literal^);
          ELSE
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
          IFEND;
        ELSE
*IF NOT $true(osv$unix)
          IF i#compare_collated (subject (subject_index, STRLENGTH (string_literal^)), string_literal^,
                osv$lower_to_upper) = 0 THEN
            element_match_result := clc$sp_success;
            subject_index := subject_index + STRLENGTH (string_literal^);
          ELSE
*IFEND
            element_match_result := clc$sp_failure;
            element_failure_reason := clc$sp_fail_match;
*IF NOT $true(osv$unix)
          IFEND;
*IFEND
        IFEND;

      PROCEND process_string_literal;
?? TITLE := 'process_succeed_forced', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_SUCCEED_FORCED element.
{
{ NOTE:
{   This processor never gives up.  If it is backed into with failure, it
{   tries again.
{

      PROCEDURE process_succeed_forced;

        VAR
          successor_pattern_element: ^clt$string_pattern_element;


        IF pattern_element^.successor = NIL THEN
          element_match_result := clc$sp_success;
          RETURN;
        IFEND;

        successor_pattern_element := #PTR (pattern_element^.successor, pattern^);

        REPEAT

{ Call the main scan procedure to deal with this element's successors in order
{ to gain control when the scanning process backs up.

          pattern_element := successor_pattern_element;
          scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, scan_match_info);
        UNTIL scan_match_info.result = clc$sp_success;

        element_match_result := clc$sp_success;

      PROCEND process_succeed_forced;
?? TITLE := 'process_succeed_passive', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_SUCCEED_PASSIVE element.
{

      PROCEDURE [INLINE] process_succeed_passive;


        element_match_result := clc$sp_success;

      PROCEND process_succeed_passive;
?? TITLE := 'process_test', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_TEST element.
{

      PROCEDURE process_test;

{ TYPE
{   test = boolean

        VAR
          boolean_type_spec: [STATIC, READ, cls$declaration_section] record
            header: clt$type_specification_header,
          recend := [[1, 0, clc$boolean_type]];

{ TYPEND

        VAR
          expression_result: ^clt$data_value,
*IF $true(osv$unix)
          handler_established: boolean,
*IFEND
          original_work_area: ^clt$work_area,
          test_expression: ^clt$expression_text,
          work_area: ^^clt$work_area;

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

{
{ PURPOSE:
{   This block exit condition handler is established to ensure that the work
{   area pointer is reset to its original value.
{

        PROCEDURE abort_handler
*IF $true(osv$unix)
          (    signal_no: integer;
               code: integer;
               p_sigcontext: ^cyt$mips_sigcontext);
*ELSE
          (    condition: pmt$condition;
               ignore_info: ^pmt$condition_information;
               save_area: ^ost$stack_frame_save_area;
           VAR handler_status: ost$status);
*IFEND

          work_area^ := original_work_area;

        PROCEND abort_handler;
?? OLDTITLE, EJECT ??

{ Get a work area to use for evaluating the test expression.

*IF NOT $true(osv$unix)
        clp$get_work_area (#RING (^work_area), work_area, status);
*ELSE
        clp$get_work_area (#OFFSET (^work_area), work_area, status);
*IFEND
        IF NOT status.normal THEN
          EXIT clp$match_string_pattern;
        IFEND;
        original_work_area := work_area^;

        #SPOIL (original_work_area);
*IF $true(osv$unix)
        handler_established := #establish_condition_handler (-1, ^abort_handler);
*ELSE
        osp$establish_block_exit_hndlr (^abort_handler);
*IFEND

{ Evaluate the test expression.

        test_expression := #PTR (pattern_element^.test_expression, pattern^);
        clp$evaluate_expression (test_expression^, #SEQ (boolean_type_spec), work_area^, expression_result,
              status);
        IF status.normal AND expression_result^.boolean_value.value THEN
          element_match_result := clc$sp_success;
        ELSE
          status.normal := TRUE;
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

{ release the work area

        work_area^ := original_work_area;
*IF $true(osv$unix)
        IF handler_established THEN
          handler_established := NOT #disestablish_condition_handler (-1);
        IFEND;
*ELSE
        osp$disestablish_cond_handler;
*IFEND

      PROCEND process_test;
?? TITLE := 'process_unevaluated_pattern', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_UNEVALUATED_PATTERN element.
{

      PROCEDURE process_unevaluated_pattern;

{ TYPE
{   unevaluated_pattern = string_pattern

        VAR
          string_pattern_type_spec: [STATIC, READ, cls$declaration_section] record
            header: clt$type_specification_header,
          recend := [[1, 0, clc$string_pattern_type]];

{ TYPEND

        VAR
          expression_result: ^clt$data_value,
*IF $true(osv$unix)
          handler_established: boolean,
*IFEND
          original_work_area: ^clt$work_area,
          sub_pattern: ^clt$string_pattern,
          sub_pattern_element: ^clt$string_pattern_element,
          sub_pattern_header: ^clt$string_pattern_header,
          successor_stack_entry: clt$successor_stack_entry,
          unevaluated_expression: ^clt$expression_text,
          work_area: ^^clt$work_area;

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

{
{ PURPOSE:
{   This block exit condition handler is established to ensure that the work
{   area pointer is reset to its original value.
{

        PROCEDURE abort_handler
*IF $true(osv$unix)
          (    signal_no: integer;
               code: integer;
               p_sigcontext: ^cyt$mips_sigcontext);
*ELSE
          (    condition: pmt$condition;
               ignore_info: ^pmt$condition_information;
               save_area: ^ost$stack_frame_save_area;
           VAR handler_status: ost$status);
*IFEND


          work_area^ := original_work_area;

        PROCEND abort_handler;
?? OLDTITLE, EJECT ??

{ Get a work area to use for evaluating the string pattern.

*IF NOT $true(osv$unix)
        clp$get_work_area (#RING (^work_area), work_area, status);
*ELSE
        clp$get_work_area (#OFFSET (^work_area), work_area, status);
*IFEND
        IF NOT status.normal THEN
          EXIT clp$match_string_pattern;
        IFEND;
        original_work_area := work_area^;

        #SPOIL (original_work_area);
*IF $true(osv$unix)
        handler_established := #establish_condition_handler (-1, ^abort_handler);
*ELSE
        osp$establish_block_exit_hndlr (^abort_handler);
*IFEND

{ Evaluate the string pattern.

        unevaluated_expression := #PTR (pattern_element^.unevaluated_pattern, pattern^);
        clp$evaluate_expression (unevaluated_expression^, #SEQ (string_pattern_type_spec), work_area^,
              expression_result, status);
        IF NOT status.normal THEN
          status.normal := TRUE;
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
          RETURN;
        IFEND;

{ Copy the evaluated string pattern to this procedures stack frame in order to
{ release the work area.

        PUSH sub_pattern: [[REP #SIZE (expression_result^.string_pattern_value^) OF cell]];
        sub_pattern^ := expression_result^.string_pattern_value^;

        work_area^ := original_work_area;
*IF $true(osv$unix)
        IF handler_established THEN
          handler_established := NOT #disestablish_condition_handler (-1);
        IFEND;
*ELSE
        osp$disestablish_cond_handler;
*IFEND


        open_string_pattern (sub_pattern, sub_pattern_header, sub_pattern_element, status);
        IF NOT status.normal THEN
          EXIT clp$match_string_pattern;
        ELSEIF sub_pattern_header^.initial_element = NIL THEN
          element_match_result := clc$sp_success;
          RETURN;
        IFEND;

{ "Push" an entry onto the successor stack.

        successor_stack_entry.link := successor_stack;
        successor_stack_entry.process := TRUE;
        successor_stack_entry.pattern := pattern;
        successor_stack_entry.element := pattern_element^.successor;

{ The following assignment will cause a "pointer lifetime" warning from CYBIL.
{ This is OK!

        successor_stack := ^successor_stack_entry;

{ Call the main scan procedure to deal with the sub-pattern.

        scan_string_pattern (sub_pattern, subject_index, sub_pattern_element, scan_failure_reason,
              scan_match_info);

        element_match_result := scan_match_info.result;
        IF element_match_result = clc$sp_failure THEN
          element_failure_reason := scan_failure_reason;
          IF element_failure_reason = clc$sp_fail_size THEN

{ See the discussion at the beginning of the module for how the failure reason
{ information is used.

            element_failure_reason := clc$sp_fail_unevaluated;
          IFEND;
        IFEND;

{ "Pop" the successor stack entry that was "pushed" above.

        successor_stack := successor_stack_entry.link;

      PROCEND process_unevaluated_pattern;
?? TITLE := 'process_upto_character', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_UPTO_CHARACTER element.
{

      PROCEDURE [INLINE] process_upto_character;

        VAR
          characters: ^clt$string_pattern_characters,
          scan_found_char: boolean,
          scan_index: clt$string_index;


        characters := #PTR (pattern_element^.characters, pattern^);
        #SCAN (characters^, subject (subject_index, * ), scan_index, scan_found_char);
        IF scan_found_char THEN
          element_match_result := clc$sp_success;
          subject_index := subject_index + scan_index - 1;
        ELSE
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_match;
        IFEND;

      PROCEND process_upto_character;
?? TITLE := 'process_upto_count_from_left', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_UPTO_COUNT_FROM_LEFT element.
{

      PROCEDURE [INLINE] process_upto_count_from_left;


        IF (subject_index - 1) > pattern_element^.count THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          element_match_result := clc$sp_success;
          subject_index := pattern_element^.count + 1;
        IFEND;

      PROCEND process_upto_count_from_left;
?? TITLE := 'process_upto_count_from_right', EJECT ??

{
{ PURPOSE:
{   This is the processor for a CLC$SP_UPTO_COUNT_FROM_RIGHT element.
{

      PROCEDURE [INLINE] process_upto_count_from_right;


        IF remaining_subject_size < pattern_element^.count THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE
          element_match_result := clc$sp_success;
          subject_index := STRLENGTH (subject) - pattern_element^.count + 1;
        IFEND;

      PROCEND process_upto_count_from_right;
?? OLDTITLE, EJECT ??

      scan_match_info.result := clc$sp_success;
      original_subject_index := subject_index;

    /scan/
      WHILE TRUE DO
        remaining_subject_size := STRLENGTH (subject) - subject_index + 1;

{ Setup for handling an alternative.

        IF (pattern_element^.alternative <> NIL) AND ((scan_option = clc$sp_full_scan) OR
              (remaining_subject_size >= pattern_element^.alternative_min_subject_size)) THEN
          alternative_pattern_element := #PTR (pattern_element^.alternative, pattern^);
          local_subject_index := subject_index;
        ELSE
          alternative_pattern_element := NIL;
        IFEND;

        IF (scan_option = clc$sp_quick_scan) AND (remaining_subject_size < pattern_element^.min_subject_size)
              THEN
          element_match_result := clc$sp_failure;
          element_failure_reason := clc$sp_fail_size;
        ELSE

{ Match a pattern element.

          CASE pattern_element^.kind OF
          = clc$sp_balanced_pair =
            process_balanced_pair;
          = clc$sp_capture_begin =
            process_capture_begin;
          = clc$sp_capture_end =
            process_capture_end;
          = clc$sp_capture_index =
            process_capture_index;
          = clc$sp_characters =
            process_characters;
          = clc$sp_count =
            process_count;
          = clc$sp_count_test_left =
            process_count_test_left;
          = clc$sp_count_test_right =
            process_count_test_right;
          = clc$sp_fail_element =
            process_fail_element;
          = clc$sp_fail_pattern =
            process_fail_pattern;
          = clc$sp_fence =
            process_fence;
          = clc$sp_multiple =
            process_multiple;
          = clc$sp_multiple_path_elements =
            process_multiple_path_elements;
          = clc$sp_one_character =
            process_one_character;
          = clc$sp_repeat_pattern_begin =
            process_repeat_pattern_begin;
          = clc$sp_repeat_pattern_end =
            process_repeat_pattern_end;
          = clc$sp_string_literal =
            process_string_literal;
          = clc$sp_succeed_forced =
            process_succeed_forced;
          = clc$sp_succeed_passive =
            process_succeed_passive;
          = clc$sp_test =
            process_test;
          = clc$sp_unevaluated_pattern =
            process_unevaluated_pattern;
          = clc$sp_upto_character =
            process_upto_character;
          = clc$sp_upto_count_from_left =
            process_upto_count_from_left;
          = clc$sp_upto_count_from_right =
            process_upto_count_from_right;
          ELSE
            bad_string_pattern;
          CASEND;
        IFEND;

        IF (element_match_result = clc$sp_success) AND (pattern_element^.successor = NIL) AND
              (successor_stack <> NIL) THEN
          process_stacked_successor;
        IFEND;

        IF element_match_result = clc$sp_success THEN
          scan_match_info.result := clc$sp_success;

          IF (pattern_element^.successor = NIL) OR (pattern_element^.kind = clc$sp_unevaluated_pattern) THEN

{ Terminate with success.
{
{ Note that the processor for CLC$SP_UNEVALUATED_PATTERNs has arranged to have
{ all of its successors scanned via the successor stack.

            scan_match_info.index := original_subject_index;
            scan_match_info.size := subject_index - original_subject_index;
            RETURN;
          IFEND;

{ Continue with the successor element.

          pattern_element := #PTR (pattern_element^.successor, pattern^);

          IF alternative_pattern_element = NIL THEN
            CYCLE /scan/;
          IFEND;

{ If this element has an alternative, its successor must be processed via
{ another call so we can back up to deal with the alternative.

          scan_string_pattern (pattern, subject_index, pattern_element, element_failure_reason,
                local_match_info);
          IF local_match_info.result = clc$sp_success THEN

{ Terminate with success.

            scan_match_info.result := clc$sp_success;
            scan_match_info.index := original_subject_index;
            scan_match_info.size := subject_index - original_subject_index;
            RETURN;
          IFEND;

          element_match_result := clc$sp_failure;
        IFEND;

{ Merge this element's failure reason with the overall failure reason.

        IF scan_match_info.result = clc$sp_success THEN
          scan_match_info.result := clc$sp_failure;
          scan_failure_reason := element_failure_reason;
        ELSEIF (scan_failure_reason = clc$sp_fail_match) OR (element_failure_reason = clc$sp_fail_match) THEN
          scan_failure_reason := clc$sp_fail_match;
        ELSEIF element_failure_reason = clc$sp_fail_immediate_capture THEN
          scan_failure_reason := clc$sp_fail_immediate_capture;
        IFEND;

        IF alternative_pattern_element = NIL THEN

{ Terminate with failure.

          subject_index := original_subject_index;
          RETURN;
        IFEND;

{ Continue with the alternative element.

        pattern_element := alternative_pattern_element;
        subject_index := local_subject_index;
      WHILEND /scan/;

    PROCEND scan_string_pattern;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    open_string_pattern (pattern, pattern_header, initial_pattern_element, status);
    IF NOT status.normal THEN
      RETURN;
    ELSEIF initial_pattern_element = NIL THEN
      match_info.result := clc$sp_success;
      match_info.index := 1;
      match_info.size := 0;
      RETURN;
    IFEND;

    capture_stack := NIL;
    repeat_pattern_stack := NIL;
    successor_stack := NIL;

{ For an unanchored scan, examine the initial element to determine whether a
{ look ahead can be done for the first character matched by the initial
{ element.

    look_for_initial_characters := NIL;
    IF (anchor_option = clc$sp_unanchored) AND (initial_pattern_element^.alternative = NIL) THEN
      CASE initial_pattern_element^.kind OF
      = clc$sp_characters =
        IF initial_pattern_element^.count >= 1 THEN
          PUSH look_for_initial_characters;
          initial_characters := #PTR (initial_pattern_element^.characters, pattern^);
          look_for_initial_characters^ := -initial_characters^;
        IFEND;
      = clc$sp_one_character =
        look_for_initial_characters := #PTR (initial_pattern_element^.characters, pattern^);
      = clc$sp_string_literal =
        PUSH look_for_initial_characters;
        initial_string_literal := #PTR (initial_pattern_element^.string_literal, pattern^);
        look_for_initial_characters^ := $clt$string_pattern_characters
              [osv$lower_to_upper ($INTEGER (initial_string_literal^ (1)) + 1),
              osv$upper_to_lower ($INTEGER (initial_string_literal^ (1)) + 1)];
      ELSE
        ;
      CASEND;
    IFEND;

    IF look_for_initial_characters = NIL THEN
      subject_index := 1;
    ELSE

{ If the look ahead can be done, use the #SCAN intrinsic to do it.

      #SCAN (look_for_initial_characters^, subject, scan_index, scan_found_char);
      IF NOT scan_found_char THEN
        match_info.result := clc$sp_failure;
        RETURN;
      IFEND;
      subject_index := scan_index;
    IFEND;

    WHILE TRUE DO
      IF (scan_option = clc$sp_quick_scan) AND ((STRLENGTH (subject) - subject_index + 1) <
            min_subject_size (initial_pattern_element)) THEN
        match_info.result := clc$sp_failure;
        RETURN;
      IFEND;

      pattern_element := initial_pattern_element;
      scan_string_pattern (pattern, subject_index, pattern_element, scan_failure_reason, match_info);

      IF (match_info.result = clc$sp_success) OR (anchor_option = clc$sp_anchored) THEN
        RETURN;
      ELSEIF scan_option = clc$sp_quick_scan THEN
        IF (scan_failure_reason <> clc$sp_fail_match) OR ((STRLENGTH (subject) - subject_index) <
              min_subject_size (initial_pattern_element)) THEN
          RETURN;
        IFEND;
      ELSE {scan_option = clc$sp_full_scan}
        IF subject_index >= STRLENGTH (subject) THEN
          RETURN;
        IFEND;
      IFEND;

{ Skip over more characters then retry the pattern.

      subject_index := subject_index + 1;
      IF look_for_initial_characters <> NIL THEN
        #SCAN (look_for_initial_characters^, subject (subject_index, * ), scan_index, scan_found_char);
        IF NOT scan_found_char THEN
          match_info.result := clc$sp_failure;
          RETURN;
        IFEND;
        subject_index := subject_index + scan_index - 1;
      IFEND;
    WHILEND;

  PROCEND clp$match_string_pattern;
?? TITLE := 'clp$sp_balanced_pair', EJECT ??

{
{   This request builds a string pattern that matches a string balanced
{ with respect to a pair of characters.
{
{       CLP$SP_BALANCED_PAIR (LEFT_CHARACTER, RIGHT_CHARACTER, WORK_AREA,
{         PATTERN, STATUS)
{
{ LEFT_CHARACTER: (input)  This parameter specifies the left character of the
{       pair to be balanced
{
{ RIGHT_CHARACTER: (input)  This parameter specifies the right character of the
{       pair to be balanced
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_balanced_pair
    (    left_character: char;
         right_character: char;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) OF cell]] IN
          work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := clc$sp_balanced_pair;
    pattern_element^.left_character := left_character;
    pattern_element^.right_character := right_character;
    pattern_element^.min_subject_size := 1;

    RESET pattern;

  PROCEND clp$sp_balanced_pair;
?? TITLE := 'clp$sp_capture_index', EJECT ??

{
{   This request creates a string pattern that captures the current substring
{ index when is is encountered during pattern matching.
{
{       CLP$SP_CAPTURE_INDEX (CAPTURE, WORK_AREA, PATTERN, STATUS)
{
{ CAPTURE: (input)  This parameter specified how the capture is to be
{       accomplished.  The IMMEDIATE field is ignored for this request.
{       The KIND field specifies how the capturing is to be done.
{
{       CLC$SP_CAPTURE_VIA_PROCEDURE: specifies that the subject index is
{             passed to the PROCedure as a string.
{
{       CLC$SP_CAPTURE_VIA_VARIABLE: specifies that the subject index is
{             written into the VARIABLE.
{
{       CLC$SP_CAPTURE_VIA_COMMAND: specifies that the subject index is passed
{             to the COMMAND as a string.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_capture_index
    (    capture: clt$string_pattern_capture;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      command: ^clt$command_line,
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header,
      pattern_size: clt$string_pattern_size,
      variable: ^clt$variable_ref_expression;


    status.normal := TRUE;
    pattern_size := #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element);
    CASE capture.kind OF
    = clc$sp_capture_via_procedure =
      ;
    = clc$sp_capture_via_variable =
      pattern_size := pattern_size + #SIZE (capture.variable^);
    = clc$sp_capture_via_command =
      pattern_size := pattern_size + #SIZE (capture.command^);
    ELSE
      osp$set_status_condition (cle$bad_string_pattern, status);
      RETURN;
    CASEND;
    NEXT pattern: [[REP pattern_size OF cell]] IN work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := clc$sp_capture_index;
    pattern_element^.immediate_capture := TRUE;
    pattern_element^.capture_kind := capture.kind;
    CASE capture.kind OF
    = clc$sp_capture_via_procedure =
      pattern_element^.capture_procedure := capture.proc;
    = clc$sp_capture_via_variable =
      NEXT variable: [STRLENGTH (capture.variable^)] IN pattern;
      pattern_element^.capture_variable := #REL (variable, pattern^);
      variable^ := capture.variable^;
      pattern_element^.extra_info_size := #SIZE (variable^);
    = clc$sp_capture_via_command =
      NEXT command: [STRLENGTH (capture.command^)] IN pattern;
      pattern_element^.capture_command := #REL (command, pattern^);
      command^ := capture.command^;
      pattern_element^.extra_info_size := #SIZE (command^);
    ELSE
      ;
    CASEND;

    RESET pattern;

  PROCEND clp$sp_capture_index;
?? TITLE := 'clp$sp_capture_substring', EJECT ??

{
{   This request creates a string pattern that captures the substring matched
{ by the specified pattern.
{
{       CLP$SP_CAPTURE_SUBSTRING (PATTERN, CAPTURE, WORK_AREA,
{         RESULT_PATTERN, STATUS)
{
{ PATTERN: (input)  This parameter specifies the pattern whose matched
{       substring is to be captured.
{
{ CAPTURE: (input)  This parameter specified how the capture is to be
{       accomplished.  The IMMEDIATE field specifies whether the capture should
{       occur immediately when the PATTERN is matched, or not until the entire
{       RESULT_PATTERN has been matched.  The KIND field specifies how the
{       capturing is to be done.
{
{       CLC$SP_CAPTURE_VIA_PROCEDURE: specifies that the matched substring is
{             passed to the PROCedure.
{
{       CLC$SP_CAPTURE_VIA_VARIABLE: specifies that the matched substring is
{             written into the VARIABLE.
{
{       CLC$SP_CAPTURE_VIA_COMMAND: specifies that the matched substring is
{             passed to the COMMAND.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ RESULT_PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_capture_substring
    (    pattern: ^clt$string_pattern;
         capture: clt$string_pattern_capture;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      begin_element: ^clt$string_pattern_element,
      begin_element_link: clt$string_pattern_element_link,
      command: ^clt$command_line,
      copied_pattern: ^clt$string_pattern,
      end_element: ^clt$string_pattern_element,
      end_element_link: clt$string_pattern_element_link,
      first_result_element: ^clt$string_pattern_element,
      initial_copied_element: ^clt$string_pattern_element,
      ignore_initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      result_pattern_header: ^clt$string_pattern_header,
      result_pattern_size: clt$string_pattern_size,
      variable: ^clt$variable_ref_expression;


    status.normal := TRUE;

    open_string_pattern (pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    result_pattern_size := #SIZE (pattern^) + (2 * #SIZE (clt$string_pattern_element));
    CASE capture.kind OF
    = clc$sp_capture_via_procedure =
      ;
    = clc$sp_capture_via_variable =
      result_pattern_size := result_pattern_size + #SIZE (capture.variable^);
    = clc$sp_capture_via_command =
      result_pattern_size := result_pattern_size + #SIZE (capture.command^);
    ELSE
      osp$set_status_condition (cle$bad_string_pattern, status);
      RETURN;
    CASEND;
    NEXT result_pattern: [[REP result_pattern_size OF cell]] IN work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    NEXT copied_pattern: [[REP #SIZE (pattern^) OF cell]] IN result_pattern;
    copied_pattern^ := pattern^;
    RESET copied_pattern;
    NEXT result_pattern_header IN copied_pattern;

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          end_element_link, end_element);

    end_element^.kind := clc$sp_capture_end;
    end_element^.immediate_capture := capture.immediate;
    end_element^.capture_kind := capture.kind;
    CASE capture.kind OF
    = clc$sp_capture_via_procedure =
      end_element^.capture_procedure := capture.proc;
    = clc$sp_capture_via_variable =
      NEXT variable: [STRLENGTH (capture.variable^)] IN result_pattern;
      end_element^.capture_variable := #REL (variable, result_pattern^);
      variable^ := capture.variable^;
      end_element^.extra_info_size := #SIZE (variable^);
    = clc$sp_capture_via_command =
      NEXT command: [STRLENGTH (capture.command^)] IN result_pattern;
      end_element^.capture_command := #REL (command, result_pattern^);
      command^ := capture.command^;
      end_element^.extra_info_size := #SIZE (command^);
    ELSE
      ;
    CASEND;

    IF result_pattern_header^.number_of_elements = 1 THEN
      result_pattern_header^.initial_element := end_element_link;
    ELSE
      NEXT first_result_element IN copied_pattern;
      link_successor_to_pattern (result_pattern, first_result_element,
            result_pattern_header^.number_of_elements - 1, end_element_link, 0);
    IFEND;

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          begin_element_link, begin_element);

    begin_element^.kind := clc$sp_capture_begin;
    begin_element^.capture_end_element := end_element_link;

    begin_element^.successor := result_pattern_header^.initial_element;
    initial_copied_element := #PTR (result_pattern_header^.initial_element, result_pattern^);
    begin_element^.min_subject_size := min_subject_size (initial_copied_element);
    begin_element^.alternative_min_subject_size := begin_element^.min_subject_size;

    result_pattern_header^.initial_element := begin_element_link;

    RESET result_pattern;

  PROCEND clp$sp_capture_substring;
?? TITLE := 'clp$sp_characters', EJECT ??

{
{   This request builds a string pattern that matches a mimimum number of
{ of a particular set of characters.
{
{       CLP$SP_CHARACTERS (CHAR_SET, MINIMUM_COUNT, WORK_AREA, PATTERN, STATUS)
{
{ CHAR_SET: (input)  This parameter specifies the set of characters.
{
{ MINIMUM_COUNT: (input)  This parameter specifies the minimum number of
{       characters that must be found.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_characters
    (    char_set: clt$string_pattern_characters;
         minimum_count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_char_set_pattern (clc$sp_characters, -char_set, minimum_count, work_area, pattern, status);

  PROCEND clp$sp_characters;
?? TITLE := 'clp$sp_convert_to_string', EJECT ??
*copyc clh$sp_convert_to_string

{
{ DESIGN:
{   The string representation is produced in a two phase process.  The first phase
{   identifies the beinning and ending of sub_pattern.  The second phase produces the
{   string representation of the pattern, with appropriate notation for sub_patterns.
{
{   PHASE 1
{
{   For each element a count of the number of other pattern elements that point to
{   it as a successor, the PREDECESSOR_COUNT, is determined.  An element that has
{   more than one predecessor is the first element following a sub_pattern.
{
{   An element which is this first of a series of alternatives represents the start
{   of one or more sub_patterns.  The SUB_PATTERN_START_COUNT for such an element is
{   equal to the number of unique ways in which the alternatives "terminate".  This
{   count is determined by following the successors of each alternative until there
{   are no more successors or until an element with more than one predecessor is found.
{   A pointer this element in the latter case, or NIL in the former, is propogated
{   back to where the alternatives are being dealt with.  The number of unique such
{   pointers represents the number of unique ways in which the alternatives terminate,
{   and therefore the number of sub_patterns that start at the element in question.
{
{   SInce the string representation of the pattern does not include it, the
{   ALTERNATIVE_MIN_SUBJECT_SIZE field is used to store an index into an array
{   containing these counts for each element in of a copy of the pattern.
{
{   The first group of nested procedures and functions are used to isolate this
{   secondary use of this field.
{
{   PHASE 2
{
{   During the output phase the information determined during the first phase is used
{   to put out the appropriate "parenthesization" of the sub_patterns.  There is a
{   separate output procedure for each kind of pattern element.  The pattern elements
{   that operate in pairs have special processing to deal with their pattern structures.
{

  PROCEDURE [XDCL] clp$sp_convert_to_string
    (    source_pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_string: ^clt$string_value;
     VAR status: ost$status);

    VAR
*IF $true(osv$unix)
      handler_established: boolean,
*IFEND
      ignore_sub_pattern_successor: ^clt$string_pattern_element,
      initial_element: ^clt$string_pattern_element,
      original_work_area: ^clt$work_area,
      pattern: ^clt$string_pattern,
      pattern_end_count: clt$string_size,
      pattern_header: ^clt$string_pattern_header,
      representation_counts: ^array [1 .. * ] of record
        predecessor: clt$string_size,
        sub_pattern_start: clt$string_size,
        sub_pattern_end: clt$string_size,
        reached: clt$string_size,
      recend;

?? NEWTITLE := 'Count Manipulation Procedures and Functions' ??
?? NEWTITLE := 'decrement_sub_pattern_end_count', EJECT ??

{
{ PURPOSE:
{   This procedure decrements the SUB_PATTERN_END_COUNT of an element by 1.
{

    PROCEDURE [INLINE] decrement_sub_pattern_end_count
      (    pattern_element: ^clt$string_pattern_element);


      representation_counts^ [pattern_element^.alternative_min_subject_size].sub_pattern_end :=
            representation_counts^ [pattern_element^.alternative_min_subject_size].sub_pattern_end - 1;

    PROCEND decrement_sub_pattern_end_count;
?? TITLE := 'increment_predecessor_count', EJECT ??

{
{ PURPOSE:
{   This procedure increments the PREDECESSOR_COUNT of an element by 1.
{

    PROCEDURE [INLINE] increment_predecessor_count
      (    pattern_element: ^clt$string_pattern_element);


      representation_counts^ [pattern_element^.alternative_min_subject_size].predecessor :=
            representation_counts^ [pattern_element^.alternative_min_subject_size].predecessor + 1;

    PROCEND increment_predecessor_count;
?? TITLE := 'increment_reached_count', EJECT ??

{
{ PURPOSE:
{   This procedure increments the RECAHED_COUNT of an element by 1.
{

    PROCEDURE [INLINE] increment_reached_count
      (    pattern_element: ^clt$string_pattern_element);


      representation_counts^ [pattern_element^.alternative_min_subject_size].reached :=
            representation_counts^ [pattern_element^.alternative_min_subject_size].reached + 1;

    PROCEND increment_reached_count;
?? TITLE := 'increment_sub_pattern_end_count', EJECT ??

{
{ PURPOSE:
{   This procedure increments the SUB_PATTERN_END_COUNT of an element by 1.
{

    PROCEDURE [INLINE] increment_sub_pattern_end_count
      (    pattern_element: ^clt$string_pattern_element);


      representation_counts^ [pattern_element^.alternative_min_subject_size].sub_pattern_end :=
            representation_counts^ [pattern_element^.alternative_min_subject_size].sub_pattern_end + 1;

    PROCEND increment_sub_pattern_end_count;
?? TITLE := 'initialize_element_counts', EJECT ??

{
{ PURPOSE:
{   This procedure initializes the representation count information for an element.
{

    PROCEDURE [INLINE] initialize_element_counts
      (    pattern_element: ^clt$string_pattern_element;
           index: clt$string_size);


      pattern_element^.alternative_min_subject_size := index;
      representation_counts^ [index].predecessor := 0;
      representation_counts^ [index].sub_pattern_start := 0;
      representation_counts^ [index].sub_pattern_end := 0;
      representation_counts^ [index].reached := 0;

    PROCEND initialize_element_counts;
?? TITLE := 'predecessor_count', EJECT ??

{
{ PURPOSE:
{   This function returns the PREDECESSOR_COUNT of an element.
{

    FUNCTION [INLINE] predecessor_count
      (    pattern_element: ^clt$string_pattern_element): clt$string_size;


      predecessor_count := representation_counts^ [pattern_element^.alternative_min_subject_size].predecessor;

    FUNCEND predecessor_count;
?? TITLE := 'reached_count', EJECT ??

{
{ PURPOSE:
{   This function returns the REACHED_COUNT of an element.
{

    FUNCTION [INLINE] reached_count
      (    pattern_element: ^clt$string_pattern_element): clt$string_size;


      reached_count := representation_counts^ [pattern_element^.alternative_min_subject_size].reached;

    FUNCEND reached_count;
?? TITLE := 'set_sub_pattern_start_count', EJECT ??

{
{ PURPOSE:
{   This procedure sets the SUB_PATTERN_START_COUNT of an element.
{

    PROCEDURE [INLINE] set_sub_pattern_start_count
      (    pattern_element: ^clt$string_pattern_element;
           count: clt$string_size);


      representation_counts^ [pattern_element^.alternative_min_subject_size].sub_pattern_start := count;

    PROCEND set_sub_pattern_start_count;
?? TITLE := 'sub_pattern_end_count', EJECT ??

{
{ PURPOSE:
{   This function returns the SUB_PATTERN_END_COUNT of an element.
{

    FUNCTION [INLINE] sub_pattern_end_count
      (    pattern_element: ^clt$string_pattern_element): clt$string_size;


      sub_pattern_end_count := representation_counts^ [pattern_element^.alternative_min_subject_size].
            sub_pattern_end;

    FUNCEND sub_pattern_end_count;
?? TITLE := 'sub_pattern_start_count', EJECT ??

{
{ PURPOSE:
{   This function returns the SUB_PATTERN_START_COUNT of an element.
{

    FUNCTION [INLINE] sub_pattern_start_count
      (    pattern_element: ^clt$string_pattern_element): clt$string_size;


      sub_pattern_start_count := representation_counts^ [pattern_element^.alternative_min_subject_size].
            sub_pattern_start;

    FUNCEND sub_pattern_start_count;
?? OLDTITLE ??
?? TITLE := 'abort_handler', EJECT ??

{
{ PURPOSE:
{   This block exit condition handler is established to ensure that the work
{   area pointer is reset to its original value.
{

    PROCEDURE abort_handler
*IF $true(osv$unix)
      (    signal_no: integer;
           code: integer;
           p_sigcontext: ^cyt$mips_sigcontext);
*ELSE
      (    condition: pmt$condition;
           ignore_info: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);
*IFEND


      RESET work_area TO result_string;

    PROCEND abort_handler;
?? TITLE := 'bad_string_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure is called when an inconsistency in the structure of a string
{   pattern is detected.  It causes an abnormal status exit from the entire
{   conversion process.
{

    PROCEDURE [INLINE] bad_string_pattern;


      osp$set_status_condition (cle$bad_string_pattern, status);
      EXIT clp$sp_convert_to_string;

    PROCEND bad_string_pattern;
?? TITLE := 'identify_sub_patterns', EJECT ??

{
{ PURPOSE:
{   This procedure identifies sub-patterns within the pattern by establishing the
{   values for each element's PREDECESSOR_COUNT, SUB_PATTERN_START_COUNT and
{   SUB_PATTERN_END_COUNT, as described above.
{

    PROCEDURE identify_sub_patterns
      (    pattern_element: ^clt$string_pattern_element);

      VAR
        alternative_count: clt$string_size,
        alternatives: ^array [1 .. * ] of record
          first: ^clt$string_pattern_element,
          terminal: ^clt$string_pattern_element,
          sub_patterns: clt$string_size,
        recend,
        current_element: ^clt$string_pattern_element,
        i: clt$string_size,
        sub_pattern_index: clt$string_size,
        terminal_element: ^clt$string_pattern_element,
        unique_terminal_count: clt$string_size;


      increment_predecessor_count (pattern_element);

      IF predecessor_count (pattern_element) > 1 THEN

{ An element should only go through the identification process once.

        RETURN;
      IFEND;

      current_element := pattern_element;

{ Identify sub-patterns in this element's successors.

    /process_successors/
      WHILE current_element^.successor <> NIL DO
        current_element := #PTR (current_element^.successor, pattern^);

        IF current_element^.alternative <> NIL THEN

{ Recurse in order to be able to handle the successor's alternatives.

          identify_sub_patterns (current_element);
          EXIT /process_successors/;
        IFEND;

        increment_predecessor_count (current_element);
      WHILEND /process_successors/;

      IF pattern_element^.kind = clc$sp_repeat_pattern_end THEN

{ The ALTERNATIVE of a CLC$SP_REPEAT_PATTERN_END element is the first element
{ of the pattern to be repeated.  Because of this special use of the
{ ALTERNATIVE link, the CLC$SP_REPEAT_PATTERN_END element can never be
{ the start of a sub-pattern.  Therefore, the repeated sub-pattern must be
{ handled in a separate call.

        current_element := #PTR (pattern_element^.alternative, pattern^);
        identify_sub_patterns (current_element);
        RETURN;
      IFEND;

{ Count this element's alternatives and identify the sub-patterns in them.

      current_element := pattern_element;
      alternative_count := 1;
      WHILE current_element^.alternative <> NIL DO
        alternative_count := alternative_count + 1;

        current_element := #PTR (current_element^.alternative, pattern^);
        increment_predecessor_count (current_element);

        IF current_element^.successor <> NIL THEN
          identify_sub_patterns (#PTR (current_element^.successor, pattern^));
        IFEND;
      WHILEND;

      IF alternative_count = 1 THEN

{ Nothing more to do if no alternatives.

        RETURN;
      IFEND;

{ Create an array in which to keep track of sub-patterns for the alternatives.

      PUSH alternatives: [1 .. alternative_count];
      unique_terminal_count := 0;
      alternative_count := 0;

{ Find the "terminal" elements of the alternatives.

      current_element := pattern_element;
      REPEAT
        terminal_element := #PTR (current_element^.successor, pattern^);
        WHILE (terminal_element <> NIL) AND (predecessor_count (terminal_element) = 1) DO
          terminal_element := #PTR (terminal_element^.successor, pattern^);
        WHILEND;
        alternative_count := alternative_count + 1;
        alternatives^ [alternative_count].first := current_element;
        alternatives^ [alternative_count].terminal := terminal_element;
        alternatives^ [alternative_count].sub_patterns := 0;
        current_element := #PTR (current_element^.alternative, pattern^);
      UNTIL current_element = NIL;

{ This element, of course, starts a sub-pattern.  Also, any element which is
{ the first a series of consecutive alternatives with the same terminal element
{ starts a sub-pattern.

      sub_pattern_index := 1;
      REPEAT
        i := sub_pattern_index + 1;
        WHILE (i <= alternative_count) AND (alternatives^ [i].terminal = alternatives^ [i - 1].terminal) DO
          i := i + 1;
        WHILEND;
        IF (i - sub_pattern_index) > 1 THEN
          alternatives^ [sub_pattern_index].sub_patterns := alternatives^ [sub_pattern_index].sub_patterns +
                1;
        IFEND;
        IF (sub_pattern_index = 1) AND (i <= alternative_count) THEN
          alternatives^ [1].sub_patterns := alternatives^ [1].sub_patterns + 1;
        IFEND;
        sub_pattern_index := i;
      UNTIL sub_pattern_index >= alternative_count;

{ Save the sub-pattern start counts.

      FOR i := 1 TO alternative_count DO
        set_sub_pattern_start_count (alternatives^ [i].first, alternatives^ [i].sub_patterns);
      FOREND;

{ Increment the sub-pattern end counts.

    /increment_end_counts/
      FOR sub_pattern_index := 1 TO alternative_count DO

        FOR i := 1 TO sub_pattern_index - 1 DO
          IF alternatives^ [i].terminal = alternatives^ [sub_pattern_index].terminal THEN
            CYCLE /increment_end_counts/;
          IFEND;
        FOREND;

        IF alternatives^ [sub_pattern_index].terminal = NIL THEN
          pattern_end_count := pattern_end_count + 1;
        ELSE
          increment_sub_pattern_end_count (alternatives^ [sub_pattern_index].terminal);
        IFEND;
      FOREND /increment_end_counts/;

    PROCEND identify_sub_patterns;
?? TITLE := 'initialize_counts', EJECT ??

{
{ PURPOSE:
{   This procedure initializes all of the counters needed to produce the string
{   representation of the pattern.
{
{ DESIGN:
{   The pattern elements are sequentially accessed through the pattern, the links
{   are not used.
{

    PROCEDURE [INLINE] initialize_counts;

      VAR
        i: clt$string_size,
        pattern_element: ^clt$string_pattern_element,
        skip_extra_info: ^array [1 .. * ] of cell;


      pattern_end_count := 0;

      RESET pattern;
      NEXT pattern_header IN pattern;

      FOR i := 1 TO pattern_header^.number_of_elements DO
        NEXT pattern_element IN pattern;
        initialize_element_counts (pattern_element, i);

        IF pattern_element^.extra_info_size > 0 THEN

{ Skip over any additional information for the pattern element.

          NEXT skip_extra_info: [1 .. pattern_element^.extra_info_size] IN pattern;
        IFEND;
      FOREND;

    PROCEND initialize_counts;
?? TITLE := 'put_string', EJECT ??

{
{ PURPOSE:
{   This procedure appends a string to the result.
{

    PROCEDURE [INLINE] put_string
      (    s: clt$string_value);

      VAR
        copied_s: ^clt$string_value;


{ Append the string to the result.

      NEXT copied_s: [STRLENGTH (s)] IN work_area;
      IF copied_s = NIL THEN
        osp$set_status_condition (cle$work_area_overflow, status);
        EXIT clp$sp_convert_to_string;
      IFEND;

      copied_s^ := s;

{ Update the RESULT_STRING pointer.

      RESET original_work_area TO result_string;
      NEXT result_string: [STRLENGTH (result_string^) + STRLENGTH (s)] IN original_work_area;

    PROCEND put_string;
?? TITLE := 'put_sub_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure puts out the representation of a pattern element.  It is also
{   responsible for putting out the parentheses, etc. which are needed to represent
{   sub-patterns containing alternatives; and the operators that join successive
{   pattern elements.
{
{ DESIGN:
{   Successor elements are handled via recursive calls to this procedure.
{   Alternative elements are handled directly.
{   This allows for the proper detection of sub-patterns.
{

    PROCEDURE put_sub_pattern
      (    concatenate_pending: boolean;
           sub_pattern_element: ^clt$string_pattern_element;
       VAR sub_pattern_successor: ^clt$string_pattern_element);

      VAR
        i: clt$string_size,
        pattern_element: ^clt$string_pattern_element,
        successor_element: ^clt$string_pattern_element,
        unterminated_count: clt$string_size;

?? NEWTITLE := 'put_balanced_pair', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_BALANCED_PAIR element.
{

      PROCEDURE put_balanced_pair;


        put_string ('$sp_balance(');
        put_quoted_char (pattern_element^.left_character);
        put_string (',');
        put_quoted_char (pattern_element^.right_character);
        put_string (')');

      PROCEND put_balanced_pair;
?? TITLE := 'put_capture_begin', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_CAPTURE_BEGIN element.
{

      PROCEDURE put_capture_begin;


        put_string ('$sp_capture(');

      PROCEND put_capture_begin;
?? TITLE := 'put_capture_end', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_CAPTURE_END element.
{

      PROCEDURE put_capture_end;

        VAR
          capture_command: ^clt$command_line,
          capture_variable: ^clt$variable_ref_expression;


        IF pattern_element^.immediate_capture THEN
          put_string (',unconditional,');
        ELSE
          put_string (',conditional,');
        IFEND;

        CASE pattern_element^.capture_kind OF

        = clc$sp_capture_via_variable =
          capture_variable := #PTR (pattern_element^.capture_variable, pattern^);
          put_quoted_string (capture_variable^);
          put_string (',variable)');

        = clc$sp_capture_via_command =
          capture_command := #PTR (pattern_element^.capture_command, pattern^);
          put_quoted_string (capture_command^);
          put_string (',command)');

        = clc$sp_capture_via_procedure =
          put_string (',"CAPTURE VIA INTERNAL PROCEDURE")');

        ELSE
          bad_string_pattern;
        CASEND;

      PROCEND put_capture_end;
?? TITLE := 'put_capture_index', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_CAPTURE_INDEX element.
{

      PROCEDURE put_capture_index;

        VAR
          capture_command: ^clt$command_line,
          capture_variable: ^clt$variable_ref_expression;


        put_string ('$sp_index(');

        CASE pattern_element^.capture_kind OF

        = clc$sp_capture_via_variable =
          capture_variable := #PTR (pattern_element^.capture_variable, pattern^);
          put_quoted_string (capture_variable^);
          put_string (',variable)');

        = clc$sp_capture_via_command =
          capture_command := #PTR (pattern_element^.capture_command, pattern^);
          put_quoted_string (capture_command^);
          put_string (',command)');

        = clc$sp_capture_via_procedure =
          put_string (',"CAPTURE VIA INTERNAL PROCEDURE")');

        ELSE
          bad_string_pattern;
        CASEND;

      PROCEND put_capture_index;
?? TITLE := 'put_character_set', EJECT ??

{
{ PURPOSE:
{   This procedure the representation of a set of characters.
{
{ DESIGN:
{   A range of characters is produced if more than MIN_CHARS_FOR_RANGE consecutive
{   characters appear in the set; otherwise a string is produced.
{

      PROCEDURE put_character_set
        (    characters: clt$string_pattern_characters);

        CONST
          max_char_ordinal = 255,
          min_chars_for_range = 7;

        VAR
          c: char,
          put_separator: boolean,
          range_count: 0 .. max_char_ordinal,
          short_range: string (min_chars_for_range - 1);


        put_separator := FALSE;
        range_count := 0;
        FOR c := LOWERVALUE (char) TO UPPERVALUE (char) DO

          IF c IN characters THEN
            range_count := range_count + 1;
            IF range_count < min_chars_for_range THEN
              short_range (range_count) := c;
            IFEND;

          ELSEIF range_count > 0 THEN
            IF put_separator THEN
              put_string (',');
            IFEND;

            IF range_count < min_chars_for_range THEN
              put_quoted_string (short_range (1, range_count));
            ELSE
              put_quoted_string (short_range (1));
              put_string ('..');
              put_quoted_char (PRED (c));
            IFEND;

            range_count := 0;
            put_separator := TRUE;
          IFEND;
        FOREND;

        IF range_count > 0 THEN
          IF put_separator THEN
            put_string (',');
          IFEND;

          IF range_count < min_chars_for_range THEN
            put_quoted_string (short_range (1, range_count));
          ELSE
            put_quoted_string (short_range (1));
            put_string ('..');
            put_quoted_char (UPPERVALUE (char));
          IFEND;
        IFEND;

      PROCEND put_character_set;
?? TITLE := 'put_characters', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_CHARACTERS element.
{

      PROCEDURE put_characters;

        VAR
          characters: ^clt$string_pattern_characters;


        put_string ('$sp_repeat((any, ');
        characters := #PTR (pattern_element^.characters, pattern^);
        put_character_set (-characters^);
        put_string (')');
        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_characters;
?? TITLE := 'put_count', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_COUNT element.
{

      PROCEDURE put_count;

        VAR
          excluded_characters: ^clt$string_pattern_characters;


        put_string ('$sp_count(');
        put_integer (pattern_element^.count);
        IF pattern_element^.characters <> NIL THEN
          excluded_characters := #PTR (pattern_element^.characters, pattern^);
          put_string (',');
          put_character_set (excluded_characters^);
        IFEND;
        put_string (')');

      PROCEND put_count;
?? TITLE := 'put_count_test_left', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_COUNT_TEST_LEFT element.
{

      PROCEDURE put_count_test_left;


        put_string ('$sp_left');
        IF pattern_element^.count > 0 THEN
          put_string ('(');
          put_integer (pattern_element^.count);
          put_string (')');
        IFEND;

      PROCEND put_count_test_left;
?? TITLE := 'put_count_test_right', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_COUNT_TEST_RIGHT element.
{

      PROCEDURE put_count_test_right;


        put_string ('$sp_right');
        IF pattern_element^.count > 0 THEN
          put_string ('(');
          put_integer (pattern_element^.count);
          put_string (')');
        IFEND;

      PROCEND put_count_test_right;
?? TITLE := 'put_fail_element', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_FAIL_ELEMENT element.
{

      PROCEDURE put_fail_element;


        put_string ('$sp_fail');

      PROCEND put_fail_element;
?? TITLE := 'put_fail_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_FAIL_PATTERN element.
{

      PROCEDURE put_fail_pattern;


        put_string ('$sp_stop');

      PROCEND put_fail_pattern;
?? TITLE := 'put_fence', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_FENCE element.
{

      PROCEDURE put_fence;


        put_string ('$sp_fence');

      PROCEND put_fence;
?? TITLE := 'put_integer', EJECT ??

{
{ PURPOSE:
{   This procedure puts out an integer.
{

      PROCEDURE put_integer
        (    i: integer);

        VAR
          str: ost$string;


        clp$convert_integer_to_string (i, 10, FALSE, str, status);
        IF NOT status.normal THEN
          EXIT clp$sp_convert_to_string;
        IFEND;
        put_string (str.value (1, str.size));

      PROCEND put_integer;
?? TITLE := 'put_multiple', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_MULTIPLE element.
{

      PROCEDURE put_multiple;

        VAR
          excluded_characters: ^clt$string_pattern_characters;


        IF pattern_element^.characters = NIL THEN
          put_string ('$sp_repeat(any');
        ELSE
          put_string ('$sp_repeat((not_any,');
          excluded_characters := #PTR (pattern_element^.characters, pattern^);
          put_character_set (excluded_characters^);
          put_string (')');
        IFEND;
        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_multiple;
?? TITLE := 'put_multiple_path_elements', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_MULTIPLE_PATH_ELEMENTS element.
{

      PROCEDURE put_multiple_path_elements;


        put_string ('.$ALL');
        IF pattern_element^.successor <> NIL THEN
          put_string ('.');
        IFEND;

      PROCEND put_multiple_path_elements;
?? TITLE := 'put_one_character', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_ONE_CHARACTER element.
{

      PROCEDURE put_one_character;

        CONST
          max_characters = 256;

        VAR
          c: char,
          characters: ^clt$string_pattern_characters,
          count: 0 .. max_characters;


        characters := #PTR (pattern_element^.characters, pattern^);
        count := 0;
        FOR c := LOWERVALUE (char) TO UPPERVALUE (char) DO
          count := count + $INTEGER (c IN characters^);
        FOREND;
        IF count <= (max_characters DIV 2) THEN
          put_string ('$sp_any(');
          put_character_set (characters^);
        ELSE
          put_string ('$sp_not_any(');
          put_character_set (-characters^);
        IFEND;
        put_string (')');

      PROCEND put_one_character;
?? TITLE := 'put_quoted_char', EJECT ??

{
{ PURPOSE:
{   This procedure adds quotes to a character before putting it out.
{

      PROCEDURE [INLINE] put_quoted_char
        (    c: char);

        VAR
          s: string (1);


        s (1) := c;
        put_quoted_string (s);

      PROCEND put_quoted_char;
?? TITLE := 'put_quoted_string', EJECT ??

{
{ PURPOSE:
{   This procedure adds quotes to a string before putting it out.
{

      PROCEDURE put_quoted_string
        (    s: clt$string_value);

        VAR
          graphic: ost$string,
          i: clt$string_index,
          in_$char: boolean,
          in_string: boolean;


        IF STRLENGTH (s) = 0 THEN
          put_string ('''''');
          RETURN;
        IFEND;

        #SCAN (clv$non_graphic, s, i, in_$char);
        IF in_$char THEN
          put_string ('$CHAR(');
        IFEND;

        in_string := FALSE;
        FOR i := 1 TO STRLENGTH (s) DO
          CASE s (i) OF

          = ' ' .. '~' =
            IF NOT in_string THEN
              IF (i > 1) AND in_$char THEN
                put_string (' ');
              IFEND;
              put_string ('''');
              in_string := TRUE;
            IFEND;
            IF s (i) = '''' THEN
              put_string ('''');
            IFEND;
            put_string (s (i));

          ELSE
            IF i > 1 THEN
              IF in_string THEN
                put_string ('''');
                in_string := FALSE;
              IFEND;
              put_string (' ');
            IFEND;
            clp$convert_char_to_graphic (s (i), graphic, status);
            IF NOT status.normal THEN
              EXIT clp$sp_convert_to_string;
            IFEND;
            put_string (graphic.value (1, graphic.size));
          CASEND;
        FOREND;

        IF in_string THEN
          put_string ('''');
        IFEND;

        IF in_$char THEN
          put_string (')');
        IFEND;

      PROCEND put_quoted_string;
?? TITLE := 'put_repeat_pattern_begin', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_REPEAT_PATTERN_BEGIN element.
{
{ NOTE:
{   The SUCCESSOR of a CLC$SP_REPEAT_PATTERN_BEGIN element is the corresponding
{   CLC$SP_REPEAT_PATTERN_END element.  The first element of the pattern to be
{   repeated is the ALTERNATIVE of the CLC$SP_REPEAT_PATTERN_END element.  The
{   CLC$SP_REPEAT_PATTERN_END element is also the successor of the repeatable
{   pattern.
{
{   For the present purpose, it is necessary to adjust the SUCCESSOR_ELEMENT
{   varibale so that it points the first element of the pattern to be repeated.
{   Having done this the ALTERNATIVE field of the CLC$SP_REPEAT_PATTERN_END
{   element must be set to NIL.  Also, its REACHED_COUNT must be incremented.
{

      PROCEDURE put_repeat_pattern_begin;

        VAR
          end_element: ^clt$string_pattern_element;


        IF (successor_element = NIL) OR (successor_element^.kind <> clc$sp_repeat_pattern_end) THEN
          bad_string_pattern;
        IFEND;

        end_element := successor_element;
        successor_element := #PTR (end_element^.alternative, pattern^);
        end_element^.alternative := NIL;
        increment_reached_count (end_element);

        put_string ('$sp_repeat(');

      PROCEND put_repeat_pattern_begin;
?? TITLE := 'put_repeat_pattern_end', EJECT ??

{
{ PURPOSE:
{   This procedure processes a CLC$SP_REPEAT_PATTERN_END element.
{

      PROCEDURE put_repeat_pattern_end;


        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_repeat_pattern_end;
?? TITLE := 'put_string_literal', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_STRING_LITERAL element.
{

      PROCEDURE put_string_literal;

        VAR
          string_literal: ^clt$string_value;


        string_literal := #PTR (pattern_element^.string_literal, pattern^);

        IF NOT pattern_element^.case_sensitive THEN
          put_string ('$sp_string(');
        IFEND;

        put_quoted_string (string_literal^);

        IF NOT pattern_element^.case_sensitive THEN
          put_string (',ignore_case)');
        IFEND;

      PROCEND put_string_literal;
?? TITLE := 'put_succeed_forced', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_SUCCEED_FORCED element.
{

      PROCEDURE put_succeed_forced;


        put_string ('$sp_succeed');

      PROCEND put_succeed_forced;
?? TITLE := 'put_succeed_passive', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_SUCCEED_PASSIVE element.
{

      PROCEDURE put_succeed_passive;


        put_string ('$sp_null');

      PROCEND put_succeed_passive;
?? TITLE := 'put_successor', EJECT ??

{
{ PURPOSE:
{   This procedure puts out the successor to the current element.  It also
{   puts out a concatenation operator before the successor, if appropriate.
{

      PROCEDURE [INLINE] put_successor;

        VAR
          put_a_concatenate: boolean;


        put_a_concatenate := (pattern_element^.kind <> clc$sp_capture_begin) AND
              (pattern_element^.kind <> clc$sp_repeat_pattern_begin) AND
              (successor_element^.kind <> clc$sp_capture_end) AND
              (successor_element^.kind <> clc$sp_repeat_pattern_end);

{ Put out the successor.

        put_sub_pattern (put_a_concatenate, successor_element, sub_pattern_successor);

      PROCEND put_successor;
?? TITLE := 'put_test', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_TEST element.
{

      PROCEDURE put_test;

        VAR
          test_expression: ^clt$expression_text;


        put_string ('$sp_test(');
        test_expression := #PTR (pattern_element^.test_expression, pattern^);
        put_string (test_expression^);
        put_string (')');

      PROCEND put_test;
?? TITLE := 'put_unevaluated_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_UNEVALUATED_PATTERN element.
{

      PROCEDURE put_unevaluated_pattern;

        VAR
          unevaluated_expression: ^clt$expression_text;


        put_string ('$sp_defer(');
        unevaluated_expression := #PTR (pattern_element^.unevaluated_pattern, pattern^);
        put_string (unevaluated_expression^);
        IF pattern_element^.min_subject_size <> 1 THEN
          put_string (',');
          put_integer (pattern_element^.min_subject_size);
        IFEND;
        put_string (')');

      PROCEND put_unevaluated_pattern;
?? TITLE := 'put_upto_character', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_UPTO_CHARACTER element.
{

      PROCEDURE put_upto_character;

        VAR
          characters: ^clt$string_pattern_characters;


        put_string ('$sp_upto((');
        characters := #PTR (pattern_element^.characters, pattern^);
        put_character_set (characters^);
        put_string (')');
        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_upto_character;
?? TITLE := 'put_upto_count_from_left', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_UPTO_COUNT_FROM_LEFT element.
{

      PROCEDURE put_upto_count_from_left;


        put_string ('$sp_upto(left');
        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_upto_count_from_left;
?? TITLE := 'put_upto_count_from_right', EJECT ??

{
{ PURPOSE:
{   This procedure puts out a CLC$SP_UPTO_COUNT_FROM_RIGHT element.
{

      PROCEDURE put_upto_count_from_right;


        put_string ('$sp_upto(right');
        IF pattern_element^.count > 0 THEN
          put_string (',');
          put_integer (pattern_element^.count);
        IFEND;
        put_string (')');

      PROCEND put_upto_count_from_right;
?? OLDTITLE, EJECT ??

      sub_pattern_successor := NIL;

      increment_reached_count (sub_pattern_element);

      IF (predecessor_count (sub_pattern_element) > 1) AND
            (reached_count (sub_pattern_element) <= predecessor_count (sub_pattern_element)) THEN

{ This element must be treated as a sub_pattern successor until it has been "reached"
{ after its precedeeing sub_pattern has been completely put out.

        sub_pattern_successor := sub_pattern_element;
        RETURN;
      IFEND;

{ Terminate any sub-patterns that haven't already been terminated.

      unterminated_count := sub_pattern_end_count (sub_pattern_element);
      WHILE unterminated_count > 0 DO
        put_string (')');
        unterminated_count := unterminated_count - 1;
      WHILEND;

      IF concatenate_pending THEN

{ Put out concatenation operator since this element is a successor.

        put_string ('//');
      IFEND;

{ Put out the approriate number of "sub_pattern starters".

      FOR i := 1 TO sub_pattern_start_count (sub_pattern_element) DO
        put_string ('$sp_or(');
      FOREND;

{ Loop through this element and its alternatives.

      pattern_element := sub_pattern_element;

      REPEAT

{ Initialize the successor element pointer.  Some of the specialized "put" procedures
{ may adjust this pointer.

        successor_element := #PTR (pattern_element^.successor, pattern^);

{ Put current pattern element.

        CASE pattern_element^.kind OF
        = clc$sp_balanced_pair =
          put_balanced_pair;
        = clc$sp_capture_begin =
          put_capture_begin;
        = clc$sp_capture_end =
          put_capture_end;
        = clc$sp_capture_index =
          put_capture_index;
        = clc$sp_characters =
          put_characters;
        = clc$sp_count =
          put_count;
        = clc$sp_count_test_left =
          put_count_test_left;
        = clc$sp_count_test_right =
          put_count_test_right;
        = clc$sp_fail_element =
          put_fail_element;
        = clc$sp_fail_pattern =
          put_fail_pattern;
        = clc$sp_fence =
          put_fence;
        = clc$sp_multiple =
          put_multiple;
        = clc$sp_multiple_path_elements =
          put_multiple_path_elements;
        = clc$sp_one_character =
          put_one_character;
        = clc$sp_repeat_pattern_begin =
          put_repeat_pattern_begin;
        = clc$sp_repeat_pattern_end =
          put_repeat_pattern_end;
        = clc$sp_string_literal =
          put_string_literal;
        = clc$sp_succeed_forced =
          put_succeed_forced;
        = clc$sp_succeed_passive =
          put_succeed_passive;
        = clc$sp_test =
          put_test;
        = clc$sp_unevaluated_pattern =
          put_unevaluated_pattern;
        = clc$sp_upto_character =
          put_upto_character;
        = clc$sp_upto_count_from_left =
          put_upto_count_from_left;
        = clc$sp_upto_count_from_right =
          put_upto_count_from_right;
        ELSE
          bad_string_pattern;
        CASEND;

        IF successor_element = NIL THEN
          sub_pattern_successor := NIL;
        ELSE
          put_successor;
        IFEND;

        IF sub_pattern_start_count (sub_pattern_element) > 0 THEN
          IF (pattern_element^.alternative = NIL) OR ((sub_pattern_successor <> NIL) AND
                (reached_count (sub_pattern_successor) = predecessor_count (sub_pattern_successor))) THEN

{ Terminate the sub_pattern.

            put_string (')');
            IF sub_pattern_successor = NIL THEN
              pattern_end_count := pattern_end_count - 1;
            ELSE
              decrement_sub_pattern_end_count (sub_pattern_successor);

              IF reached_count (sub_pattern_successor) = predecessor_count (sub_pattern_successor) THEN

{ Put the sub-pattern's successor.

                successor_element := sub_pattern_successor;
                put_successor;
              IFEND;
            IFEND;
          IFEND;

          IF pattern_element^.alternative <> NIL THEN

{ Put separator between alternatives.

            put_string (',');
          IFEND;
        IFEND;

        pattern_element := #PTR (pattern_element^.alternative, pattern^);

        IF (pattern_element <> NIL) AND (sub_pattern_start_count (pattern_element) > 0) THEN

{ Remaining alternatives must be dealt with via a recursive call because of the
{ start of a new sub-pattern.

          put_sub_pattern (FALSE, pattern_element, sub_pattern_successor);
          RETURN;
        IFEND;

      UNTIL pattern_element = NIL;

    PROCEND put_sub_pattern;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

{ Make a copy of the pattern so that the necessary modifications can be made to it during
{ the representation process.

    PUSH pattern: [[REP #SIZE (source_pattern^) OF cell]];
    pattern^ := source_pattern^;

    open_string_pattern (pattern, pattern_header, initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Initialize the RESULT_STRING pointer.

    original_work_area := work_area;
    NEXT result_string: [0] IN work_area;

{ If the pattern is empty treat it as a "null" pattern.

    IF pattern_header^.number_of_elements = 0 THEN
      put_string ('$sp_null');
      RETURN;
    IFEND;

*IF $true(osv$unix)
    handler_established := #establish_condition_handler (-1, ^abort_handler);
*ELSE
    osp$establish_block_exit_hndlr (^abort_handler);
*IFEND

{ Phase 1: identify the sub-patterns.

    PUSH representation_counts: [1 .. pattern_header^.number_of_elements];
    initialize_counts;

    identify_sub_patterns (initial_element);

{ Phase 2: put out the string representation of the pattern.

    put_sub_pattern (FALSE, initial_element, ignore_sub_pattern_successor);

    WHILE pattern_end_count > 0 DO
      put_string (')');
      pattern_end_count := pattern_end_count - 1;
    WHILEND;

*IF $true(osv$unix)
    IF handler_established THEN
      handler_established := NOT #disestablish_condition_handler (-1);
    IFEND;
*ELSE
    osp$disestablish_cond_handler;
*IFEND

  PROCEND clp$sp_convert_to_string;
?? TITLE := 'clp$sp_count', EJECT ??

{
{   This request builds a string pattern that matches a particular number of
{ characters.
{
{       CLP$SP_COUNT (COUNT, WORK_AREA, PATTERN, STATUS)
{
{ COUNT: (input)  This parameter specifies the number of characters that must
{       be found.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_count
    (    excluded_chars: clt$string_pattern_characters;
         count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    IF excluded_chars = $clt$string_pattern_characters [] THEN
      initialize_count_pattern (clc$sp_count, count, count, work_area, pattern, status);
    ELSE
      initialize_char_set_pattern (clc$sp_count, excluded_chars, count, work_area, pattern, status);
    IFEND;

  PROCEND clp$sp_count;
?? TITLE := 'clp$sp_count_test_left', EJECT ??

{
{   This request builds a string pattern that succeeds when encountered the
{ specified number of characters from the left end of the subject string.
{
{       CLP$SP_COUNT_TEST_LEFT (COUNT, WORK_AREA, PATTERN, STATUS)
{
{ COUNT: (input)  This parameter specifies the number of characters to the
{       left.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_count_test_left
    (    count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_count_pattern (clc$sp_count_test_left, count, 0, work_area, pattern, status);

  PROCEND clp$sp_count_test_left;
?? TITLE := 'clp$sp_count_test_right', EJECT ??

{
{   This request builds a string pattern that succeeds when encountered the
{ specified number of characters from the right end of the subject string.
{
{       CLP$SP_COUNT_TEST_RIGHT (COUNT, WORK_AREA, PATTERN, STATUS)
{
{ COUNT: (input)  This parameter specifies the number of characters to the
{       right.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_count_test_right
    (    count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_count_pattern (clc$sp_count_test_right, count, 0, work_area, pattern, status);

  PROCEND clp$sp_count_test_right;
?? TITLE := 'clp$sp_fail_element', EJECT ??

{
{   This request builds a string pattern consisting of an element that always
{ fails to match.
{
{       CLP$SP_FAIL_ELEMENT (WORK_AREA, PATTERN, STATUS)
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_fail_element
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_unqualified_pattern (clc$sp_fail_element, work_area, pattern, status);

  PROCEND clp$sp_fail_element;
?? TITLE := 'clp$sp_fail_pattern', EJECT ??

{
{   This request builds a string pattern consisting of an element that will
{ cause immediate failure termination of the entire matching process.
{
{       CLP$SP_FAIL_PATTERN (WORK_AREA, PATTERN, STATUS)
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_fail_pattern
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_unqualified_pattern (clc$sp_fail_pattern, work_area, pattern, status);

  PROCEND clp$sp_fail_pattern;
?? TITLE := 'clp$sp_fence', EJECT ??

{
{   This request builds a string pattern consisting of a "fence" element.
{
{       CLP$SP_FENCE (WORK_AREA, PATTERN, STATUS)
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_fence
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_unqualified_pattern (clc$sp_fence, work_area, pattern, status);

  PROCEND clp$sp_fence;
?? TITLE := 'clp$sp_multiple', EJECT ??

{
{   This request builds a string pattern that matches a minimum number of
{ characters.
{
{       CLP$SP_MULTIPLE (MINIMUM_COUNT, WORK_AREA, PATTERN, STATUS)
{
{ MINIMUM_COUNT: (input)  This parameter specifies the minimum number of
{       characters to be matched.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_multiple
    (    excluded_chars: clt$string_pattern_characters;
         minimum_count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    IF excluded_chars = $clt$string_pattern_characters [] THEN
      initialize_count_pattern (clc$sp_multiple, minimum_count, minimum_count, work_area, pattern, status);
    ELSE
      initialize_char_set_pattern (clc$sp_multiple, excluded_chars, minimum_count, work_area, pattern,
            status);
    IFEND;

  PROCEND clp$sp_multiple;
?? TITLE := 'clp$sp_one_character', EJECT ??

{
{   This request builds a string pattern that matches exactly one of a
{ particular set of characters.
{
{       CLP$SP_ONE_CHARACTER (CHAR_SET, WORK_AREA, PATTERN, STATUS)
{
{ CHAR_SET: (input)  This parameter specifies the set of characters.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_one_character
    (    char_set: clt$string_pattern_characters;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_char_set_pattern (clc$sp_one_character, char_set, 1, work_area, pattern, status);

  PROCEND clp$sp_one_character;
?? TITLE := 'clp$sp_pattern_concat_pattern', EJECT ??
*copyc clh$sp_pattern_concat_pattern

  PROCEDURE [XDCL] clp$sp_pattern_concat_pattern
    (    left_pattern: ^clt$string_pattern;
         right_pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      copied_left_pattern: ^clt$string_pattern,
      first_result_element: ^clt$string_pattern_element,
      ignore_initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      number_of_left_elements: clt$string_size,
      result_pattern_header: ^clt$string_pattern_header,
      successor_element: ^clt$string_pattern_element,
      successor_element_link: clt$string_pattern_element_link;


    status.normal := TRUE;

    open_string_pattern (left_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    open_string_pattern (right_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT result_pattern: [[REP #SIZE (left_pattern^) + #SIZE (right_pattern^) -
          #SIZE (clt$string_pattern_header) OF cell]] IN work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    NEXT copied_left_pattern: [[REP #SIZE (left_pattern^) OF cell]] IN result_pattern;
    copied_left_pattern^ := left_pattern^;
    RESET copied_left_pattern;
    NEXT result_pattern_header IN copied_left_pattern;
    number_of_left_elements := result_pattern_header^.number_of_elements;

    successor_element_link := NIL;
    copy_pattern_elements (right_pattern, result_pattern, successor_element_link);

    IF number_of_left_elements = 0 THEN
      result_pattern_header^.initial_element := successor_element_link;
    ELSE
      NEXT first_result_element IN copied_left_pattern;
      successor_element := #PTR (successor_element_link, result_pattern^);
      link_successor_to_pattern (result_pattern, first_result_element, number_of_left_elements,
            successor_element_link, min_subject_size (successor_element));
    IFEND;

    RESET result_pattern;

  PROCEND clp$sp_pattern_concat_pattern;
?? TITLE := 'clp$sp_pattern_concat_string', EJECT ??
*copyc clh$sp_pattern_concat_string

  PROCEDURE [XDCL] clp$sp_pattern_concat_string
    (    left_pattern: ^clt$string_pattern;
         right_string: ^clt$string_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      copied_left_pattern: ^clt$string_pattern,
      first_result_element: ^clt$string_pattern_element,
      ignore_initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      number_of_left_elements: clt$string_size,
      result_pattern_header: ^clt$string_pattern_header,
      successor_element: ^clt$string_pattern_element,
      successor_element_link: clt$string_pattern_element_link;


    status.normal := TRUE;

    open_string_pattern (left_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT result_pattern: [[REP #SIZE (left_pattern^) + #SIZE (clt$string_pattern_element) +
          #SIZE (right_string^) OF cell]] IN work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    NEXT copied_left_pattern: [[REP #SIZE (left_pattern^) OF cell]] IN result_pattern;
    copied_left_pattern^ := left_pattern^;
    RESET copied_left_pattern;
    NEXT result_pattern_header IN copied_left_pattern;
    number_of_left_elements := result_pattern_header^.number_of_elements;

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          successor_element_link, successor_element);

    initialize_string_lit_element (right_string, TRUE, successor_element, result_pattern, result_pattern);

    IF number_of_left_elements = 0 THEN
      result_pattern_header^.initial_element := successor_element_link;
    ELSE
      NEXT first_result_element IN copied_left_pattern;
      link_successor_to_pattern (result_pattern, first_result_element, number_of_left_elements,
            successor_element_link, min_subject_size (successor_element));
    IFEND;

    RESET result_pattern;

  PROCEND clp$sp_pattern_concat_string;
?? TITLE := 'clp$sp_pattern_or_pattern', EJECT ??
*copyc clh$sp_pattern_or_pattern

  PROCEDURE clp$sp_pattern_or_pattern
    (    first_pattern: ^clt$string_pattern;
         second_pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      alternative_element: ^clt$string_pattern_element,
      alternative_element_link: clt$string_pattern_element_link,
      copied_first_pattern: ^clt$string_pattern,
      first_result_element: ^clt$string_pattern_element,
      ignore_initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      number_of_first_elements: clt$string_size,
      result_pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    open_string_pattern (first_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    open_string_pattern (second_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT result_pattern: [[REP #SIZE (first_pattern^) + #SIZE (second_pattern^) -
          #SIZE (clt$string_pattern_header) OF cell]] IN work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    NEXT copied_first_pattern: [[REP #SIZE (first_pattern^) OF cell]] IN result_pattern;
    copied_first_pattern^ := first_pattern^;
    RESET copied_first_pattern;
    NEXT result_pattern_header IN copied_first_pattern;
    number_of_first_elements := result_pattern_header^.number_of_elements;

    alternative_element_link := NIL;
    copy_pattern_elements (second_pattern, result_pattern, alternative_element_link);

    IF number_of_first_elements = 0 THEN
      result_pattern_header^.initial_element := alternative_element_link;
    ELSE
      first_result_element := #PTR (result_pattern_header^.initial_element, result_pattern^);
      alternative_element := #PTR (alternative_element_link, result_pattern^);
      link_alternative_to_pattern (result_pattern, first_result_element, alternative_element_link,
            min_subject_size (alternative_element));
    IFEND;

    RESET result_pattern;

  PROCEND clp$sp_pattern_or_pattern;
?? TITLE := 'clp$sp_repeat_pattern', EJECT ??

{
{   This request creates a string pattern that matches a specified pattern a
{ minimum number of times.
{
{       CLP$SP_REPEAT_PATTERN (PATTERN, MINIMUM_COUNT, WORK_AREA,
{         RESULT_PATTERN, STATUS)
{
{ PATTERN: (input)  This parameter specifies the pattern to be matched
{       repeatedly.
{
{ MINIMUM_COUNT: (input)  This parameter specifies the minimum number of
{       repititions required of the PATTERN.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ RESULT_PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_repeat_pattern
    (    pattern: ^clt$string_pattern;
         minimum_count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      begin_element: ^clt$string_pattern_element,
      begin_element_link: clt$string_pattern_element_link,
      copied_pattern: ^clt$string_pattern,
      end_element: ^clt$string_pattern_element,
      end_element_link: clt$string_pattern_element_link,
      first_result_element: ^clt$string_pattern_element,
      initial_copied_element: ^clt$string_pattern_element,
      initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      result_pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    open_string_pattern (pattern, ignore_pattern_header, initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    ELSEIF initial_element = NIL THEN
      result_pattern := pattern;
      RETURN;
    IFEND;

    NEXT result_pattern: [[REP #SIZE (pattern^) + (2 * #SIZE (clt$string_pattern_element)) OF cell]] IN
          work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    NEXT copied_pattern: [[REP #SIZE (pattern^) OF cell]] IN result_pattern;
    copied_pattern^ := pattern^;
    RESET copied_pattern;
    NEXT result_pattern_header IN copied_pattern;
    initial_copied_element := #PTR (result_pattern_header^.initial_element, result_pattern^);

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          end_element_link, end_element);

    end_element^.kind := clc$sp_repeat_pattern_end;
    end_element^.count := minimum_count;
    end_element^.alternative := result_pattern_header^.initial_element;
    end_element^.alternative_min_subject_size := min_subject_size (initial_copied_element);

    NEXT first_result_element IN copied_pattern;
    link_successor_to_pattern (result_pattern, first_result_element,
          result_pattern_header^.number_of_elements - 1, end_element_link, 0);

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          begin_element_link, begin_element);

    begin_element^.kind := clc$sp_repeat_pattern_begin;
    begin_element^.count := minimum_count;

    begin_element^.successor := end_element_link;
    begin_element^.min_subject_size := end_element^.alternative_min_subject_size * minimum_count;
    begin_element^.alternative_min_subject_size := begin_element^.min_subject_size;

    result_pattern_header^.initial_element := begin_element_link;

    RESET result_pattern;

  PROCEND clp$sp_repeat_pattern;
?? TITLE := 'clp$sp_string_concat_pattern', EJECT ??
*copyc clh$sp_string_concat_pattern

  PROCEDURE [XDCL] clp$sp_string_concat_pattern
    (    left_string: ^clt$string_value;
         right_pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result_pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      first_result_element: ^clt$string_pattern_element,
      ignore_initial_element: ^clt$string_pattern_element,
      ignore_pattern_header: ^clt$string_pattern_header,
      result_pattern_header: ^clt$string_pattern_header,
      successor_element: ^clt$string_pattern_element,
      successor_element_link: clt$string_pattern_element_link;


    status.normal := TRUE;

    open_string_pattern (right_pattern, ignore_pattern_header, ignore_initial_element, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT result_pattern: [[REP #SIZE (right_pattern^) + #SIZE (clt$string_pattern_element) +
          #SIZE (left_string^) OF cell]] IN work_area;
    IF result_pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET result_pattern;

    initialize_pattern_header (result_pattern, result_pattern_header);

    initialize_pattern_element (result_pattern, result_pattern, result_pattern_header^.number_of_elements,
          result_pattern_header^.initial_element, first_result_element);

    initialize_string_lit_element (left_string, TRUE, first_result_element, result_pattern, result_pattern);

    successor_element_link := NIL;
    copy_pattern_elements (right_pattern, result_pattern, successor_element_link);

    successor_element := #PTR (successor_element_link, result_pattern^);
    link_successor_to_pattern (result_pattern, first_result_element, 1, successor_element_link,
          min_subject_size (successor_element));

    RESET result_pattern;

  PROCEND clp$sp_string_concat_pattern;
?? TITLE := 'clp$sp_string_literal', EJECT ??
*copyc clh$sp_string_literal

  PROCEDURE [XDCL] clp$sp_string_literal
    (    string_literal: ^clt$string_value;
         case_sensitive: boolean;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) +
          #SIZE (string_literal^) OF cell]] IN work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    initialize_string_lit_element (string_literal, case_sensitive, pattern_element, pattern, pattern);

    RESET pattern;

  PROCEND clp$sp_string_literal;
?? TITLE := 'clp$sp_succeed_forced', EJECT ??

{
{   This request builds a string pattern consisting of an element that always
{ succeeds, even when "backed into".
{
{       CLP$SP_SUCCEED_FORCED (WORK_AREA, PATTERN, STATUS)
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_succeed_forced
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_unqualified_pattern (clc$sp_succeed_forced, work_area, pattern, status);

  PROCEND clp$sp_succeed_forced;
?? TITLE := 'clp$sp_succeed_passive', EJECT ??

{
{   This request builds a string pattern consisting of an element that matches
{ a null string.
{
{       CLP$SP_SUCCEED_PASSIVE (WORK_AREA, PATTERN, STATUS)
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_succeed_passive
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_unqualified_pattern (clc$sp_succeed_passive, work_area, pattern, status);

  PROCEND clp$sp_succeed_passive;
?? TITLE := 'clp$sp_test', EJECT ??

{
{   This request builds a string pattern that evaluates a boolean expression
{ during the pattern matching process.
{
{       CLP$SP_TEST (BOOLEAN_EXPRESSION, WORK_AREA, PATTERN, STATUS)
{
{ BOOLEAN_EXPRESSION: (input)  This parameter specifies the expression to be
{       tested.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_test
    (    boolean_expression: ^clt$expression_text;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header,
      test_expression: ^clt$expression_text;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) +
          #SIZE (boolean_expression^) OF cell]] IN work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := clc$sp_test;
    NEXT test_expression: [STRLENGTH (boolean_expression^)] IN pattern;
    pattern_element^.test_expression := #REL (test_expression, pattern^);
    test_expression^ := boolean_expression^;
    pattern_element^.extra_info_size := #SIZE (test_expression^);

    RESET pattern;

  PROCEND clp$sp_test;
?? TITLE := 'clp$sp_unevaluated_pattern', EJECT ??

{
{   This request builds a string pattern that is evaluated during the pattern
{ matching process.
{
{       CLP$SP_UNEVALUATED_PATTERN (PATTERN_EXPRESSION, MIN_SUBJECT_SIZE,
{         WORK_AREA, PATTERN, STATUS)
{
{ PATTERN_EXPRESSION: (input)  This parameter specifies the expression for the
{       unevaluated pattern.
{
{ MIN_SUBJECT_SIZE: (input)  This parameter specifies the minimum number of
{       characters that will be matched by the unevaluated pattern.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_unevaluated_pattern
    (    pattern_expression: ^clt$expression_text;
         min_subject_size: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header,
      unevaluated_pattern: ^clt$expression_text;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) +
          #SIZE (pattern_expression^) OF cell]] IN work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := clc$sp_unevaluated_pattern;
    NEXT unevaluated_pattern: [STRLENGTH (pattern_expression^)] IN pattern;
    pattern_element^.unevaluated_pattern := #REL (unevaluated_pattern, pattern^);
    unevaluated_pattern^ := pattern_expression^;
    pattern_element^.extra_info_size := #SIZE (unevaluated_pattern^);
    pattern_element^.min_subject_size := min_subject_size;

    RESET pattern;

  PROCEND clp$sp_unevaluated_pattern;
?? TITLE := 'clp$sp_upto_character', EJECT ??

{
{   This request builds a string pattern that matches characters until one of a
{ particular set of characters is found.
{
{       CLP$SP_UPTO_CHARACTER (CHAR_SET, WORK_AREA, PATTERN, STATUS)
{
{ CHAR_SET: (input)  This parameter specifies the set of characters.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_upto_character
    (    char_set: clt$string_pattern_characters;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_char_set_pattern (clc$sp_upto_character, char_set, 0, work_area, pattern, status);

  PROCEND clp$sp_upto_character;
?? TITLE := 'clp$sp_upto_count_from_left', EJECT ??

{
{   This request builds a string pattern that matches characters upto the
{ specified number of characters from the left end of the subject string.
{
{       CLP$SP_UPTO_COUNT_FROM_LEFT (COUNT, WORK_AREA, PATTERN, STATUS)
{
{ COUNT: (input)  This parameter specifies the number of characters to the
{       left.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_upto_count_from_left
    (    count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_count_pattern (clc$sp_upto_count_from_left, count, 0, work_area, pattern, status);

  PROCEND clp$sp_upto_count_from_left;
?? TITLE := 'clp$sp_upto_count_from_right', EJECT ??

{
{   This request builds a string pattern that matches characters upto the
{ specified number of characters from the right end of the subject string.
{
{       CLP$SP_UPTO_COUNT_FROM_RIGHT (COUNT, WORK_AREA, PATTERN, STATUS)
{
{ COUNT: (input)  This parameter specifies the number of characters to the
{       right.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE clp$sp_upto_count_from_right
    (    count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    initialize_count_pattern (clc$sp_upto_count_from_right, count, 0, work_area, pattern, status);

  PROCEND clp$sp_upto_count_from_right;
?? TITLE := 'adjust_relative_pointer', EJECT ??

{
{ PURPOSE:
{   This procedure is used to adjust (increment) a relative pointer.  It
{   is needed when the data referenced by the relative pointer is moved
{   within the structure containing the pointer.
{
{ RELATIVE_POINTER: (input)  This parameter specifies the address of the
{       relative pointer to be adjusted.  The caller must pass the
{       address via the #LOC function.
{
{ OFFSET_AMOUNT: (input)  This parameter specifies the number of cells
{       by which the relative pointer is to be adjusted.
{
{ NOTES:
{   This procedure depends on the fact that a non-NIL relative pointer is
{   represented by a 4-byte non-negative integer.
{

?? SKIP := 3 ??

  TYPE
    clt$adjust_relative_pointer = packed record
      offset: ost$segment_offset,
    recend;

?? SKIP := 3 ??

  PROCEDURE [INLINE] adjust_relative_pointer
    (    relative_pointer: ^clt$adjust_relative_pointer;
         offset_amount: ost$segment_offset);


    IF relative_pointer^.offset >= 0 THEN
      relative_pointer^.offset := relative_pointer^.offset + offset_amount;
    IFEND;

  PROCEND adjust_relative_pointer;
?? TITLE := 'build_character_set', EJECT ??

{
{ PURPOSE:
{   This procedure builds a set of characters from a cl$data_value of type
{
{            list of any of
{                string
{                range of string 1
{              anyend
{
{   Each string element represents all of the characters in the string.  Each
{   range element represents all of the characters between and including the
{   low character of the range and the high character.
{
{ LIST_VALUE: (input)  This parameter specifies the list to be processed.
{
{ CHARACTERS: (output)  This parameter specifies the set of characters.
{

  PROCEDURE build_character_set
    (    list_value: ^clt$data_value;
     VAR characters: clt$string_pattern_characters);

    VAR
      c: char,
      high_char: char,
      i: clt$string_index,
      low_char: char,
      node: ^clt$data_value;


    characters := $clt$string_pattern_characters [];
    node := list_value;
    WHILE (node <> NIL) AND (node^.kind = clc$list) AND (node^.element_value <> NIL) DO

      IF node^.element_value^.kind = clc$string THEN
        FOR i := 1 TO STRLENGTH (node^.element_value^.string_value^) DO
          characters := characters + $clt$string_pattern_characters [node^.element_value^.string_value^ (i)];
        FOREND;

      ELSE {clc$range}
        low_char := node^.element_value^.low_value^.string_value^ (1);
        high_char := node^.element_value^.high_value^.string_value^ (1);

        IF low_char <= high_char THEN
          FOR c := low_char TO high_char DO
            characters := characters + $clt$string_pattern_characters [c];
          FOREND;

        ELSE
          FOR c := high_char DOWNTO low_char DO
            characters := characters + $clt$string_pattern_characters [c];
          FOREND;
        IFEND;
      IFEND;

      node := node^.link;
    WHILEND;

  PROCEND build_character_set;
?? TITLE := 'copy_pattern_elements', EJECT ??

{
{ PURPOSE:
{   This procedure copies all of the element from one pattern, the source to
{   the end of another pattern, the destination.  In the process it adjusts
{   all of the element links and other relative pointers within the copied
{   elements to be correct for their relative position within the destination
{   pattern.  Also, the link to the logically first of the copied elements is
{   returned.
{
{ SOURCE_PATTERN: (input)  This parameter specifies the pattern whose elements
{       are to be copied.
{
{ DESTINATION_PATTERN_AREA: (input, output)  This parameter specifies
{       destination pattern.  This sequence pointer is assumed, on input, to be
{       positioned at the logical end of the destination pattern and is updated
{       to reflect the amount of space occupied by the copied elements.
{
{ INITIAL_COPIED_ELEMENT_LINK: (input, output)  This parameter specifies the
{       link to the logically first element of the copied elements.  If NIL
{       on input, the link is obtained from the source pattern's header.
{

  PROCEDURE copy_pattern_elements
    (    source_pattern: ^clt$string_pattern;
     VAR destination_pattern_area {input, output} : ^clt$string_pattern;
     VAR initial_copied_element_link: clt$string_pattern_element_link);

    VAR
      destination_offset: ost$segment_offset,
      destination_pattern: ^clt$string_pattern,
      destination_pattern_header: ^clt$string_pattern_header,
      i: clt$string_pattern_size,
      new_pattern_elements: ^SEQ ( * ),
      old_pattern_elements: ^SEQ ( * ),
      pattern_element: ^clt$string_pattern_element,
      skip_extra_info: ^array [1 .. * ] of cell,
      source_pattern_area: ^clt$string_pattern,
      source_pattern_header: ^clt$string_pattern_header;


    source_pattern_area := source_pattern;
    RESET source_pattern_area;
    NEXT source_pattern_header IN source_pattern_area;

    IF initial_copied_element_link = NIL THEN
      initial_copied_element_link := source_pattern_header^.initial_element;
    IFEND;

    IF initial_copied_element_link = NIL THEN

{ The pattern is empty, so there's nothing to do.

      RETURN;
    IFEND;

{ Copy all of the source pattern elements to the destination pattern area.

    NEXT old_pattern_elements: [[REP #SIZE (source_pattern_area^) - #SIZE (clt$string_pattern_header) OF
          cell]] IN source_pattern_area;
    NEXT new_pattern_elements: [[REP #SIZE (old_pattern_elements^) OF cell]] IN destination_pattern_area;
    new_pattern_elements^ := old_pattern_elements^;
    RESET destination_pattern_area TO new_pattern_elements;

{ Calculate the amount by which relative pointers in the source pattern must be
{ adjusted once they have been copied into the destination pattern.

    destination_offset := i#current_sequence_position (destination_pattern_area) -
          #SIZE (clt$string_pattern_header);

{ Adjust the link to the logically first element of the copied pattern.

    adjust_relative_pointer (#LOC (initial_copied_element_link), destination_offset);

    FOR i := 1 TO source_pattern_header^.number_of_elements DO
      NEXT pattern_element IN destination_pattern_area;

{ Adjust the links to the successor and alternative elements.

      adjust_relative_pointer (#LOC (pattern_element^.successor), destination_offset);
      adjust_relative_pointer (#LOC (pattern_element^.alternative), destination_offset);

{ Adjust the relative pointer to extra information which follows the element.

      CASE pattern_element^.kind OF
      = clc$sp_capture_begin =
        adjust_relative_pointer (#LOC (pattern_element^.capture_end_element), destination_offset);
      = clc$sp_capture_end, clc$sp_capture_index =
        CASE pattern_element^.capture_kind OF
        = clc$sp_capture_via_command =
          adjust_relative_pointer (#LOC (pattern_element^.capture_command), destination_offset);
        = clc$sp_capture_via_variable =
          adjust_relative_pointer (#LOC (pattern_element^.capture_variable), destination_offset);
        ELSE
        CASEND;
      = clc$sp_characters, clc$sp_multiple, clc$sp_one_character, clc$sp_upto_character =
        adjust_relative_pointer (#LOC (pattern_element^.characters), destination_offset);
      = clc$sp_string_literal =
        adjust_relative_pointer (#LOC (pattern_element^.string_literal), destination_offset);
      = clc$sp_test =
        adjust_relative_pointer (#LOC (pattern_element^.test_expression), destination_offset);
      = clc$sp_unevaluated_pattern =
        adjust_relative_pointer (#LOC (pattern_element^.unevaluated_pattern), destination_offset);
      ELSE
      CASEND;

      IF pattern_element^.extra_info_size > 0 THEN

{ Skip over any additional information for the pattern element.

        NEXT skip_extra_info: [1 .. pattern_element^.extra_info_size] IN destination_pattern_area;
      IFEND;
    FOREND;

{ Update the number of elements in the destination pattern.

    destination_pattern := destination_pattern_area;
    RESET destination_pattern;
    NEXT destination_pattern_header IN destination_pattern;
    destination_pattern_header^.number_of_elements := destination_pattern_header^.number_of_elements +
          source_pattern_header^.number_of_elements;

  PROCEND copy_pattern_elements;
?? TITLE := 'initialize_char_set_element', EJECT ??

{
{ PURPOSE:
{   This procedure initializes a new pattern element as one of the pattern
{   elements that is qualified by a set of characters.  It allocates space for
{   the character set itself.  If there isn't enough space for the character
{   set, the CHARACTERS field of the PATTERN_ELEMENT is set to NIL.
{
{ CHAR_SET: (input)  This parameter specifies the set of characters that
{       qualify the pattern element.
{
{ PATTERN_ELEMENT: (input)  This parameter points to the new pattern element.
{
{ PATTERN: (input)  This parameter specifies the string pattern for which the
{       element is to be initialized.
{
{ WORK_AREA: (input, output)  This parameter specifies the work area in which
{       the character set is to be allocated.
{

  PROCEDURE [INLINE] initialize_char_set_element
    (    char_set: clt$string_pattern_characters;
         pattern_element: ^clt$string_pattern_element;
         pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area);

    VAR
      characters: ^clt$string_pattern_characters;


    NEXT characters IN work_area;
    pattern_element^.characters := #REL (characters, pattern^);
    IF characters <> NIL THEN
      characters^ := char_set;
      pattern_element^.extra_info_size := #SIZE (clt$string_pattern_characters);
    IFEND;

  PROCEND initialize_char_set_element;
?? TITLE := 'initialize_char_set_pattern', EJECT ??

{
{   This request builds a string pattern consisting of one of the pattern
{ elements which is qualified by a set of characters.
{
{       INITIALIZE_CHAR_SET_PATTERN (KIND, CHAR_SET, COUNT, WORK_AREA, PATTERN,
{         STATUS)
{
{ KIND: (input)  This parameter specifies the kind of the pattern element.
{
{ CHAR_SET: (input)  This parameter specifies the set of characters to be used
{       for the pattern element.
{
{ COUNT: (input)  This parameter specifies the COUNT and MIN_SUBJECT_SIZE
{       fields for the pattern element.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE [INLINE] initialize_char_set_pattern
    (    kind: clt$string_pattern_element_kind;
         char_set: clt$string_pattern_characters;
         count: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) +
          #SIZE (clt$string_pattern_characters) OF cell]] IN work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := kind;
    initialize_char_set_element (char_set, pattern_element, pattern, pattern);
    pattern_element^.count := count;
    pattern_element^.min_subject_size := count;

    RESET pattern;

  PROCEND initialize_char_set_pattern;
?? TITLE := 'initialize_count_pattern', EJECT ??

{
{   This request builds a string pattern consisting of one of the pattern
{ elements which is qualified by a count.
{
{       INITIALIZE_COUNT_PATTERN (KIND, COUNT, MIN_SUBJECT_SIZE, WORK_AREA,
{         PATTERN, STATUS)
{
{ KIND: (input)  This parameter specifies the kind of the pattern element.
{
{ COUNT: (input)  This parameter specifies the COUNT and MIN_SUBJECT_SIZE
{       fields for the pattern element.
{
{ MIN_SUBJECT_SIZE: (input)  This parameter specifies the minimum number of
{       characters the pattern element matches.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE [INLINE] initialize_count_pattern
    (    kind: clt$string_pattern_element_kind;
         count: clt$string_size;
         min_subject_size: clt$string_size;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) OF cell]] IN
          work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := kind;
    pattern_element^.count := count;
    pattern_element^.min_subject_size := min_subject_size;

    IF (kind = clc$sp_count) OR (kind = clc$sp_multiple) THEN
      pattern_element^.characters := NIL;
    IFEND;

    RESET pattern;

  PROCEND initialize_count_pattern;
?? TITLE := 'initialize_pattern_element', EJECT ??

{
{ PURPOSE:
{   This procedure allocates space for and initializes a new pattern element.
{
{ PATTERN: (input)  This parameter specifies the string pattern for for which
{       the element is to be initialized.
{
{ WORK_AREA: (input, output)  This parameter specifies the work area in which
{       the pattern element is to be allocated.
{
{ NUMBER_OF_ELEMENTS: (input, output)  This parameter specifies the number of
{       elements in the pattern for which this element is being initialized.
{       It is incremented by 1 by this procedure.
{
{ PATTERN_ELEMENT_LINK: (output)  This parameter specifies the linkage field
{       for the element to be initialized.  This linkage field is set by this
{       procedure once space for the new pattern element has been allocated.
{
{ PATTERN_ELEMENT: (output)  This parameter is set to point to the new pattern
{       element.  If there is no room in the work area for the pattern element,
{       NIL is returned.
{

  PROCEDURE [INLINE] initialize_pattern_element
    (    pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area;
     VAR number_of_elements {input, output} : clt$string_size;
     VAR pattern_element_link: clt$string_pattern_element_link;
     VAR pattern_element: ^clt$string_pattern_element);


    NEXT pattern_element IN work_area;

    IF pattern_element <> NIL THEN
      pattern_element_link := #REL (pattern_element, pattern^);

      pattern_element^.successor := NIL;
      pattern_element^.alternative := NIL;
      pattern_element^.min_subject_size := 0;
      pattern_element^.alternative_min_subject_size := 0;
      pattern_element^.count := 0;
      pattern_element^.extra_info_size := 0;

      number_of_elements := number_of_elements + 1;
    IFEND;

  PROCEND initialize_pattern_element;
?? TITLE := 'initialize_pattern_header', EJECT ??

{
{ PURPOSE:
{   This procedure allocates space for and initializes a new pattern header.
{       It is incremented by 1 by this procedure.
{
{ WORK_AREA: (input, output)  This parameter specifies the work area in which
{       the pattern element is to be allocated.
{
{ PATTERN_HEADER: (output)  This parameter is set to point to the new pattern
{       header.  If there is no room in the work area for the pattern header,
{       NIL is returned.
{

  PROCEDURE [INLINE] initialize_pattern_header
    (VAR work_area {input, output} : ^clt$work_area;
     VAR pattern_header: ^clt$string_pattern_header);


    NEXT pattern_header IN work_area;
    IF pattern_header <> NIL THEN
      pattern_header^.version := clc$string_pattern_version;
      pattern_header^.number_of_elements := 0;
      pattern_header^.initial_element := NIL;
    IFEND;

  PROCEND initialize_pattern_header;
?? TITLE := 'initialize_string_lit_element', EJECT ??

{
{ PURPOSE:
{   This procedure initializes a new pattern element as a string literal
{   pattern element.  It allocates space for the string literal itself.
{   If there isn't enough space for the string literal, the STRING_LITERAL
{   field of the PATTERN_ELEMENT is set to NIL.
{
{ STR: (input)  This parameter specifies the string literal for the pattern
{       element.
{
{ CASE_SENSITIVE: (input)  This parameter specifies whether the case (lower or
{       upper) matters (TRUE) or not (FALSE) when matching STR.
{
{ PATTERN_ELEMENT: (input)  This parameter points to the new pattern element.
{
{ PATTERN: (input)  This parameter specifies the string pattern for which the
{       element is to be initialized.
{
{ WORK_AREA: (input, output)  This parameter specifies the work area in which
{       the pattern element is to be allocated.
{

  PROCEDURE [INLINE] initialize_string_lit_element
    (    str: ^clt$string_value;
         case_sensitive: boolean;
         pattern_element: ^clt$string_pattern_element;
         pattern: ^clt$string_pattern;
     VAR work_area {input, output} : ^clt$work_area);

    VAR
      string_literal: ^clt$string_value;


    pattern_element^.kind := clc$sp_string_literal;
    pattern_element^.case_sensitive := case_sensitive;
    NEXT string_literal: [STRLENGTH (str^)] IN work_area;
    pattern_element^.string_literal := #REL (string_literal, pattern^);
    IF string_literal <> NIL THEN
      string_literal^ := str^;
      pattern_element^.extra_info_size := #SIZE (string_literal^);
      pattern_element^.min_subject_size := STRLENGTH (string_literal^);
    IFEND;

  PROCEND initialize_string_lit_element;
?? TITLE := 'initialize_unqualified_pattern', EJECT ??

{
{   This request builds a string pattern consisting of one of the pattern
{ elements which requires no qualifying information.
{
{       INITIALIZE_UNQUALIFIED_PATTERN (KIND, WORK_AREA, PATTERN, STATUS)
{
{ KIND: (input)  This parameter specifies the kind of the pattern element.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage that
{       will be used to construct the resulting string pattern.  The current
{       position of this sequence pointer is updated to reflect the amount of
{       storage used by the request.  The resulting string pattern is contained
{       completely within the used part of this sequence.
{
{ PATTERN: (output)  This parameter specifies the result string pattern.
{
{ STATUS: (output)  This parameter specifies the request completion status.
{

  PROCEDURE [INLINE] initialize_unqualified_pattern
    (    kind: clt$string_pattern_element_kind;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pattern: ^clt$string_pattern;
     VAR status: ost$status);

    VAR
      pattern_element: ^clt$string_pattern_element,
      pattern_header: ^clt$string_pattern_header;


    status.normal := TRUE;

    NEXT pattern: [[REP #SIZE (clt$string_pattern_header) + #SIZE (clt$string_pattern_element) OF cell]] IN
          work_area;
    IF pattern = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    RESET pattern;

    initialize_pattern_header (pattern, pattern_header);

    initialize_pattern_element (pattern, pattern, pattern_header^.number_of_elements,
          pattern_header^.initial_element, pattern_element);

    pattern_element^.kind := kind;

    RESET pattern;

  PROCEND initialize_unqualified_pattern;
?? TITLE := 'link_alternative_to_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure links an alternative pattern to an existing pattern.
{   If the existing pattern already has alternatives, the new one is
{   added to the end of the chain of alternatives.  Also, the
{   ALTERNATIVE_MIN_SUBJECT_SIZE field of every element in the alternative
{   chain is set to the minimum subject size required by the new if the
{   new alternative is shorter.
{
{ PATTERN: (input)  This parameter specifies the string pattern.
{
{ FIRST_PATTERN_ELEMENT: (input)  This parameter specifies the first
{       element of the pattern to which an alternative is being added.
{
{ ALTERNATIVE_ELEMENT_LINK: (input)  This parameter specifies the link to
{       the new alternative.
{
{ MIN_ALTERNATIVE_SIZE: (input)  This parameter specifies the minimum
{       subject size required by the new alternative.
{

  PROCEDURE [INLINE] link_alternative_to_pattern
    (    pattern: ^clt$string_pattern;
         first_pattern_element: ^clt$string_pattern_element;
         alternative_element_link: clt$string_pattern_element_link;
         min_alternative_size: clt$string_size);

    VAR
      linkage_element: ^clt$string_pattern_element;


    linkage_element := first_pattern_element;
    WHILE linkage_element^.alternative <> NIL DO

{ Set the current element's ALTERNATIVE_MIN_SUBJECT_SIZE  to the lesser of its
{ present value and the new alternative's minimum subject size.

      IF min_alternative_size < linkage_element^.alternative_min_subject_size THEN
        linkage_element^.alternative_min_subject_size := min_alternative_size;
      IFEND;

      linkage_element := #PTR (linkage_element^.alternative, pattern^);
    WHILEND;

{ Link the new alternative to the end of the "chain" of existing alternatives.

    linkage_element^.alternative := alternative_element_link;
    linkage_element^.alternative_min_subject_size := min_alternative_size;

  PROCEND link_alternative_to_pattern;
?? TITLE := 'link_successor_to_pattern', EJECT ??

{
{ PURPOSE:
{   This procedure links all of the terminal nodes within a group of
{   pattern elements to the group's successor.  It also increments the
{   MIN_SUBJECT_SIZE and ALTERNATIVE_MIN_SUBJECT_SIZE fields of every
{   element in the group by the minimum subject size required by the
{   group's successor or its alternatives.
{
{ PATTERN: (input)  This parameter specifies the string pattern.
{
{ FIRST_PATTERN_ELEMENT: (input)  This parameter specifies the first
{       element of the group to be updated.
{
{ NUMBER_OF_ELEMENTS: (input)  This parameter specifies the number of
{       elements in the group.
{
{ SUCCESSOR_ELEMENT_LINK: (input)  This parameter specifies the link to
{       the group's successor.
{
{ MIN_SUCCESSOR_SIZE: (input)  This parameter specifies the minimum
{       subject size required by the group's successor or its
{       alternatives.
{

  PROCEDURE [INLINE] link_successor_to_pattern
    (    pattern: ^clt$string_pattern;
         first_pattern_element: ^clt$string_pattern_element;
         number_of_elements: clt$string_pattern_size;
         successor_element_link: clt$string_pattern_element_link;
         min_successor_size: clt$string_size);

    VAR
      i: clt$string_pattern_size,
      pattern_area: ^clt$string_pattern,
      pattern_element: ^clt$string_pattern_element,
      skip_extra_info: ^array [1 .. * ] of cell;


    pattern_area := pattern;
    RESET pattern_area TO first_pattern_element;

    FOR i := 1 TO number_of_elements DO
      NEXT pattern_element IN pattern_area;

{ Add the minimum size of the pattern's successor to the minimum subject
{ size fields of the element.

      pattern_element^.min_subject_size := pattern_element^.min_subject_size + min_successor_size;
      pattern_element^.alternative_min_subject_size := pattern_element^.alternative_min_subject_size +
            min_successor_size;
      IF pattern_element^.successor = NIL THEN

{ Link this terminal node of the pattern to the pattern's successor.

        pattern_element^.successor := successor_element_link;
      IFEND;

      IF (i < number_of_elements) AND (pattern_element^.extra_info_size > 0) THEN

{ Skip over any additional information for the pattern element.

        NEXT skip_extra_info: [1 .. pattern_element^.extra_info_size] IN pattern_area;
      IFEND;
    FOREND;

  PROCEND link_successor_to_pattern;
?? TITLE := 'min_subject_size', EJECT ??

{
{ PURPOSE:
{   This function returns the lesser of a CLT$STRING_PATTERN_ELEMENT's
{   MIN_SUBJECT_SIZE and ALTERNATIVE_MIN_SUBJECT_SIZE fields.
{

  FUNCTION [INLINE] min_subject_size
    (    pattern_element: ^clt$string_pattern_element): clt$string_size;


    IF pattern_element^.min_subject_size <= pattern_element^.alternative_min_subject_size THEN
      min_subject_size := pattern_element^.min_subject_size;
    ELSE
      min_subject_size := pattern_element^.alternative_min_subject_size;
    IFEND;

  FUNCEND min_subject_size;
?? TITLE := 'open_string_pattern', EJECT ??

  PROCEDURE [INLINE] open_string_pattern
    (    pattern: ^clt$string_pattern;
     VAR pattern_header: ^clt$string_pattern_header;
     VAR initial_pattern_element: ^clt$string_pattern_element;
     VAR status: ost$status);

    VAR
      pattern_sequence: ^clt$string_pattern;


    status.normal := TRUE;

    pattern_sequence := pattern;
    RESET pattern_sequence;
    NEXT pattern_header IN pattern_sequence;

    IF (pattern_header = NIL) OR (pattern_header^.version <> clc$string_pattern_version) THEN
      osp$set_status_condition (cle$bad_string_pattern, status);
    ELSE
      initial_pattern_element := #PTR (pattern_header^.initial_element, pattern^);
    IFEND;

  PROCEND open_string_pattern;

MODEND clm$string_pattern_handlers;
