?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL PROC Formatter' ??
MODULE clm$format_scl_proc;

{ PURPOSE:
{   The purpose of this module is to provide the basic procedures
{   of the SCL formatter.

{ FORMATTER REQUIREMENTS:

{  .The SCL formatter will read an input file of SCL statements and
{   will output the statements in a more readable - or at least a more
{   consistent - format while also checking for basic syntax errors.

{  .Detailed description of the formatter output is given in the user
{   documentation.

{ DESIGN CONSIDERAIONS:

{   In order to achieve its goal of recognizing SCL tokens (names,
{   strings, etc.), groups of tokens (such as a file reference), and
{   statement types, the formatter uses several modified SCL interpreter
{   procedures. The modified modules, procedures, variables, and CYBIL
{   types have F_ appended to the dollar sign of the original names - for
{   example, the modified clp$scan_expression procedure becomes clp$f_scan_expression.
{   Modification of interpreter procedures and modules will consist, in
{   most cases, of deleting code not needed or used by the formatter and
{   adding calls to interface procedures in this or other formatter
{   modules.
{
{   Data - in the form of input lines - usually flows through three processors:
{
{       .Input line processor.
{          Reads a line from the input file. Data lines - such as those encountered when
{          formatting is turned off - are passed on unmodified. A command line which
{          is continued has all of its continuation lines concatenated.
{
{       .Line scanner.
{          Scans a command line and generates an array of "format tokens" for the
{          line.  An entry in this array describes a clt$lexical_unit (such as
{          clt$lex_name) encountered in the line or it may serve to delineate a
{          group of units such as a file reference or a parameter. It is this
{          processor which makes use of modified interpreter procedures.
{
{       .Output line processor.
{          Generates the formatted output line based upon the contents of the format
{          token array and the formatter "environment" (such as current block
{          structure).

{ NOTES:

{   .As a command line is scanned by the formatter, an array (clv$current_array_ptr^)
{    and a semi-final output line (clv$current_line_ptr^) are built by the interface
{    routines. An entry in the array points to the beginning of the corresponding
{    string in the output line. Each entry also contains information concerning
{    the kind of interpreter unit (clt$lexical_unit_kind), the kind of formatter
{    token (clt$format_type), and the length of the string in the output line
{    associated with the entry.
{
{   .The array is initialized to contain zero entries. The current index into the
{    array is specified by clv$format_token_array_index.
{
{   .Certain entries in the array - called "format markers" - delineate
{    collections of tokens - called "packets" - which are of interest to
{    to the formatter. An example of such packets would be a series of
{    interpreter tokens which describe a file path name.  All such
{    format markers have an interpreter unit kind of clc$lex_unknown
{    and a token length of zero.
{
{   .Output line and array entries are usually generated by calls from
{    the  clp$f_scan_token procedure.  Format markers are usually
{    requested for inclusion by calls from other modified interpreter
{    procedures.

{  COMMENTS:
{   .The formatter has been modified to use clt$lexical_unit instead of clt$token,
{    to process long (up to 65K) command lines, and to (optionally) translate
{    from "old" SCL types, etc. to "new". These modifications do not provide for
{    formatting input in the "new" form so that it is expected that this formatter
{    will eventually be replaced (which serves as an excuse for some of the
{    "loose ends" which have not been cleaned up).

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_command_processing
*copyc amt$page_format
*copyc amt$page_length
*copyc amt$page_width
*copyc cle$ecc_compare_command
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parsing
*copyc cle$ecc_scl_formatter
*copyc clt$command_line
*copyc clt$command_line_index
*copyc clt$command_line_size
*copyc clt$f_block
*copyc clt$f_command_type
*copyc clt$f_control_statement_desc
*copyc clt$f_node_value
*copyc clt$file_reference
*copyc clt$format_marker_kind
*copyc clt$format_token_type
*copyc clt$interpreter_modes
*copyc clt$lexical_unit_kind
*copyc clt$lexical_unit_kinds
*copyc clt$parameter_list_size
*copyc clt$parse_state
*copyc clt$string_index
*copyc clt$string_size
*copyc clv$comment_delimiter
*copyc clv$non_space
*copyc clv$string_delimiter
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc amp$get_next
*copyc amp$put_next
*copyc clp$append_status_parse_state
*copyc clp$evaluate_parameters
*copyc clp$evaluate_sub_parameters
*copyc clp$f_pop_block_stack
*copyc clp$f_process_command
*copyc clp$f_push_block_stack
*copyc clp$f_scan_expression
*copyc clp$f_scan_token
*copyc clp$f_set_substitution_mark
*copyc clp$format_proc_header
*copyc clp$initialize_parse_state
*copyc clp$isolate_command
*copyc clp$process_utility_def_file
*copyc clp$search_format_utilities
*copyc clp$trimmed_string_size
*copyc clp$translate_function
*copyc fsp$close_file
*copyc fsp$get_open_information
*copyc fsp$open_file
*copyc mmp$create_scratch_segment
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osv$lower_to_upper
*copyc osv$upper_to_lower
?? EJECT ??

  TYPE
    output_line_record = record
      next_output_pointer: ^output_line_record,
      indent_column: clt$command_line_index,
      output_line_size: clt$command_line_size,
      output_line_ptr: ^clt$command_line,
    recend;

  TYPE
    t$pushed_objects = record
      next_p: ^t$pushed_objects,
      formatting_in_effect: boolean,
      page_width: clt$command_line_size,
    recend;

  CONST
    continuation_indicator_size = 2,
    min_page_width = 65,
    min_usable_space = 65,
    max_page_width = clc$max_command_line_size;

  VAR
    input_file_id: amt$file_identifier,
    output_file_id: amt$file_identifier;

  VAR
    work_area_segment: [STATIC] amt$segment_pointer := [amc$sequence_pointer, NIL];

  CONST
    clc$max_error_count = 100,
    clc$indent_increment = 2,
    clc$continuation_increment = 6;

  TYPE
    clt$command_header = record
      command_type: clt$f_command_type,
      command_line_ptr: ^clt$command_line,
      labeled: boolean,
      input_line_number: integer,
      output_line_number: integer,
      command_line_size: clt$command_line_size,
    recend;

  VAR
    clv$input_line_ptr: [STATIC] ^clt$command_line; {For use by clp$get_statement_to_format only,}
                                                    {and clp$f_process_var_or_type.}
  VAR
    v$pushed_objects_p: ^t$pushed_objects := NIL;

  VAR
    clv$add_format_tokens: boolean := TRUE,
    clv$collecting_text: boolean := FALSE,
    clv$colt_until_value: string (osc$max_string_size),
    clv$command_header: clt$command_header,
    clv$continuation_indent_bias: 0 .. clc$continuation_increment,
    clv$current_indent_column: clt$command_line_index,
    clv$current_line_ptr: ^clt$command_line,
    clv$current_line_size: clt$command_line_size,
    clv$error_count: 0 .. amc$file_byte_limit,
    clv$file_position: amt$file_position,
    clv$formatting_in_effect: [XDCL] boolean := TRUE,
    clv$format_line: string (clc$max_command_line_size),
    clv$format_token_array_index: clt$token_array_index,
    clv$input_line_index: clt$command_line_index := 1,
    clv$input_line_size: 0 .. clc$max_command_line_size := 0,
    clv$current_array_ptr: ^clt$format_token_array,
    clv$format_token_array: clt$format_token_array,
    clv$key_character: char := '*',
    clv$last_command_blank: boolean,
    clv$last_command_type: clt$f_command_type,
    clv$last_non_zero_size_index: clt$token_array_index,
    clv$output_line_number: integer,
    clv$page_width: clt$command_line_size,
    clv$process_collect_text: boolean,
    clv$processing_crev: boolean := FALSE,
    clv$save_indent_column: clt$command_line_index,
    clv$saved_blank_lines: 0 .. 5000 := 0,
    clv$space: string (1) := ' ',
    clv$translate: [XDCL] boolean,
    clv$warning_count: 0 .. amc$file_byte_limit;

  VAR
    indent_number: integer,
    number_of_structured_types: integer;

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

  PROGRAM [XDCL] clp$format_scl_proc
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PURPOSE: This procedure provides the starting procedure for the SCL
{   formatter and controls the formatting process.


    VAR
      got_line: boolean,
      line_ptr: ^clt$command_line,
      local_status: ost$status;

    status.normal := TRUE;
    PUSH clv$input_line_ptr: [clc$max_command_line_size];
    initialize (parameter_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_statement_to_format (line_ptr, got_line, status);

  /doit/
    WHILE got_line DO
      IF status.normal THEN
        IF (clv$last_command_type = clc$proc_declaration) AND (NOT clv$last_command_blank) THEN
          put_line ('', local_status);
        IFEND;
        clv$last_command_type := clc$empty_command;
        clp$f_process_command (clc$interpret_mode, line_ptr, status);
      IFEND;
      IF status.normal THEN
        IF (clv$command_header.command_type <> clc$proc_declaration) AND
              (clv$command_header.command_type <> clc$end_colt_command) AND
              (clv$command_header.command_type <> clc$var_or_type_statement) THEN
          clp$format_line (status);
        IFEND;
      IFEND;
      IF NOT status.normal THEN
        report_status (status, clv$input_line_ptr^ (1, clv$input_line_size), local_status);
        status.normal := TRUE;
        IF (status.condition = cle$table_overflow) OR (clv$error_count >= clc$max_error_count) OR
              (clv$file_position = amc$eoi) THEN
          EXIT /doit/;
        IFEND;
      IFEND;
      clv$last_command_type := clv$command_header.command_type;
      clp$get_statement_to_format (line_ptr, got_line, status);
    WHILEND /doit/;

    IF status.normal AND clv$processing_crev THEN

{Windup

      translate_create_variable (1, 1, NIL, clv$current_indent_column, status);
    IFEND;

    fsp$close_file (input_file_id, local_status);
    IF (NOT local_status.normal) AND status.normal THEN
      status := local_status;
    IFEND;
    fsp$close_file (output_file_id, local_status);
    IF (NOT local_status.normal) AND status.normal THEN
      status := local_status;
    IFEND;

    IF status.normal THEN
      IF clv$error_count >= clc$max_error_count THEN
        osp$set_status_abnormal ('CL', cle$max_error_count_reached, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, clv$error_count, 10, FALSE, status);
      ELSEIF (clv$warning_count > 0) AND (clv$error_count = 0) THEN
        osp$set_status_abnormal ('CL', cle$warnings_encountered, '', status);
        osp$append_status_integer (' ', clv$warning_count, 10, FALSE, status);
      ELSEIF (clv$warning_count = 0) AND (clv$error_count > 0) THEN
        osp$set_status_abnormal ('CL', cle$errors_encountered, '', status);
        osp$append_status_integer (' ', clv$error_count, 10, FALSE, status);
      ELSEIF (clv$warning_count > 0) AND (clv$error_count > 0) THEN
        osp$set_status_abnormal ('CL', cle$errors_and_warnings, '', status);
        osp$append_status_integer (' ', clv$error_count, 10, FALSE, status);
        osp$append_status_integer (' ', clv$warning_count, 10, FALSE, status);
      IFEND;
    IFEND;

  PROCEND clp$format_scl_proc;
?? TITLE := 'clp$add_format_token', EJECT ??

  PROCEDURE [XDCL] clp$add_format_token
    (    str_ptr: ^string ( * );
         clt_kind: clt$lexical_unit_kind;
         format_type: clt$format_token_type);

{ PURPOSE:
{     The purpose of this procedure is to add an entry to the format
{     token array and to add to the output line the string representing the token.

    VAR
      old_size: clt$command_line_size,
      size: clt$command_line_size,
      start_index: clt$command_line_size;

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

{ Do not enter duplicate spaces.

    IF (clt_kind = clc$lex_space) AND (clv$format_token_array_index > 0) THEN
      IF (clv$current_array_ptr^ [clv$format_token_array_index].clt_kind = clt_kind) AND
            (clv$current_array_ptr^ [clv$format_token_array_index].format_type = format_type) THEN
        RETURN;
      IFEND;
    IFEND;

{ Check for two strings in a row.

    IF (clt_kind IN $clt$lexical_unit_kinds [clc$lex_string, clc$lex_unterminated_string]) AND
          ((clv$current_array_ptr^ [clv$format_token_array_index].clt_kind = clc$lex_unterminated_string) OR
          (clv$current_array_ptr^ [clv$format_token_array_index].clt_kind = clc$lex_string)) THEN
      size := STRLENGTH (str_ptr^);
      old_size := clv$current_array_ptr^ [clv$format_token_array_index].token_size;
      clv$current_line_ptr^ (clv$current_line_size + 1, size) := str_ptr^;
      clv$current_array_ptr^ [clv$format_token_array_index].string_ptr :=
            ^clv$current_line_ptr^ (clv$current_line_size - old_size + 1, old_size + size);
      clv$current_line_size := clv$current_line_size + size;
      size := size + old_size;
      clv$current_array_ptr^ [clv$format_token_array_index].token_size := size;
    ELSE
      clv$format_token_array_index := clv$format_token_array_index + 1;

{move end_of_line indicator

      clv$current_array_ptr^ [clv$format_token_array_index + 1] :=
            clv$current_array_ptr^ [clv$format_token_array_index];

      clv$current_array_ptr^ [clv$format_token_array_index].clt_kind := clt_kind;

      IF clt_kind = clc$lex_space THEN
        size := 1;
      ELSEIF clt_kind = clc$lex_end_of_line THEN
        size := 0;
      ELSE
        size := STRLENGTH (str_ptr^);
      IFEND;
      IF size > 0 THEN
        clv$current_line_ptr^ (clv$current_line_size + 1, size) := str_ptr^;
        clv$current_array_ptr^ [clv$format_token_array_index].string_ptr :=
              ^clv$current_line_ptr^ (clv$current_line_size + 1, size);
        clv$current_line_size := clv$current_line_size + size;
      IFEND;

      clv$current_array_ptr^ [clv$format_token_array_index].token_size := size;
      clv$current_array_ptr^ [clv$format_token_array_index].format_type := format_type;
    IFEND;


  PROCEND clp$add_format_token;
?? TITLE := 'clp$delete_current_format_token', EJECT ??

  PROCEDURE [XDCL] clp$delete_current_format_token;

{ PURPOSE:
{    The purpose of this procedure is to delete the current format token from the
{    format token array.
{

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

{ move end_of-line indicator

    clv$current_array_ptr^ [clv$format_token_array_index] :=
          clv$current_array_ptr^ [clv$format_token_array_index + 1];
    clv$format_token_array_index := clv$format_token_array_index - 1;

  PROCEND clp$delete_current_format_token;
?? TITLE := 'clp$delete_node_format_token', EJECT ??

  PROCEDURE [XDCL] clp$delete_node_format_token
    (    index: clt$token_array_index);

{ PURPOSE:
{    The purpose of this procedure is to delete the current format token from the
{    format token array.
{

    VAR
      node_values: [STATIC, READ] set of clt$f_node_value :=
            [clc$null_node, clc$or_node, clc$and_node, clc$not_node, clc$rel_node, clc$cat_node, clc$add_node,
            clc$mul_node, clc$exp_node];

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

    CASE clv$current_array_ptr^ [index].format_type OF
    = clc$tree_begin, clc$node, clc$tree_end =
      IF clv$current_array_ptr^ [index].node_value IN node_values THEN
        clv$current_array_ptr^ [index] := clv$current_array_ptr^ [index + 1];
        clv$format_token_array_index := clv$format_token_array_index - 1;
      IFEND;
    ELSE
      ;
    CASEND;

  PROCEND clp$delete_node_format_token;
?? TITLE := 'clp$f_add_node_value', EJECT ??

  PROCEDURE [XDCL] clp$f_add_node_value
    (    node_value: clt$f_node_value);

{ PURPOSE:
{     The purpose of this procedure is to add to the nearest node format token
{     the node value specified.
{

    CONST
      max_node_names = 4,
      max_operator_name_size = 3;

    VAR
      node_kinds: [STATIC, READ] set of clt$lexical_unit_kind :=
            [clc$lex_name, clc$lex_greater_than, clc$lex_greater_equal, clc$lex_less_than, clc$lex_less_equal,
            clc$lex_equal, clc$lex_not_equal, clc$lex_concatenate, clc$lex_add, clc$lex_subtract,
            clc$lex_multiply, clc$lex_divide, clc$lex_exponentiate],

      node_names: [STATIC, READ] array [1 .. max_node_names] of string (max_operator_name_size) := {} ['OR',
            'XOR', 'AND', 'NOT'],
      i: 1 .. max_node_names,
      index: clt$token_array_index,
      temp_name: string (max_operator_name_size),
      current_token: clt$format_token;

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

  /find_node/
    FOR index := clv$format_token_array_index DOWNTO 1 DO
      current_token := clv$current_array_ptr^ [index];
      IF current_token.clt_kind IN node_kinds THEN
        IF (current_token.clt_kind = clc$lex_name) AND (current_token.token_size <= max_operator_name_size)
              THEN
          temp_name := '  ';
          #TRANSLATE (osv$lower_to_upper, current_token.string_ptr^, temp_name);
          FOR i := 1 TO max_node_names DO
            IF node_names [i] = temp_name THEN
              current_token.string_ptr^ := temp_name;
              EXIT /find_node/;
            IFEND;
          FOREND;
        ELSE
          EXIT /find_node/;
        IFEND;
      IFEND;
    FOREND /find_node/;

    IF index = 1 THEN
      RETURN;
    IFEND;
    clv$current_array_ptr^ [index].format_type := clc$node;
    clv$current_array_ptr^ [index].node_value := node_value;

  PROCEND clp$f_add_node_value;
?? TITLE := 'clp$f_get_token_index', EJECT ??

  PROCEDURE [XDCL] clp$f_get_token_index
    (VAR index: integer);

{ PURPOSE:
{   The purpose of this procedure is to obtain the current index into the token
{   array for use in a possible future call to clp$f_set_tree_marker.
{

    index := clv$format_token_array_index;

  PROCEND clp$f_get_token_index;
?? TITLE := 'clp$format_line', EJECT ??

  PROCEDURE clp$format_line
    (VAR status: ost$status);

{ PURPOSE:
{   The purpose of this procedure is to generate and output the
{   final formatted line. Procedures called only by this procedure
{   may be nested within this procedure.

    VAR
      begin_count: clt$string_size,
      begin_type: clt$format_token_type,
      continuation_indent_size: clt$command_line_size,
      continuation_lines_with_indent: clt$command_line_size,
      current_string: string (osc$max_string_size),
      escape_encountered: boolean,
      end_type: clt$format_token_type,
      previous_token: clt$format_token,
      current_token: clt$format_token,
      max_array_index: clt$token_array_index,
      temp_name: ost$name,
      temp_index: clt$token_array_index,
      format_index: clt$token_array_index,
      line_ptr: ^clt$command_line,
      line_size: clt$command_line_size,
      indent_size: clt$command_line_size,
      name_size: 0 .. osc$max_name_size,
      final_token_count: clt$token_array_index,
      save_indent: clt$command_line_index,
      first_output_pointer: ^output_line_record,
      current_output_pointer: ^output_line_record,
      last_output_pointer: ^output_line_record,
      packet: ^clt$command_line,
      packet_line_begin: clt$command_line_index,
      packet_size: clt$command_line_size,
      translate_line_ptr: ^clt$command_line,
      translate_line_size: clt$command_line_size,
      first_index: clt$token_array_index,
      line_to_print: ^clt$command_line;

?? NEWTITLE := 'fits_on_current/next_line', EJECT ??

    FUNCTION [INLINE] fits_on_current_line
      (    string_size: clt$string_size;
           reserve_size: 0 .. continuation_indicator_size): boolean;

      fits_on_current_line := (current_output_pointer^.output_line_size + string_size +
            current_output_pointer^.indent_column - 1 + reserve_size) <= clv$page_width;

    FUNCEND fits_on_current_line;

    FUNCTION [INLINE] fits_on_next_line
      (    string_size: clt$string_size;
           indent: clt$command_line_size;
           reserve_size: 0 .. continuation_indicator_size): boolean;

      fits_on_next_line := (string_size + indent - 1 + reserve_size) < clv$page_width;

    FUNCEND fits_on_next_line;
?? OLDTITLE ??
?? NEWTITLE := 'rebuild_array', EJECT ??

    PROCEDURE rebuild_array
      (    array_ptr: ^clt$format_token_array;
           begin_index: clt$token_array_index;
           translate_line_ptr: ^clt$command_line;
       VAR translate_line_size: clt$command_line_size;
       VAR last_non_zero_size_index: clt$token_array_index;
       VAR output_index: clt$token_array_index;
       VAR status: ost$status);

{ PURPOSE:
{   The purpose of this procedure is to modify the specified format token array
{   such that the requirements for spaces are satisifed and that names are set
{   to the required case.

      TYPE
        command_types = set of clt$f_command_type;

      VAR
        upper_case_name_types: [STATIC, READ] command_types :=
              [clc$control_statement_begin, clc$control_statement_end, clc$control_statement_switch,
              clc$control_statement_no_switch, clc$procend_command, clc$collect_text_command,
              clc$utility_begin, clc$utility_end];

      VAR
        end_input_index: clt$token_array_index,
        first_name_found: boolean,
        input_index: clt$token_array_index,
        insert_spaces_for_assignment: boolean,
        parameter_level: 0 .. clc$max_command_line_size DIV 2,
        temp_format_array: ^clt$format_token_array,
        temp_name: ost$name,
        token: clt$format_token;

?? NEWTITLE := 'copy_format_token', EJECT ??

      PROCEDURE copy_format_token;

        output_index := output_index + 1;
        array_ptr^ [output_index] := token;
        IF token.token_size > 0 THEN
          previous_token := token;
          last_non_zero_size_index := output_index;
        IFEND;

      PROCEND copy_format_token;
?? OLDTITLE ??
?? NEWTITLE := 'insert_space_token', EJECT ??

      PROCEDURE insert_space_token;

        output_index := output_index + 1;

        array_ptr^ [output_index].clt_kind := clc$lex_space;
        array_ptr^ [output_index].token_size := 1;
        array_ptr^ [output_index].format_type := clc$unassigned;
        array_ptr^ [output_index].string_ptr := ^clv$space;
        previous_token := array_ptr^ [output_index];

      PROCEND insert_space_token;
?? OLDTITLE ??
?? NEWTITLE := 'delete_last_space_token', EJECT ??

      PROCEDURE delete_last_space_token;

{ PURPOSE:
{   The purpose of this procedure is to provide the rebuild_array
{   procedure the capability of deleting the last space token (which may
{   not be the current token due to format marker tokens existing).

        VAR
          index: clt$token_array_index,
          index2: clt$token_array_index,
          token: clt$format_token;

        FOR index := output_index DOWNTO 1 DO
          token := array_ptr^ [index];
          IF token.token_size > 0 THEN
            IF token.clt_kind = clc$lex_space THEN
              output_index := output_index - 1;
              FOR index2 := index TO output_index DO
                array_ptr^ [index2] := array_ptr^ [index2 + 1];
              FOREND;
              RETURN;
            ELSE
              RETURN;
            IFEND;
          IFEND;
        FOREND;

      PROCEND delete_last_space_token;
?? OLDTITLE, EJECT ??

      PUSH temp_format_array;
      end_input_index := output_index;
      FOR input_index := 1 TO end_input_index DO
        temp_format_array^ [input_index] := array_ptr^ [input_index];
      FOREND;
      temp_format_array^ [end_input_index + 1].clt_kind := clc$lex_end_of_line;
      temp_format_array^ [end_input_index + 1].token_size := 0;

      input_index := begin_index - 1;
      output_index := begin_index - 1;
      IF input_index > 0 THEN
        previous_token := temp_format_array^ [input_index];
      ELSE
        previous_token.clt_kind := clc$lex_unknown;
      IFEND;
      input_index := input_index + 1;
      token := temp_format_array^ [input_index];
      parameter_level := 0;
      first_name_found := FALSE;

    /rebuild/
      WHILE token.clt_kind <> clc$lex_end_of_line DO
        insert_spaces_for_assignment := FALSE;
        IF clv$translate AND (token.format_type = clc$function_begin) THEN
          translate_function (input_index, temp_format_array, translate_line_ptr, end_input_index,
                translate_line_size, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          temp_format_array^ [end_input_index + 1].clt_kind := clc$lex_end_of_line;
          temp_format_array^ [end_input_index + 1].token_size := 0;
          IF temp_format_array^ [input_index + 1].format_type = clc$function_begin THEN
            copy_format_token;
            input_index := input_index + 2;
          IFEND;
          token := temp_format_array^ [input_index];
        IFEND;

        IF (token.clt_kind = clc$lex_name) THEN
          IF NOT first_name_found THEN
            first_name_found := TRUE;
            IF clv$command_header.command_type IN upper_case_name_types THEN
              token.format_type := clc$reserved_name;
            IFEND;
          IFEND;
          temp_name := token.string_ptr^;
          IF (token.format_type <> clc$reserved_name) AND (token.format_type <> clc$node) THEN
            #TRANSLATE (osv$upper_to_lower, temp_name, token.string_ptr^);
          ELSE
            #TRANSLATE (osv$lower_to_upper, temp_name, token.string_ptr^);
          IFEND;
        IFEND;

        IF ((token.format_type = clc$node) AND (token.clt_kind <> clc$lex_name)) OR
              (token.clt_kind = clc$lex_assign) OR (token.clt_kind = clc$lex_ellipsis) THEN
          CASE clv$command_header.command_type OF
          = clc$assignment, clc$case_selection, clc$control_statement_begin, clc$control_statement_end,
            clc$proc_declaration, clc$control_statement_switch, clc$control_statement_no_switch,
            clc$var_or_type_statement =

            IF parameter_level = 0 THEN
              IF (clv$command_header.command_type <> clc$case_selection) AND (token.clt_kind = clc$lex_assign)
                    AND (previous_token.clt_kind <> clc$lex_space) THEN
                insert_space_token;
                insert_spaces_for_assignment := TRUE;
              IFEND;
              copy_format_token;
              input_index := input_index + 1;
              token := temp_format_array^ [input_index];
              IF token.clt_kind = clc$lex_space THEN
                copy_format_token;
                input_index := input_index + 1;
                token := temp_format_array^ [input_index];
              ELSEIF insert_spaces_for_assignment THEN
                insert_space_token;
              IFEND;
            ELSE {parameter_level <> 0}
              IF previous_token.clt_kind = clc$lex_space THEN
                delete_last_space_token;
              IFEND;
              copy_format_token;
              input_index := input_index + 1;
              token := temp_format_array^ [input_index];
              IF token.clt_kind = clc$lex_space THEN
                input_index := input_index + 1;
                token := temp_format_array^ [input_index];
              IFEND;
            IFEND; {if parameter_level = 0}

          ELSE {CASE clv$command_header.command_type}
            IF previous_token.clt_kind = clc$lex_space THEN

{ Don't delete last space token if a parameter begins with a node.

              IF NOT ((output_index >= 2) AND (array_ptr^ [output_index].format_type = clc$tree_begin) AND
                    (array_ptr^ [output_index - 1].format_type = clc$parameter_begin)) THEN
                delete_last_space_token;
              IFEND;
            IFEND;
            copy_format_token;
            input_index := input_index + 1;
            token := temp_format_array^ [input_index];
          CASEND;
        ELSEIF token.clt_kind = clc$lex_comma THEN
          IF previous_token.clt_kind = clc$lex_space THEN
            delete_last_space_token;
          IFEND;
          copy_format_token;
          input_index := input_index + 1;
          token := temp_format_array^ [input_index];
          IF token.clt_kind <> clc$lex_space THEN
            insert_space_token;
          IFEND;
        ELSEIF token.clt_kind = clc$lex_left_parenthesis THEN
          copy_format_token;
          input_index := input_index + 1;
          IF temp_format_array^ [input_index].clt_kind = clc$lex_space THEN
            input_index := input_index + 1;
          IFEND;
          token := temp_format_array^ [input_index];
        ELSEIF (token.clt_kind = clc$lex_right_parenthesis) OR (token.clt_kind = clc$lex_space) THEN
          IF previous_token.clt_kind = clc$lex_space THEN
            delete_last_space_token;
          IFEND;
          copy_format_token;
          input_index := input_index + 1;
          token := temp_format_array^ [input_index];
        ELSE
          CASE token.format_type OF
          = clc$parameter_begin =
            parameter_level := parameter_level + 1;
          = clc$parameter_end =
            parameter_level := parameter_level - 1;
          ELSE
          CASEND;
          copy_format_token;
          input_index := input_index + 1;
          token := temp_format_array^ [input_index];
        IFEND;
      WHILEND /rebuild/;

      array_ptr^ [output_index + 1].clt_kind := clc$lex_end_of_line;
      array_ptr^ [output_index + 1].token_size := 0;

    PROCEND rebuild_array;
?? OLDTITLE ??
?? NEWTITLE := 'process_label', EJECT ??

    PROCEDURE process_label
      (VAR indent: clt$command_line_index;
       VAR current_token: clt$format_token;
       VAR format_index: clt$token_array_index;
       VAR current_output_pointer: ^output_line_record;
       VAR status: ost$status);

      VAR
        current_string: string (osc$max_name_size + 2),
        name_size: 0 .. osc$max_name_size,
        output_size: 0 .. osc$max_name_size + 2;

      IF current_token.clt_kind <> clc$lex_name THEN
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, ' Cant find label ', status);
        RETURN;
      IFEND;
      temp_name := current_token.string_ptr^;
      name_size := clp$trimmed_string_size (temp_name);
      #TRANSLATE (osv$upper_to_lower, temp_name (1, name_size), current_string);
      IF clv$current_indent_column > clc$indent_increment THEN
        current_output_pointer^.indent_column := clv$current_indent_column - clc$indent_increment;
      ELSE
        current_output_pointer^.indent_column := clv$current_indent_column;
      IFEND;
      current_string (name_size + 1) := ':';
      output_size := name_size + 1;
      format_index := format_index + 2;
      IF clv$current_array_ptr^ [format_index].clt_kind = clc$lex_space THEN
        output_size := output_size + 1;
        format_index := format_index + 1;
      IFEND;
      put_string (^current_string (1, output_size), TRUE, 2, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      generate_continuation (TRUE, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      current_output_pointer^.indent_column := clv$current_indent_column;

    PROCEND process_label;
?? OLDTITLE ??
?? NEWTITLE := 'put_it_if_you_can', EJECT ??

    PROCEDURE put_it_if_you_can
      (    str_size: clt$command_line_size;
           begin_index: clt$token_array_index;
           end_index: clt$token_array_index;
           reserve_size: 0 .. 2;
           continuation_okay: boolean;
           array_ptr: ^clt$format_token_array;
       VAR did: boolean;
       VAR status: ost$status);

      did := FALSE;
      IF fits_on_current_line (str_size, reserve_size) THEN
        IF NOT ((str_size = 1) AND (array_ptr^ [begin_index].string_ptr^ = '.')) OR
              fits_on_current_line (array_ptr^ [begin_index + 1].token_size + 1, reserve_size) THEN
          put_string_from_array (str_size, begin_index, end_index, array_ptr, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          did := TRUE;
        IFEND;
      ELSEIF fits_on_next_line (str_size, clv$current_indent_column + clc$continuation_increment,
            reserve_size) THEN
        IF continuation_okay THEN
          IF (array_ptr^ [begin_index].clt_kind = clc$lex_left_parenthesis) AND (begin_index > 2) AND
                (array_ptr^ [begin_index - 2].format_type = clc$function_begin) THEN
            generate_continuation (FALSE, status);
          ELSE
            generate_continuation (TRUE, status);
          IFEND;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          put_string_from_array (str_size, begin_index, end_index, array_ptr, status);
          did := TRUE;
        IFEND;
      IFEND;

    PROCEND put_it_if_you_can;
?? OLDTITLE ??
?? NEWTITLE := 'put_string', EJECT ??

    PROCEDURE put_string
      (    str_ptr: ^clt$command_line;
           ignore_length_restrictions: boolean;
           reserve_size: 0 .. 2;
       VAR status: ost$status);

{ This procedure outputs the specified string. If IGNORE_LENGTH_RESTRICTIONS
{  is true, the string will be added to the current line without checking
{  the resulting line size. Otherwise, if the string will overflow the
{  line, it will be broken, ellipses added, and the remainder placed on the
{  following line.

      VAR
        indent: clt$command_line_index,
        string_size: clt$command_line_size,
        string_index: clt$command_line_index,
        temp_size: clt$command_line_size;

      string_size := STRLENGTH (str_ptr^);
      string_index := 1;

      WHILE string_size > 0 DO
        indent := clv$current_indent_column + clv$continuation_indent_bias;
        IF fits_on_current_line (string_size, reserve_size) OR ignore_length_restrictions THEN
          current_output_pointer^.output_line_ptr^ (current_output_pointer^.output_line_size + 1,
                string_size) := str_ptr^ (string_index, string_size);
          current_output_pointer^.output_line_size := current_output_pointer^.output_line_size + string_size;
          RETURN;
        IFEND;

        temp_size := clv$page_width - current_output_pointer^.output_line_size - indent;
        IF temp_size > continuation_indicator_size THEN
          temp_size := temp_size - continuation_indicator_size;
          WHILE (temp_size > 0) AND (str_ptr^ (string_index + temp_size - 1) = '.') DO
            temp_size := temp_size - 1;
          WHILEND;
          IF (temp_size = 0) AND (current_output_pointer^.indent_column = 1) THEN
            osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Too many periods.', status);
            RETURN;
          IFEND;
          current_output_pointer^.output_line_ptr^ (current_output_pointer^.output_line_size + 1,
                temp_size) := str_ptr^ (string_index, temp_size);
          current_output_pointer^.output_line_size := current_output_pointer^.output_line_size + temp_size;
          string_size := string_size - temp_size;
          string_index := string_index + temp_size;
        IFEND;
        IF string_size > 0 THEN
          generate_continuation (FALSE, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      WHILEND;

    PROCEND put_string;
?? OLDTITLE ??
?? NEWTITLE := 'generate_continuation', EJECT ??

    PROCEDURE generate_continuation
      (    indent_next: boolean;
       VAR status: ost$status);

      VAR
        indent: clt$command_line_index,
        inhibit_indent: boolean,
        next_output_pointer: ^output_line_record;

{ Inhibit indentation of the continuation line if string concatination is the last operator
{ in the current line.
      inhibit_indent := (current_output_pointer^.output_line_ptr^
            (current_output_pointer^.output_line_size - 1, 2) = '//') OR
            (clv$command_header.command_type = clc$var_or_type_statement);

      current_output_pointer^.output_line_ptr^ (current_output_pointer^.output_line_size + 1,
            continuation_indicator_size) := '..';
      current_output_pointer^.output_line_size := current_output_pointer^.output_line_size +
            continuation_indicator_size;

      ALLOCATE next_output_pointer;
      IF next_output_pointer <> NIL THEN
        ALLOCATE next_output_pointer^.output_line_ptr: [clv$page_width + 5 {|} ];
      IFEND;
      IF next_output_pointer^.output_line_ptr = NIL THEN
        osp$set_status_abnormal ('CL', cle$table_overflow, 'next_output_pointer', status);
        RETURN;
      IFEND;

      IF indent_next AND NOT inhibit_indent THEN
        indent := clv$current_indent_column + clc$continuation_increment;
      ELSE
        indent := 1;
      IFEND;

      current_output_pointer^.next_output_pointer := next_output_pointer;
      next_output_pointer^.next_output_pointer := NIL;
      next_output_pointer^.indent_column := indent;
      next_output_pointer^.output_line_size := 0;
      next_output_pointer^.output_line_ptr^ := '';
      current_output_pointer := next_output_pointer;
      clv$continuation_indent_bias := clc$continuation_increment;

    PROCEND generate_continuation;
?? OLDTITLE ??
?? NEWTITLE := 'put_packet', EJECT ??

    PROCEDURE put_packet
      (    packet_size: clt$command_line_size;
           begin_index: clt$token_array_index;
           end_index: clt$token_array_index;
           max_array_index: clt$token_array_index;
           indent_on_continuation: boolean;
           array_ptr: ^clt$format_token_array;
       VAR status: ost$status);

      VAR
        current_token: clt$format_token,
        did: boolean,
        index: clt$token_array_index,
        index_to_set: clt$token_array_index,
        reserve_size: 0 .. continuation_indicator_size;

      IF end_index >= clv$last_non_zero_size_index THEN
        reserve_size := 0;
      ELSE
        reserve_size := continuation_indicator_size;
      IFEND;

      IF fits_on_current_line (packet_size, reserve_size) THEN
        put_string_from_array (packet_size, begin_index, end_index, array_ptr, status);
        RETURN;
      IFEND;

      index := begin_index;

    /process/
      WHILE index <= end_index DO
        current_token := array_ptr^ [index];
        CASE current_token.format_type OF
        = clc$tree_begin =
          put_tree (index, max_array_index, indent_on_continuation, array_ptr, index_to_set, status);
        = clc$parameter_begin =
          put_parameter (index, max_array_index, array_ptr, index_to_set, status);
        = clc$file_or_var_begin =
          put_file_or_variable (index, max_array_index, array_ptr, { indent_on_continuation } FALSE,
                index_to_set, status);
        ELSE
          IF index >= clv$last_non_zero_size_index THEN
            reserve_size := 0;
          ELSE
            reserve_size := continuation_indicator_size;
          IFEND;
          IF current_token.token_size > 0 THEN
            put_it_if_you_can (current_token.token_size, index, index, reserve_size, indent_on_continuation,
                  array_ptr, did, status);
            IF status.normal AND (NOT did) THEN
              generate_continuation (indent_on_continuation, status);
              IF status.normal THEN
                put_string (current_token.string_ptr, FALSE, reserve_size, status);
              IFEND;
            IFEND;
          IFEND;
          index_to_set := index;
        CASEND;
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        index := index_to_set + 1;
      WHILEND /process/;

    PROCEND put_packet;
?? TITLE := 'put_tree', EJECT ??

    PROCEDURE put_tree
      (    begin_index: clt$token_array_index;
           max_array_index: clt$token_array_index;
           indent_on_continuation: boolean;
           array_ptr: ^clt$format_token_array;
       VAR end_index: clt$token_array_index;
       VAR status: ost$status);

      VAR
        current_token: clt$format_token,
        index: clt$token_array_index,
        local_indent_control: boolean,
        nesting_level: clt$command_line_size,
        node_index: clt$command_line_index,
        node_value: clt$f_node_value,
        nodes_encountered: clt$command_line_size,
        reserve_size: 0 .. continuation_indicator_size,
        size_after_node: clt$command_line_size,
        size_with_node: clt$command_line_size;

      IF array_ptr^ [begin_index].format_type <> clc$tree_begin THEN
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find tree_begin.', status);
        end_index := max_array_index;
        RETURN;
      IFEND;

      nesting_level := 0;
      node_index := 1;
      node_value := array_ptr^ [begin_index].node_value;
      nodes_encountered := 0;
      size_with_node := 0;
      size_after_node := 0;
      end_index := begin_index + 1;

    /isolate_tree/
      WHILE end_index <= max_array_index DO
        current_token := array_ptr^ [end_index];
        nesting_level := nesting_level + $INTEGER (current_token.clt_kind =
              clc$lex_left_parenthesis) - $INTEGER (current_token.clt_kind = clc$lex_right_parenthesis);
        CASE current_token.format_type OF
        = clc$node =
          IF (current_token.node_value = node_value) AND (nesting_level = 0) THEN
            IF array_ptr^ [end_index + 1].clt_kind IN $clt$lexical_unit_kinds
                  [clc$lex_space, clc$lex_comment, clc$lex_unterminated_comment] THEN
              node_index := end_index + 1;
              size_with_node := size_with_node + current_token.token_size + 1 + size_after_node;
              local_indent_control := TRUE;
              end_index := end_index + 1;
            ELSE
              node_index := end_index;
              size_with_node := size_with_node + current_token.token_size + size_after_node;
              local_indent_control := FALSE;
            IFEND;
            size_after_node := 0;
            nodes_encountered := nodes_encountered + 1;
          ELSEIF nodes_encountered = 0 THEN
            size_with_node := size_with_node + current_token.token_size;
          ELSE
            size_after_node := size_after_node + current_token.token_size;
          IFEND;
        = clc$tree_end =
          IF (current_token.node_value = node_value) AND (nesting_level = 0) THEN
            IF nodes_encountered = 0 THEN
              node_index := end_index;
            IFEND;
            EXIT /isolate_tree/;
          IFEND;
        ELSE
          IF current_token.clt_kind = clc$lex_end_of_line THEN
            osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find tree_end.', status);
            RETURN;
          ELSEIF current_token.token_size > 0 THEN
            IF nodes_encountered = 0 THEN
              node_index := end_index;
              size_with_node := size_with_node + current_token.token_size;
            ELSE
              size_after_node := size_after_node + current_token.token_size;
            IFEND;
          IFEND;
        CASEND;
        end_index := end_index + 1;
      WHILEND /isolate_tree/;

      local_indent_control := local_indent_control AND indent_on_continuation;

      IF end_index >= clv$last_non_zero_size_index THEN
        reserve_size := 0;
      ELSE
        reserve_size := continuation_indicator_size;
      IFEND;

      IF fits_on_current_line (size_with_node + size_after_node, reserve_size) THEN
        put_string_from_array (size_with_node + size_after_node, begin_index, end_index, array_ptr, status);
        RETURN;
      IFEND;

      IF fits_on_current_line (size_with_node, continuation_indicator_size) THEN
        put_string_from_array (size_with_node, begin_index, node_index, array_ptr, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        generate_continuation (local_indent_control, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        current_token := array_ptr^ [node_index + 1];
        IF local_indent_control AND (current_token.clt_kind = clc$lex_space) THEN
          node_index := node_index + 1;
          size_after_node := size_after_node - current_token.token_size;
        IFEND;
      ELSE
        put_packet (size_with_node, begin_index + 1, node_index, max_array_index, local_indent_control,
              array_ptr, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      IF fits_on_current_line (size_after_node, reserve_size) THEN
        put_string_from_array (size_after_node, node_index + 1, end_index, array_ptr, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        put_packet (size_after_node, node_index + 1, end_index, max_array_index, local_indent_control,
              array_ptr, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    PROCEND put_tree;
?? TITLE := 'put_string_from_array', EJECT ??

    PROCEDURE put_string_from_array
      (    string_size: clt$command_line_size;
           begin_index: clt$token_array_index;
           end_index: clt$token_array_index;
           array_ptr: ^clt$format_token_array;
       VAR status: ost$status);

      VAR
        current_string_size: clt$command_line_size,
        index: clt$token_array_index,
        string_ptr: ^string ( * ),
        token_size: clt$string_size;

{ This procedure assembles a string from the specified tokens in the array
{ and writes the string to the output line. It is assumed that string will
{ fit on the current line.

      PUSH string_ptr: [string_size];
      current_string_size := 0;

      FOR index := begin_index TO end_index DO
        token_size := array_ptr^ [index].token_size;
        IF token_size > 0 THEN
          string_ptr^ (current_string_size + 1, token_size) := array_ptr^ [index].string_ptr^;
          current_string_size := current_string_size + token_size;
        IFEND;
      FOREND;

      put_string (string_ptr, TRUE, 0, status);

    PROCEND put_string_from_array;
?? TITLE := 'put_parameter', EJECT ??

    PROCEDURE put_parameter
      (    begin_index: clt$token_array_index;
           max_array_index: clt$token_array_index;
           array_ptr: ^clt$format_token_array;
       VAR end_index: clt$token_array_index;
       VAR status: ost$status);

      VAR
        did: boolean,
        comment_index: clt$token_array_index,
        comment_size: clt$command_line_size,
        continuation_size: 0 .. continuation_indicator_size,
        index: clt$token_array_index,
        nested_value_set_count: clt$list_size,
        packet: ^clt$command_line,
        packet_size: clt$command_line_size,
        parameter_line_begin: clt$command_line_index,
        parameter_size: clt$command_line_size,
        parameter_begin: clt$token_array_index,
        parameter_end: clt$token_array_index,
        parameter_name: ost$name,
        parameter_name_size: 0 .. osc$max_name_size,
        postlude_line_begin: clt$command_line_index,
        postlude_size: clt$command_line_size,
        postlude_begin: clt$token_array_index,
        postlude_end: clt$token_array_index,
        prelude_line_begin: clt$command_line_index,
        prelude_size: clt$command_line_size,
        prelude_begin: clt$token_array_index,
        prelude_end: clt$token_array_index,
        save_index: clt$token_array_index,
        token: clt$format_token,
        total_size: clt$command_line_size,
        value_line_begin: clt$command_line_index,
        value_set_count: clt$list_size;


      index := begin_index;
      continuation_size := continuation_indicator_size;

    /format_loop/
      BEGIN
        token := array_ptr^ [index];
        IF token.clt_kind = clc$lex_end_of_line THEN
          EXIT /format_loop/;
        IFEND;
        IF token.format_type <> clc$parameter_begin THEN
          osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find parameter_begin.', status);
          RETURN;
        IFEND;

        isolate_parameter (index, max_array_index, array_ptr, FALSE, comment_index, comment_size,
              parameter_name, parameter_name_size, prelude_size, prelude_begin, prelude_end, parameter_size,
              parameter_begin, parameter_end, postlude_size, postlude_begin, postlude_end, value_set_count,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        end_index := postlude_end;

        IF array_ptr^ [postlude_end + 1].clt_kind = clc$lex_end_of_line THEN
          continuation_size := 0;
        IFEND;

        IF prelude_size = 0 THEN
          prelude_line_begin := parameter_line_begin;
        IFEND;

        total_size := prelude_size + parameter_size + postlude_size + comment_size;

        IF fits_on_current_line (total_size, continuation_size) THEN
          put_string_from_array (total_size, prelude_begin, postlude_end, array_ptr, status);
          RETURN;
        ELSEIF value_set_count = 0 THEN
          IF fits_on_next_line (total_size, clv$current_indent_column + clc$continuation_increment,
                continuation_size) THEN
            generate_continuation (TRUE, status);
            IF status.normal THEN
              put_string_from_array (total_size, prelude_begin, postlude_end, array_ptr, status);
            IFEND;
          ELSE
            put_packet (total_size, prelude_begin, postlude_end, max_array_index, FALSE, array_ptr, status);
          IFEND;
          RETURN;
        IFEND;

        IF prelude_size > 0 THEN
          put_packet (prelude_size, prelude_begin, prelude_end, max_array_index, TRUE, array_ptr, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        index := parameter_begin;
        token := array_ptr^ [index];
        IF token.format_type <> clc$value_set_begin THEN
          put_packet (parameter_size, index, parameter_end, max_array_index, TRUE, array_ptr, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          IF postlude_size > 0 THEN
            put_packet (postlude_size, postlude_begin, postlude_end, max_array_index, TRUE, array_ptr,
                  status);
          IFEND;
          RETURN;
        IFEND;

      /format_value_sets/
        WHILE value_set_count > 0 DO
          token := array_ptr^ [index];
          packet_size := 0;
          index := index + 1;
          save_index := index;
          token := array_ptr^ [index];
          nested_value_set_count := 1;

          WHILE token.format_type <> clc$value_set_end DO
            IF token.format_type = clc$value_set_begin THEN
              nested_value_set_count := nested_value_set_count + 1;
            IFEND;
            IF token.token_size > 0 THEN
              packet_size := packet_size + token.token_size;
            IFEND;
            index := index + 1;
            token := array_ptr^ [index];
            IF token.format_type = clc$value_set_end THEN
              nested_value_set_count := nested_value_set_count - 1;
              IF nested_value_set_count <> 0 THEN
                index := index + 1;
                token := array_ptr^ [index];
                value_set_count := value_set_count - 1;
              IFEND;
            IFEND;
          WHILEND;

          index := index + 1;
          token := array_ptr^ [index];

          WHILE (token.clt_kind = clc$lex_comma) OR (token.clt_kind = clc$lex_space) DO
            packet_size := packet_size + token.token_size;
            index := index + 1;
            token := array_ptr^ [index];
          WHILEND;

          put_packet (packet_size, save_index, index - 1, max_array_index, TRUE, array_ptr, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          value_set_count := value_set_count - 1;

        WHILEND /format_value_sets/;

        IF postlude_size > 0 THEN
          put_packet (postlude_size, postlude_begin, postlude_end, max_array_index, TRUE, array_ptr, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

      END /format_loop/;

    PROCEND put_parameter;
?? TITLE := 'put_file_or_variable', EJECT ??

    PROCEDURE put_file_or_variable
      (    begin_index: clt$token_array_index;
           max_array_index: clt$token_array_index;
           array_ptr: ^clt$format_token_array;
           indent_on_continuation: boolean;
       VAR end_index: clt$token_array_index;
       VAR status: ost$status);

      VAR
        current_token: clt$format_token,
        did: boolean,
        index: clt$token_array_index,
        current_begin_index: clt$token_array_index,
        current_end_index: clt$token_array_index,
        processing_file: boolean,
        string_size: clt$command_line_size;

      string_size := 0;

    /isolate/
      FOR end_index := begin_index + 1 TO max_array_index DO
        current_token := array_ptr^ [end_index];
        IF current_token.format_type = clc$file_or_var_end THEN
          EXIT /isolate/;
        IFEND;

        IF current_token.token_size > 0 THEN
          string_size := string_size + current_token.token_size
        IFEND;

        IF current_token.clt_kind = clc$lex_end_of_line THEN
          osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find file_or_var_end.', status);
          RETURN;
        IFEND;
      FOREND /isolate/;

      IF fits_on_current_line (string_size, continuation_indicator_size) THEN
        put_string_from_array (string_size, begin_index, end_index, array_ptr, status);
        RETURN;
      ELSE
        put_it_if_you_can (string_size, begin_index, end_index, continuation_indicator_size,
              indent_on_continuation, array_ptr,
              did, status);
        IF did OR (NOT status.normal) THEN
          RETURN;
        IFEND;
      IFEND;

      string_size := 0;
      current_begin_index := begin_index + 1;

{ NOTE: The following ensures that a dot is not placed at (or   near) the
{ end of a line where it may later be absorbed into a
{ continuation ellipses.

    /put_it/
      FOR index := begin_index + 1 TO end_index - 1 DO
        current_token := array_ptr^ [index];
        IF current_token.clt_kind = clc$lex_dot THEN
          IF string_size > 0 THEN
            IF NOT fits_on_current_line (string_size, continuation_indicator_size) THEN
              generate_continuation (FALSE, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
            put_string_from_array (string_size, current_begin_index, index - 1, array_ptr, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
          string_size := current_token.token_size;
          current_begin_index := index;
        ELSE
          IF current_token.token_size > 0 THEN
            string_size := string_size + current_token.token_size;
            IF NOT fits_on_current_line (string_size, continuation_indicator_size) THEN
              generate_continuation (FALSE, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
            put_string_from_array (string_size, current_begin_index, index, array_ptr, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            current_begin_index := index + 1;
            string_size := 0;
          IFEND;
        IFEND;
      FOREND /put_it/;

{ NOTE: At this time the only item not written to the output line must
{ be a dot. Although (currently) this is an error which should  have
{ been detected by the formatter's lexical scanner, the dot will be
{ written to the beginning of the next continuation line.

      IF string_size > 0 THEN
        generate_continuation (FALSE, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        put_string_from_array (string_size, current_begin_index, index, array_ptr, status);
      IFEND;

    PROCEND put_file_or_variable;
?? OLDTITLE ??
?? EJECT ??

    clv$continuation_indent_bias := 0;
    escape_encountered := FALSE;
    status.normal := TRUE;
    IF (clv$command_header.command_line_size = 0) THEN
      put_line ('', status);
      RETURN;
    IFEND;

    max_array_index := clv$format_token_array_index;
    format_index := 1;
    clv$current_array_ptr^ [max_array_index + 1].clt_kind := clc$lex_end_of_line;
    IF clv$processing_crev AND (clv$command_header.command_type <> clc$to_be_translated_command) THEN

{ Wind up translation

      translate_create_variable (format_index, max_array_index, clv$current_array_ptr,
            clv$current_indent_column, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    CASE clv$command_header.command_type OF
    = clc$control_statement_end, clc$control_statement_switch, clc$utility_end, clc$procend_command =
      IF clv$current_indent_column > clc$indent_increment THEN
        clv$current_indent_column := clv$current_indent_column - clc$indent_increment;
      IFEND;
    = clc$end_colt_command =
      clv$collecting_text := FALSE;
      clv$current_indent_column := clv$save_indent_column;
      put_line (clv$colt_until_value (1, clp$trimmed_string_size (clv$colt_until_value)), status);
      RETURN;
    = clc$to_be_translated_command =

{ Wait until leading comments, etc are processed and to check if translating

    ELSE
      ;
    CASEND;
    IF NOT (clv$translate AND (clv$command_header.command_type = clc$to_be_translated_command)) THEN
      process_leading_comments (clv$current_array_ptr, max_array_index, clv$current_indent_column,
            format_index, status);
      IF (NOT status.normal) OR (clv$current_array_ptr^ [format_index].clt_kind = clc$lex_end_of_line) THEN
        IF clv$command_header.command_type = clc$utility_begin THEN
          clv$current_indent_column := clv$current_indent_column + clc$indent_increment;
        IFEND;
        RETURN;
      IFEND;
    IFEND;

    PUSH first_output_pointer;
    PUSH first_output_pointer^.output_line_ptr: [clv$page_width];
    IF first_output_pointer^.output_line_ptr = NIL THEN
      osp$set_status_abnormal ('CL', cle$table_overflow, 'first output pointer', status);
      RETURN;
    IFEND;

    first_output_pointer^.next_output_pointer := NIL;
    first_output_pointer^.indent_column := clv$current_indent_column;
    first_output_pointer^.output_line_size := 0;
    first_output_pointer^.output_line_ptr^ := '';
    current_output_pointer := first_output_pointer;

    current_token := clv$current_array_ptr^ [format_index];

    IF clv$command_header.labeled THEN
      process_label (clv$current_indent_column, current_token, format_index, current_output_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF current_token.clt_kind = clc$lex_divide THEN
      escape_encountered := TRUE;
      put_line ('/ ..', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      format_index := format_index + 1;
      IF clv$current_array_ptr^ [format_index].clt_kind = clc$lex_space THEN
        format_index := format_index + 1;
      IFEND;
    IFEND;

    IF clv$translate THEN
      PUSH translate_line_ptr: [clc$max_command_line_size];
      translate_line_size := 0;
    IFEND;

    rebuild_array (clv$current_array_ptr, format_index, translate_line_ptr, translate_line_size,
          clv$last_non_zero_size_index, max_array_index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    current_token := clv$current_array_ptr^ [format_index];

    CASE clv$command_header.command_type OF
    = clc$case_selection =
      IF current_output_pointer^.indent_column > clc$indent_increment THEN
        current_output_pointer^.indent_column := current_output_pointer^.indent_column -
              clc$indent_increment;
      IFEND;

    = clc$collect_text_command =
      current_output_pointer^.indent_column := 1;

    = clc$var_or_type_statement =
      IF number_of_structured_types < indent_number THEN
        indent_number := number_of_structured_types;
      IFEND;
      current_output_pointer^.indent_column := clv$current_indent_column + 2
           + 2*indent_number;
      indent_number := number_of_structured_types;

    ELSE
    CASEND;

    IF clv$translate AND (clv$command_header.command_type = clc$to_be_translated_command) THEN
      translate_create_variable (format_index, max_array_index, clv$current_array_ptr,
            clv$current_indent_column, status);
      RETURN;
    IFEND;

    IF current_token.clt_kind <> clc$lex_end_of_line THEN
      packet_size := 0;

    /set_size/
      FOR temp_index := format_index TO max_array_index DO
        current_token := clv$current_array_ptr^ [temp_index];
        IF current_token.token_size > 0 THEN
          packet_size := packet_size + clv$current_array_ptr^ [temp_index].token_size;
        IFEND;
      FOREND /set_size/;

      put_packet (packet_size, format_index, max_array_index, max_array_index, TRUE, clv$current_array_ptr,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF (clv$command_header.command_type = clc$procend_command) AND (NOT clv$last_command_blank) THEN
      put_line ('', status);
    IFEND;
    current_output_pointer := first_output_pointer;
    IF escape_encountered THEN
      line_size := 2;
    ELSE
      line_size := 0;
    IFEND;
    indent_size := 0;
    continuation_indent_size := 0;
    continuation_lines_with_indent := 0;

    WHILE current_output_pointer <> NIL DO
      indent_size := indent_size + current_output_pointer^.indent_column - 1;
      IF current_output_pointer^.indent_column = (clv$current_indent_column + clc$continuation_increment) THEN
        continuation_lines_with_indent := continuation_lines_with_indent + 1;
        continuation_indent_size := continuation_indent_size + current_output_pointer^.indent_column - 1;
      IFEND;
      line_size := line_size + current_output_pointer^.output_line_size +
            current_output_pointer^.indent_column - 1;
      current_output_pointer := current_output_pointer^.next_output_pointer;
      IF current_output_pointer <> NIL THEN {subtract for ellipses}
        line_size := line_size - continuation_indicator_size;
      IFEND;
    WHILEND;

    IF line_size > clc$max_command_line_size THEN
      IF (line_size - (continuation_lines_with_indent * (clc$continuation_increment - 1))) <=
            clc$max_command_line_size THEN
        current_output_pointer := first_output_pointer^.next_output_pointer;
        WHILE current_output_pointer <> NIL DO
          current_output_pointer^.indent_column := clv$current_indent_column + 1;
          current_output_pointer := current_output_pointer^.next_output_pointer;
        WHILEND;
      ELSEIF (line_size - indent_size + continuation_lines_with_indent) <= clc$max_command_line_size THEN
        current_output_pointer := first_output_pointer;
        current_output_pointer^.indent_column := 1;
        current_output_pointer := current_output_pointer^.next_output_pointer;
        WHILE current_output_pointer <> NIL DO
          IF current_output_pointer^.indent_column > 1 THEN

{Ensure that space exists at beginning of continuation

            current_output_pointer^.indent_column := 2;
          IFEND;
          current_output_pointer := current_output_pointer^.next_output_pointer;
        WHILEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, ' Line too long', status);
        RETURN;
      IFEND;
    IFEND;

    current_output_pointer := first_output_pointer;
    PUSH line_to_print: [clv$page_width + 5];

    WHILE current_output_pointer <> NIL DO
      IF current_output_pointer^.output_line_size > 0 THEN
        line_to_print^ := '';
        line_to_print^ (current_output_pointer^.indent_column,
              current_output_pointer^.output_line_size) := current_output_pointer^.
              output_line_ptr^ (1, current_output_pointer^.output_line_size);
        put_line (line_to_print^ (1, current_output_pointer^.output_line_size +
              current_output_pointer^.indent_column - 1), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      last_output_pointer := current_output_pointer;
      current_output_pointer := current_output_pointer^.next_output_pointer;
      IF last_output_pointer <> first_output_pointer THEN
        FREE last_output_pointer^.output_line_ptr;
        FREE last_output_pointer;
      IFEND;

    WHILEND;

    CASE clv$command_header.command_type OF
    = clc$control_statement_begin, clc$control_statement_switch, clc$utility_begin =
      clv$current_indent_column := clv$current_indent_column + clc$indent_increment;
    = clc$collect_text_command =
      IF clv$process_collect_text THEN
        clv$collecting_text := TRUE;
        clv$current_indent_column := 1 + clc$indent_increment;
      IFEND;
    ELSE
    CASEND;

  PROCEND clp$format_line;
?? TITLE := 'clp$insert_format_marker', EJECT ??

  PROCEDURE [XDCL] clp$insert_format_marker
    (    format_marker_kind: clt$format_marker_kind;
         offset: 0 .. 15);

{ PURPOSE:
{   The purpose of this procedure is to insert the specified format
{   marker "offset" tokens before the current token.
{

    VAR
      i: 0 .. 16;

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

{ move end_of-line indicator

    clv$current_array_ptr^ [clv$format_token_array_index + 2] :=
          clv$current_array_ptr^ [clv$format_token_array_index + 1];

    FOR i := 0 TO offset - 1 DO
      clv$current_array_ptr^ [clv$format_token_array_index - i + 1] :=
            clv$current_array_ptr^ [clv$format_token_array_index - i];
    FOREND;

    clv$current_array_ptr^ [clv$format_token_array_index - offset + 1].clt_kind := clc$lex_unknown;
    clv$current_array_ptr^ [clv$format_token_array_index - offset + 1].token_size := 0;
    clv$current_array_ptr^ [clv$format_token_array_index - offset + 1].format_type := format_marker_kind;

    clv$format_token_array_index := clv$format_token_array_index + 1;

  PROCEND clp$insert_format_marker;
?? TITLE := 'clp$get_statement_to_format', EJECT ??

  PROCEDURE [XDCL] clp$get_statement_to_format
    (VAR line_ptr: ^clt$command_line;
     VAR got_line: boolean;
     VAR status: ost$status);

    VAR
      command_header_pointer: ^clt$command_header,
      input_line_ptr: ^clt$command_line,
      last_input_line_pointer: ^clt$command_line,
      command_too_long: boolean,
      found_char: boolean,
      input_seq_ptr: ^SEQ ( * ),
      line_continued: boolean,
      line_size: clt$command_line_size,
      scan_index: integer,
      start_index: clt$command_line_index,
      continuation_line_ptr: ^clt$command_line,
      continuation_line_size: clt$command_line_size;

    VAR
      input_line_size: [STATIC] clt$command_line_size := 0;

    initialize_command_header (command_header_pointer);
    line_size := 0;
    command_too_long := FALSE;

  /read_block/
    BEGIN
      IF clv$input_line_index > clv$input_line_size THEN
        clv$input_line_index := 1;
        get_data_line (clv$input_line_ptr, line_size, got_line, status);
        IF NOT (status.normal AND got_line) THEN
          RETURN;
        IFEND;

        line_ptr := ^clv$input_line_ptr^ (1, line_size);
        clv$input_line_size := line_size;

        IF line_size > 2 THEN
          #SCAN (clv$non_space, line_ptr^, scan_index, found_char);
          IF found_char AND (scan_index + 1 < line_size) THEN
            IF line_ptr^ (scan_index, 2) = '"$' THEN
              process_pragmat (line_ptr^ (scan_index, line_size - scan_index + 1), status);
              IF NOT status.normal THEN
                EXIT /read_block/;
              IFEND;
            IFEND;
          IFEND;
        IFEND;

        WHILE NOT clv$formatting_in_effect DO
          put_line (line_ptr^, status);
          clv$command_header.command_type := clc$unknown_command;
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          get_data_line (clv$input_line_ptr, line_size, got_line, status);
          IF NOT (status.normal AND got_line) THEN
            RETURN;
          IFEND;

          line_ptr := ^clv$input_line_ptr^ (1, line_size);
          clv$input_line_size := line_size;
          command_header_pointer^.command_line_ptr := line_ptr;
          IF line_size > 2 THEN
            #SCAN (clv$non_space, line_ptr^, scan_index, found_char);
            IF found_char AND (scan_index + 1 < line_size) THEN
              IF line_ptr^ (scan_index, 2) = '"$' THEN
                process_pragmat (line_ptr^ (scan_index, line_size - scan_index + 1), status);
                IF NOT status.normal THEN
                  EXIT /read_block/;
                IFEND;
                IF clv$formatting_in_effect THEN
                  clv$last_command_type := clc$empty_command;
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        WHILEND;

        IF (line_size >= 2) AND (line_ptr^ (line_size - 1, 2) = '..') THEN
          line_size := line_size - 2;
          WHILE (line_size > 0) AND (line_ptr^ (line_size) = '.') DO
            line_size := line_size - 1;
          WHILEND;

          clv$input_line_size := line_size;
          PUSH continuation_line_ptr: [clc$max_command_line_size];
          IF continuation_line_ptr = NIL THEN
            osp$set_status_abnormal ('CL', cle$table_overflow, 'continuation_line_ptr', status);
            RETURN;
          IFEND;

          REPEAT
            get_data_line (continuation_line_ptr, continuation_line_size, got_line, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF NOT got_line THEN
              osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '', status);
              RETURN;
            IFEND;

            line_continued := (continuation_line_size >= 2) AND
                  (continuation_line_ptr^ (continuation_line_size - 1, 2) = '..');
            IF line_continued THEN
              continuation_line_size := continuation_line_size - 2;
              WHILE (continuation_line_size > 0) AND (continuation_line_ptr^ (continuation_line_size) =
                    '.') DO
                continuation_line_size := continuation_line_size - 1;
              WHILEND;
            IFEND;
            IF (clv$input_line_size + continuation_line_size) > clc$max_command_line_size THEN
              command_too_long := TRUE;
            IFEND;
            IF NOT command_too_long THEN
              clv$input_line_ptr^ (clv$input_line_size + 1, continuation_line_size) :=
                    continuation_line_ptr^ (1, continuation_line_size);
              clv$input_line_size := clv$input_line_size + continuation_line_size;
            IFEND;
          UNTIL NOT line_continued;
        IFEND;
      IFEND;

    END /read_block/;

    IF command_too_long THEN
      clv$current_line_size := 0;
      osp$set_status_abnormal ('CL', cle$continued_line_too_long, '', status);
      RETURN;
    IFEND;

    start_index := clv$input_line_index;
    clp$isolate_command (clv$input_line_ptr^ (1, clv$input_line_size), start_index, clv$input_line_index);

    line_size := clv$input_line_index - start_index;
    line_ptr := ^clv$input_line_ptr^ (start_index, line_size);
    IF clv$input_line_index <= clv$input_line_size THEN
      clv$input_line_index := clv$input_line_index + 1;
    IFEND;

    command_header_pointer^.command_line_ptr := line_ptr;
    command_header_pointer^.command_line_size := line_size;
    got_line := TRUE;

  PROCEND clp$get_statement_to_format;
?? TITLE := 'clp$f_note_unended_block', EJECT ??

  PROCEDURE [XDCL] clp$f_note_unended_block
    (    block_count: integer;
     VAR current_block: ^clt$f_block;
     VAR status: ost$status);

{ PURPOSE:
{   The purpose of this procedure is to write to the output
{   file information concerning blocks which have not been
{   properly terminated.

    VAR
      count: integer,
      error_line: string (150),
      error_line_index: 0 .. 151,
      j: integer,
      name_size: ost$name_size,
      name_size_2: ost$name_size,
      next_block: ^clt$f_block,
      str: string (10);

    error_line := ' ';
    count := block_count;
    WHILE count > 0 DO
      name_size := clp$trimmed_string_size (current_block^.kind_end_name);
      name_size_2 := clp$trimmed_string_size (current_block^.kind_name);
      STRINGREP (error_line, j, ' --ERROR-- No ', current_block^.kind_end_name (1, name_size),
            ' statement for ', current_block^.kind_name (1, name_size_2), ' statement at line ',
            current_block^.output_line_number);
      put_line (error_line (1, j), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      next_block := current_block^.previous_block;
      clp$f_pop_block_stack (current_block);
      count := count - 1;
      current_block := next_block;
      clv$error_count := clv$error_count + 1;
      IF clv$current_indent_column >= clc$indent_increment THEN
        clv$current_indent_column := clv$current_indent_column - clc$indent_increment;
      IFEND;
    WHILEND;

  PROCEND clp$f_note_unended_block;
?? TITLE := 'clp$f_output_line_number', EJECT ??

  FUNCTION [XDCL] clp$f_output_line_number: integer;

    clp$f_output_line_number := clv$output_line_number;

  FUNCEND clp$f_output_line_number;
?? TITLE := 'clp$f_process_collect_text', EJECT ??

  PROCEDURE [XDCL] clp$f_process_collect_text
    (    collect_command: string ( * <= 31);
     VAR status: ost$status);

{ PURPOSE:
{   This procedure handles the various commands that involve collecting text to
{   a file. It determines the termination string of the command (COLLECT_
{   TEMPLATE_UNTIL or UNTIL parameter) and then copies from the
{   input file to the output file until that string is found.  The pdt declarations
{   are given here for documentation purposes.

{ PDT collect_text_pdt (
{   output, o : FILE = $REQUIRED
{   until, u : STRING = '**'
{   prompt, p: string 0..30 = ''
{   substitution_mark, sm: string 1 or key none = none
{   input, i: file = $OPTIONAL
{   STATUS)

{ PDT create_status_message (
{   name, n : NAME = $REQUIRED
{   code, c : INTEGER 0 .. ffffffffff(16) = $REQUIRED
{   identifier, i : STRING 2
{   severity, s : key
{       (informative, i)
{       (warning, w)
{       (error, e)
{       (fatal, f)
{       (catastrophic, c)
{     keyend = error
{   collect_template_until, ctu: STRING = '**'
{   status)

{ PDT create_brief_help_message (
{   collect_template_until, ctu : STRING = '**'
{   status)

{ PDT create_full_help_message (
{   collect_template_until, ctu : STRING = '**'
{   status)

{ PDT create_parameter_prompt_message (
{   name, n : NAME = $REQUIRED
{   collect_template_until, ctu : STRING = '**'
{   status)

{ PDT create_parameter_assist_message (
{   name, n : NAME = $REQUIRED
{   collect_template_until, ctu : STRING = '**'
{   status)

{ PDT create_parameter_help_message (
{   name, n : NAME = $REQUIRED
{   collect_template_until, ctu : string = '**'
{  status)

{ PDT manage_remote_files (
{   location, l : NAME = $REQUIRED
{   file, f : file = $REQUIRED
{   data_declaration, dd  : KEY c8, c6, uu = uu
{   until, u : STRING = '**'
{   substitution_mark, sm : STRING 1 or key none = none
{   status)


    VAR
      array_index: clt$token_array_index,
      current_parameter_number: 0 .. 15,
      until_index: ost$string_index,
      found_character: boolean,
      got_line: boolean,
      line_ptr: ^clt$command_line,
      line_size: clt$command_line_size,
      local_status: ost$status,
      param_begin_count: ost$string_size,
      current_token: clt$format_token,
      parameter_name: ost$name,
      push_line_ptr: ^clt$command_line,
      requested_parameter_number: 0 .. 15,
      scan_index: integer,
      starting_indent_column: clt$command_line_index,
      substitution_mark_found: boolean,
      substitution_mark_parameter: 0 .. 15,
      temp_index: ost$string_index,
      temp_string: string (osc$max_string_size),
      until_value: string (osc$max_string_size);

    array_index := 1;
    current_parameter_number := 0;
    substitution_mark_parameter := 0;
    substitution_mark_found := FALSE;
    IF collect_command = 'COLLECT_TEXT' THEN
      requested_parameter_number := 2;
      substitution_mark_parameter := 4;
    ELSEIF collect_command = 'CREATE_STATUS_MESSAGE' THEN
      requested_parameter_number := 5;
    ELSEIF collect_command = 'CREATE_BRIEF_HELP_MESSAGE' THEN
      requested_parameter_number := 1;
    ELSEIF collect_command = 'CREATE_FULL_HELP_MESSAGE' THEN
      requested_parameter_number := 1;
    ELSEIF collect_command = 'CREATE_PARAMETER_PROMPT_MESSAGE' THEN
      requested_parameter_number := 2;
    ELSEIF collect_command = 'CREATE_PARAMETER_ASSIST_MESSAGE' THEN
      requested_parameter_number := 2;
    ELSEIF collect_command = 'CREATE_PARAMETER_HELP_MESSAGE' THEN
      requested_parameter_number := 2;
    ELSEIF collect_command = 'MANAGE_REMOTE_FILES' THEN
      requested_parameter_number := 4;
      substitution_mark_parameter := 5;
    ELSE
      osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Unknown command specified.', status);
      RETURN;
    IFEND;

    current_token := clv$current_array_ptr^ [array_index];
    until_value := '**';

  /search/
    WHILE current_token.clt_kind <> clc$lex_end_of_line DO
      IF (current_token.format_type = clc$parameter_begin) THEN
        array_index := array_index + 1;
        current_token := clv$current_array_ptr^ [array_index];
        IF current_token.format_type = clc$parameter_name THEN
          #TRANSLATE (osv$lower_to_upper, current_token.string_ptr^, parameter_name);
          IF collect_command = 'COLLECT_TEXT' THEN
            IF (parameter_name = 'OUTPUT') OR (parameter_name = 'O') THEN
              current_parameter_number := 1;
            ELSEIF (parameter_name = 'UNTIL') OR (parameter_name = 'U') THEN
              current_parameter_number := 2;
            ELSEIF (parameter_name = 'PROMPT') OR (parameter_name = 'P') THEN
              current_parameter_number := 3;
            ELSEIF (parameter_name = 'SUBSTITUTION_MARK') OR (parameter_name = 'SM') THEN
              current_parameter_number := 4;
            ELSEIF (parameter_name = 'INPUT') OR (parameter_name = 'I') THEN
              current_parameter_number := 5;
            ELSEIF (parameter_name = 'STATUS') THEN
              current_parameter_number := 6;
            ELSE
              osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
              RETURN;
            IFEND;
          ELSEIF collect_command = 'CREATE_STATUS_MESSAGE' THEN
            IF (parameter_name = 'NAME') OR (parameter_name = 'N') THEN
              current_parameter_number := 1;
            ELSEIF (parameter_name = 'CODE') OR (parameter_name = 'C') THEN
              current_parameter_number := 2;
            ELSEIF (parameter_name = 'IDENTIFIER') OR (parameter_name = 'I') THEN
              current_parameter_number := 3;
            ELSEIF (parameter_name = 'SEVERITY') OR (parameter_name = 'S') THEN
              current_parameter_number := 4;
            ELSEIF (parameter_name = 'COLLECT_TEMPLATE_UNTIL') OR (parameter_name = 'CTU') THEN
              current_parameter_number := 5;
            ELSEIF (parameter_name = 'STATUS') THEN
              current_parameter_number := 6;
            ELSE
              osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
              RETURN;
            IFEND;
          ELSEIF (collect_command = 'CREATE_BRIEF_HELP_MESSAGE') OR (collect_command =
                'CREATE_FULL_HELP_MESSAGE') THEN
            IF (parameter_name = 'COLLECT_TEMPLATE_UNTIL') OR (parameter_name = 'CTU') THEN
              current_parameter_number := 1;
            ELSEIF (parameter_name = 'STATUS') THEN
              current_parameter_number := 2;
            ELSE
              osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
              RETURN;
            IFEND;
          ELSEIF (collect_command = 'CREATE_PARAMETER_PROMPT_MESSAGE') OR (collect_command =
                'CREATE_PARAMETER_ASSIST_MESSAGE') OR (collect_command = 'CREATE_PARAMETER_HELP_MESSAGE') THEN
            IF (parameter_name = 'NAME') OR (parameter_name = 'N') THEN
              current_parameter_number := 1;
            ELSEIF (parameter_name = 'COLLECT_TEMPLATE_UNTIL') OR (parameter_name = 'CTU') THEN
              current_parameter_number := 2;
            ELSEIF (parameter_name = 'STATUS') THEN
              current_parameter_number := 3;
            ELSE
              osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
              RETURN;
            IFEND;
          ELSEIF (collect_command = 'MANAGE_REMOTE_FILES') THEN
            IF (parameter_name = 'LOCATION') OR (parameter_name = 'L') THEN
              current_parameter_number := 1;
            ELSEIF (parameter_name = 'FILE') OR (parameter_name = 'F') THEN
              current_parameter_number := 2;
            ELSEIF (parameter_name = 'DATA_DECLARATION') OR (parameter_name = 'DD') THEN
              current_parameter_number := 3;
            ELSEIF (parameter_name = 'UNTIL') OR (parameter_name = 'U') THEN
              current_parameter_number := 4;
            ELSEIF (parameter_name = 'SUBSTITUTION_MARK') OR (parameter_name = 'SM') THEN
              current_parameter_number := 5;
            ELSEIF (parameter_name = 'IGNORE_REMOTE_VALIDATION') OR (parameter_name = 'IRV') THEN
              current_parameter_number := 6;
            ELSEIF (parameter_name = 'STATUS') THEN
              current_parameter_number := 7;
            ELSE
              osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
              RETURN;
            IFEND;
          ELSE
            osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Unknown command specified.',
                  status);
            RETURN;
          IFEND;
        ELSE
          current_parameter_number := current_parameter_number + 1;
          array_index := array_index - 1;
          current_token := clv$current_array_ptr^ [array_index];
        IFEND;

        IF current_parameter_number <> requested_parameter_number THEN
          param_begin_count := 1;

        /skip_param/
          WHILE current_token.clt_kind <> clc$lex_end_of_line DO
            array_index := array_index + 1;
            current_token := clv$current_array_ptr^ [array_index];
            IF current_parameter_number = substitution_mark_parameter THEN
              IF (current_token.clt_kind = clc$lex_end_of_line) AND
                   (NOT substitution_mark_found) THEN
                osp$set_status_abnormal ('CL', cle$internal_formatter_error,
                     'Cant find parameter_end', status);
                RETURN;
              IFEND;
              IF current_token.clt_kind = clc$lex_string THEN
                clp$f_set_substitution_mark (current_token.string_ptr^ (2, 1));
                substitution_mark_found := TRUE;
              IFEND;
            IFEND;
            CASE current_token.format_type OF
            = clc$parameter_begin =
              param_begin_count := param_begin_count + 1;
            = clc$parameter_end =
              param_begin_count := param_begin_count - 1;
              IF param_begin_count <= 0 THEN
                EXIT /skip_param/;
              IFEND;
            ELSE
            CASEND;
          WHILEND /skip_param/;
        IFEND;
      ELSE
        array_index := array_index + 1;
        current_token := clv$current_array_ptr^ [array_index];
        CYCLE /search/;
      IFEND;

      IF current_parameter_number = requested_parameter_number THEN
        until_index := 1;
        WHILE current_token.format_type <> clc$parameter_end DO
          array_index := array_index + 1;
          current_token := clv$current_array_ptr^ [array_index];
          IF current_token.clt_kind = clc$lex_end_of_line THEN
            osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find parameter_end', status);
            RETURN;
          IFEND;
          IF current_token.clt_kind = clc$lex_string THEN
            temp_string := current_token.string_ptr^ (2, current_token.token_size - 2);
            temp_index := 1;

          /scan_string/
            WHILE TRUE DO
              #SCAN (clv$string_delimiter, temp_string (temp_index,
                    current_token.token_size - temp_index - 1), scan_index, found_character);
              IF NOT found_character THEN
                until_value (until_index, * ) := temp_string (temp_index, * );
                until_index := until_index + scan_index - 1;
                EXIT /scan_string/;
              IFEND;
              until_value (until_index, scan_index) := temp_string (temp_index, scan_index);
              temp_index := temp_index + scan_index + 1;

{ 1 to skip over assumed double 's

              until_index := until_index + scan_index;
            WHILEND /scan_string/;
          IFEND;
        WHILEND;

        IF until_index = 1 THEN
          osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'No string value for UNTIL parameter',
                status);
          RETURN;
        IFEND;
        IF substitution_mark_found THEN
          EXIT /search/;
        IFEND;
      ELSE
        array_index := array_index + 1;
        current_token := clv$current_array_ptr^ [array_index];
      IFEND;
    WHILEND /search/;

    clv$command_header.command_type := clc$collect_text_command;
    IF clv$process_collect_text THEN
      starting_indent_column := clv$current_indent_column;
    IFEND;
    clp$format_line (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_statement_to_format (line_ptr, got_line, status);
    IF clv$process_collect_text THEN
      WHILE status.normal AND got_line DO
        IF line_ptr^ = until_value THEN
          clv$colt_until_value := until_value;
          clv$save_indent_column := starting_indent_column;
          clv$command_header.command_type := clc$end_colt_command;
          clp$format_line (status);
          clp$f_set_substitution_mark (' ');
          RETURN;
        ELSE
          IF (clv$last_command_type = clc$proc_declaration) AND (NOT clv$last_command_blank) THEN
            put_line ('', local_status);
            clv$last_command_type := clc$empty_command;
          IFEND;
          clp$f_process_command (clc$interpret_mode, line_ptr, status);
          IF status.normal THEN
            IF (clv$command_header.command_type <> clc$proc_declaration) AND
                  (clv$command_header.command_type <> clc$end_colt_command) AND
                  (clv$command_header.command_type <> clc$var_or_type_statement) THEN
              clp$format_line (status);
            IFEND;
          IFEND;
          clv$last_command_type := clv$command_header.command_type;
        IFEND;
        IF NOT status.normal THEN
          IF (status.condition = cle$table_overflow) OR (clv$error_count >= clc$max_error_count) OR
                (clv$file_position = amc$eoi) THEN
            RETURN;
          IFEND;
          report_status (status, clv$input_line_ptr^ (1, clv$input_line_size), local_status);
          status.normal := TRUE;
        IFEND;
        clp$get_statement_to_format (line_ptr, got_line, status);
      WHILEND;
    ELSE
      clv$collecting_text := TRUE;
      clv$command_header.command_type := clc$collect_text_command;
      PUSH push_line_ptr: [clc$max_command_line_size];
      WHILE status.normal AND got_line DO
        put_line (line_ptr^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        IF line_ptr^ = until_value THEN
          clv$collecting_text := FALSE;
          clp$f_set_substitution_mark (' ');
          RETURN;
        IFEND;
        get_data_line (push_line_ptr, line_size, got_line, status);
        line_ptr := ^push_line_ptr^ (1, line_size);
      WHILEND;
    IFEND;
    osp$set_status_abnormal ('CL', cle$encountered_eoi, 'Cant find colt terminator string', status);

  PROCEND clp$f_process_collect_text;
?? TITLE := 'clp$f_process_proc_header', EJECT ??

  PROCEDURE [XDCL] clp$f_process_proc_header
    (    parameters: string ( * );
     VAR status: ost$status);

{ PURPOSE:
{   The purpose of this procedure is to provide a link between
{   CLM$F_CONTROL_STATEMENTS and the processor of a PROC header
{    declaration.

    VAR
      proc_block: ^clt$f_block,
      proc_name: ost$name;


    clp$format_proc_header (output_file_id, clv$page_width, ^clv$command_header.
          command_line_ptr^ (1, clv$command_header.command_line_size), clv$translate,
          clv$current_indent_column, proc_name, clv$error_count, status);
    IF status.normal THEN
      clp$f_push_block_stack (clc$proc_block, proc_name, proc_block);
    IFEND;
    clv$command_header.command_type := clc$proc_declaration;
    clv$last_command_blank := FALSE;
    clv$current_indent_column := clv$current_indent_column + clc$indent_increment;

  PROCEND clp$f_process_proc_header;
?? TITLE := 'clp$f_process_task_or_job', EJECT ??

  PROCEDURE [XDCL] clp$f_process_task_or_job
    (    command: string ( * <= 4);
     VAR status: ost$status);

    VAR
      array_index: clt$token_array_index,
      current_parameter_number: 0 .. 25,
      param_begin_count: ost$string_size,
      current_token: clt$format_token,
      parameter_name: ost$name,
      requested_parameter_number: 0 .. 25,
      substitution_mark_specified: boolean;

    array_index := 1;
    current_parameter_number := 0;
    IF command = 'TASK' THEN
      requested_parameter_number := 4;
    ELSEIF command = 'JOB' THEN
      requested_parameter_number := 21;
    ELSE
      osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Unknown command specified.', status);
      RETURN;
    IFEND;

    substitution_mark_specified := FALSE;
    current_token := clv$current_array_ptr^ [array_index];

{ The following search for a specified substitution mark assumes that either the
{ parameter name is explicitly specified or if specified positionally that all
{ other parameters of the command are also specified.

  /search/
    WHILE current_token.clt_kind <> clc$lex_end_of_line DO
      IF (current_token.format_type = clc$parameter_begin) THEN
        array_index := array_index + 1;
        current_token := clv$current_array_ptr^ [array_index];
        IF current_token.format_type = clc$parameter_name THEN
          #TRANSLATE (osv$lower_to_upper, current_token.string_ptr^, parameter_name);
          IF (parameter_name = 'SUBSTITUTION_MARK') OR (parameter_name = 'SM') THEN
            substitution_mark_specified := TRUE;
            EXIT /search/;
          IFEND;
        ELSE
          current_parameter_number := current_parameter_number + 1;
          array_index := array_index - 1;
          current_token := clv$current_array_ptr^ [array_index];
          IF current_parameter_number = requested_parameter_number THEN
            substitution_mark_specified := TRUE;
            EXIT /search/;
          IFEND;
        IFEND;
        param_begin_count := 1;

      /skip_param/
        WHILE current_token.clt_kind <> clc$lex_end_of_line DO
          array_index := array_index + 1;
          current_token := clv$current_array_ptr^ [array_index];
          CASE current_token.format_type OF
          = clc$parameter_begin =
            param_begin_count := param_begin_count + 1;
          = clc$parameter_end =
            param_begin_count := param_begin_count - 1;
            IF param_begin_count <= 0 THEN
              EXIT /skip_param/;
            IFEND;
          ELSE
          CASEND;
        WHILEND /skip_param/;
      IFEND;
      array_index := array_index + 1;
      current_token := clv$current_array_ptr^ [array_index];
    WHILEND;

    IF substitution_mark_specified THEN
      WHILE current_token.format_type <> clc$parameter_end DO
        array_index := array_index + 1;
        current_token := clv$current_array_ptr^ [array_index];
        IF current_token.clt_kind = clc$lex_end_of_line THEN
          osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find parameter_end', status);
          RETURN;
        IFEND;
        IF current_token.clt_kind = clc$lex_string THEN
          clp$f_set_substitution_mark (current_token.string_ptr^ (2, 1));
        IFEND;
      WHILEND;
    IFEND;

  PROCEND clp$f_process_task_or_job;
?? TITLE := 'clp$f_find_structured_types', EJECT ??

  PROCEDURE [INLINE] clp$f_find_structured_types
    (    str: string(*);
     VAR number: integer;
     VAR to_quit: boolean;
     VAR any_type_found: {input/output} boolean);

      to_quit := FALSE;
      #TRANSLATE (osv$lower_to_upper, str(1,*), str);
      IF str = 'ANY' THEN
        any_type_found := TRUE;
      ELSEIF (str = 'RECORD') OR (str = 'KEY') THEN
        number := number + 1;
      ELSEIF (str = 'RECEND') OR (str = 'ANYEND') OR (str = 'KEYEND') THEN
        number := number - 1;
        to_quit := TRUE;
      ELSEIF any_type_found AND (str <> '') THEN
        IF str = 'OF' THEN
          number := number + 1;
        ELSE
          any_type_found := FALSE;
        IFEND;
      IFEND;

  PROCEND clp$f_find_structured_types;
?? TITLE := 'clp$f_process_var_or_type', EJECT ??

  PROCEDURE [XDCL] clp$f_process_var_or_type
    (    definition: string ( * <= osc$max_name_size);
     VAR status: ost$status);

    CONST
      message_size = terminator_size + 10,
      terminator_size = 6 {VAREND or TYPEND} ;

    TYPE
      clt$f_var_or_type_definitions = array [1 .. 2] of clt$f_var_or_type_definition;

    TYPE
      clt$f_var_or_type_definition = record
        name: clt$name,
        terminator: string (terminator_size),
      recend;

    VAR
      any_type_found: boolean,
      current_indent_column: clt$command_line_index,
      current_string: string (100),
      found_char: boolean,
      got_line: boolean,
      index: clt$command_line_size,
      line_ptr: ^clt$command_line,
      line_size: clt$command_line_size,
      message: string (message_size),
      number_of_blanks: clt$command_line_size,
      parse: clt$parse_state,
      push_line_ptr: ^clt$command_line,
      scan_index: integer,
      start_index: clt$command_line_index,
      to_exit: boolean,
      var_block: ^clt$f_block,
      var_or_type_definition: clt$f_var_or_type_definition,
      var_or_type_definitions: [STATIC] clt$f_var_or_type_definitions :=
            [[[3, 'VAR'], 'VAREND'], [[4, 'TYPE'], 'TYPEND']];


    status.normal := TRUE;

    IF definition = var_or_type_definitions [1].name.value THEN
      var_or_type_definition := var_or_type_definitions [1];
    ELSE
      var_or_type_definition := var_or_type_definitions [2];
    IFEND;

    current_string := '';
    current_string (clv$current_indent_column, var_or_type_definition.name.size) :=
          var_or_type_definition.name.value (1, var_or_type_definition.name.size);
    put_line (current_string (1, clv$current_indent_column + var_or_type_definition.name.size - 1), status);

    IF clv$input_line_index < clv$input_line_size THEN
      start_index := clv$input_line_index;
      clp$isolate_command (clv$input_line_ptr^ (1, clv$input_line_size), start_index, clv$input_line_index);

      line_size := clv$input_line_index - start_index;
      push_line_ptr := ^clv$input_line_ptr^ (start_index, line_size);
      IF clv$input_line_index <= clv$input_line_size THEN
        clv$input_line_index := clv$input_line_index + 1;
      IFEND;
      got_line := TRUE;
    ELSE
      PUSH push_line_ptr: [clc$max_command_line_size];
      clp$get_statement_to_format (push_line_ptr, got_line, status);
      clv$command_header.command_type := clc$var_or_type_statement;
      line_size := clv$input_line_size;
    IFEND;

    indent_number := 0;
    number_of_structured_types := 0;
    to_exit := FALSE;
    WHILE status.normal AND got_line DO
      index := 1;
      number_of_blanks := 0;
      WHILE push_line_ptr^ (index) = ' ' DO
        number_of_blanks := number_of_blanks + 1;
        index := index + 1;
      WHILEND;
      current_indent_column := clv$current_indent_column + 2;
      PUSH line_ptr: [line_size - number_of_blanks + current_indent_column];
      line_ptr^ := '';
      line_ptr^ (current_indent_column, line_size - number_of_blanks) :=
            push_line_ptr^ (number_of_blanks + 1, * );
      #TRANSLATE (osv$lower_to_upper, push_line_ptr^ (number_of_blanks + 1, * ), push_line_ptr^);
      IF push_line_ptr^ (1, line_size - number_of_blanks) =
            var_or_type_definition.terminator (1, terminator_size) THEN
        line_ptr^ (clv$current_indent_column, * ) := var_or_type_definition.terminator (1, terminator_size);
        put_line (line_ptr^, status);
        RETURN;
      ELSE
        IF (line_size - number_of_blanks) > terminator_size THEN

{ Look for terminator + trailing comment.

          IF push_line_ptr^ (1, terminator_size) = var_or_type_definition.terminator (1, terminator_size)
                THEN
            #SCAN (clv$comment_delimiter, line_ptr^ (1, line_size - number_of_blanks), scan_index,
                  found_char);
            IF found_char THEN
              line_ptr^ (clv$current_indent_column, terminator_size) :=
                    var_or_type_definition.terminator (1, terminator_size);
              line_ptr^ (clv$current_indent_column + 2 + terminator_size, *) := line_ptr^ (scan_index,
                    *);
              line_ptr^ (clv$current_indent_column + terminator_size, 2) := '  ';
              put_line (line_ptr^, status);
              RETURN;
            IFEND;
          ELSE

{ Look for leading comment + terminator.

            IF push_line_ptr^ (1) = '"' THEN

{ Look for end of comment.

              #SCAN (clv$comment_delimiter, push_line_ptr^ (2, line_size - number_of_blanks - 1),
                    scan_index, found_char);
              IF found_char THEN
                index := scan_index + 1;
                WHILE index <= (line_size - number_of_blanks - terminator_size + 1) DO
                  IF push_line_ptr^ (index, terminator_size) = var_or_type_definition.terminator
                        (1, terminator_size) THEN
                    line_ptr^ (clv$current_indent_column, *) := push_line_ptr^ (1, line_size -
                          number_of_blanks);
                    put_line (line_ptr^, status);
                    RETURN;
                  IFEND;
                  index := index + 1;
                WHILEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

      clp$initialize_parse_state (line_ptr, NIL, parse);
      clp$f_scan_token (clc$slu_non_space, parse);
      clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
            number_of_structured_types, to_exit, any_type_found);
      IF to_exit AND (number_of_structured_types <= 0) THEN
        REPEAT
          clp$f_scan_token (clc$slu_any, parse);
          clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
                number_of_structured_types, to_exit, any_type_found);
        UNTIL parse.unit.kind = clc$lex_end_of_line;
      IFEND;
      WHILE parse.unit.kind <> clc$lex_end_of_line DO
        CASE parse.unit.kind OF
        = clc$lex_name =
          clp$f_scan_token (clc$slu_any, parse);
          clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
                number_of_structured_types, to_exit, any_type_found);
         /lowblock/
          WHILE parse.unit.kind <> clc$lex_colon DO
            CASE parse.unit.kind OF
            = clc$lex_space =
              IF number_of_structured_types <= 0 THEN
                clp$delete_current_format_token;
              IFEND;
            ELSE
              IF (number_of_structured_types <= 0) THEN
                osp$set_status_condition (cle$expecting_after_var_name, status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                RETURN;
              ELSEIF parse.unit.kind = clc$lex_end_of_line THEN
                EXIT /lowblock/;
              IFEND;
            CASEND;
            clp$f_scan_token (clc$slu_any, parse);
            clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
                  number_of_structured_types, to_exit, any_type_found);
          WHILEND /lowblock/ ;
          WHILE parse.unit.kind <> clc$lex_end_of_line DO
            clp$f_scan_token (clc$slu_any, parse);
            clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
                  number_of_structured_types, to_exit, any_type_found);
          WHILEND;
        ELSE
          clp$f_scan_token (clc$slu_any, parse);
          clp$f_find_structured_types (parse.text^(parse.unit_index,parse.unit.size),
                number_of_structured_types, to_exit, any_type_found);
        CASEND;
      WHILEND;

      any_type_found := FALSE;
      IF status.normal THEN
        clp$format_line (status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF clv$input_line_index < clv$input_line_size THEN
        start_index := clv$input_line_index;
        clp$isolate_command (clv$input_line_ptr^ (1, clv$input_line_size), start_index, clv$input_line_index);

        line_size := clv$input_line_index - start_index;
        push_line_ptr := ^clv$input_line_ptr^ (start_index, line_size);
        IF clv$input_line_index <= clv$input_line_size THEN
          clv$input_line_index := clv$input_line_index + 1;
        IFEND;
        got_line := TRUE;
      ELSE
        clp$get_statement_to_format (push_line_ptr, got_line, status);
        clv$command_header.command_type := clc$var_or_type_statement;
        line_size := clv$input_line_size;
      IFEND;
    WHILEND;

    message := 'Cant find ';
    message (11, terminator_size) := var_or_type_definition.terminator (1, terminator_size);
    osp$set_status_abnormal ('CL', cle$encountered_eoi, message, status);

  PROCEND clp$f_process_var_or_type;
?? TITLE := 'clp$recognize_format_tokens', EJECT ??

  PROCEDURE [XDCL] clp$recognize_format_tokens
    (    action: boolean);

{ PURPOSE:
{   This purpose of this procedure is to control whether or not
{   format tokens are to be added to clv$format_token_array.

    clv$add_format_tokens := action;

  PROCEND clp$recognize_format_tokens;
?? TITLE := 'clp$f_set_command_header_type', EJECT ??

  PROCEDURE [XDCL] clp$f_set_command_header_type
    (    command_type: clt$f_command_type);

    IF command_type = clc$labeled_command THEN
      clv$command_header.labeled := TRUE;
    ELSE
      clv$command_header.command_type := command_type;
    IFEND;

  PROCEND clp$f_set_command_header_type;
?? TITLE := 'clp$f_set_tree_marker', EJECT ??

  PROCEDURE [XDCL] clp$f_set_tree_marker
    (    node_value: clt$f_node_value;
         insert_index: integer;
         eoi_encountered: boolean);

{ PURPOSE:
{    This procedure sets into the format_token_array a marker specifying a tree_begin
{    and a tree_end of the specified node type. The node itself should have already
{    been identified.
{
{ NOTES:
{    1. This procedure sets the tree begin format marker at the index of the
{       token array specified.  Since these procedure is called only by the
{       scan_term_x procedures of clp$f_scan_expression, the unit following the
{       tree end has already been read and entered into the array unless an
{       end_of_line was encountered.
{

    VAR
      array_index: clt$token_array_index,
      move_count: 0 .. 3;

    IF (NOT clv$add_format_tokens) OR (insert_index < 1) OR (insert_index > clv$format_token_array_index) THEN
      RETURN;
    IFEND;

    clv$format_token_array_index := clv$format_token_array_index + 1;

    FOR array_index := clv$format_token_array_index DOWNTO insert_index DO
      clv$current_array_ptr^ [array_index + 1] := clv$current_array_ptr^ [array_index];
    FOREND;

    clv$current_array_ptr^ [insert_index].format_type := clc$tree_begin;
    clv$current_array_ptr^ [insert_index].node_value := node_value;
    clv$current_array_ptr^ [insert_index].clt_kind := clc$lex_unknown;
    clv$current_array_ptr^ [insert_index].token_size := 0;

    IF eoi_encountered THEN
      move_count := 0;
    ELSEIF clv$current_array_ptr^ [clv$format_token_array_index].clt_kind = clc$lex_space THEN
      move_count := 1;
    ELSEIF clv$current_array_ptr^ [clv$format_token_array_index - 1].clt_kind = clc$lex_space THEN
      move_count := 2;
    ELSE
      move_count := 1;
    IFEND;

    clv$format_token_array_index := clv$format_token_array_index + 1;
    clv$current_array_ptr^ [clv$format_token_array_index + 1] :=
          clv$current_array_ptr^ [clv$format_token_array_index];
    array_index := clv$format_token_array_index;
    WHILE move_count > 0 DO
      array_index := array_index - 1;
      clv$current_array_ptr^ [array_index + 1] := clv$current_array_ptr^ [array_index];
      move_count := move_count - 1;
    WHILEND;

    clv$current_array_ptr^ [array_index].format_type := clc$tree_end;
    clv$current_array_ptr^ [array_index].node_value := node_value;
    clv$current_array_ptr^ [array_index].clt_kind := clc$lex_unknown;
    clv$current_array_ptr^ [array_index].token_size := 0;

  PROCEND clp$f_set_tree_marker;
?? TITLE := 'clp$set_format_type', EJECT ??

  PROCEDURE [XDCL] clp$set_format_type
    (    format_type: clt$format_token_type);

{ PURPOSE:
{       The purpose of this procedure is to set the format type of the last
{       format token added to the format token array.
{

    VAR
      current_token: clt$format_token,
      temp_name: ost$name;

    IF NOT clv$add_format_tokens THEN
      RETURN;
    IFEND;

    IF clv$format_token_array_index > 0 THEN
      clv$current_array_ptr^ [clv$format_token_array_index].format_type := format_type;
    IFEND;
    current_token := clv$current_array_ptr^ [clv$format_token_array_index];
    IF (format_type = clc$reserved_name) AND (current_token.clt_kind = clc$lex_name) THEN
      temp_name := current_token.string_ptr^;
      #TRANSLATE (osv$lower_to_upper, temp_name, current_token.string_ptr^);
    IFEND;

  PROCEND clp$set_format_type;
?? TITLE := 'get_data_line', EJECT ??

  PROCEDURE get_data_line
    (VAR line_ptr: ^clt$command_line;
     VAR line_size: clt$command_line_size;
     VAR got_line: boolean;
     VAR status: ost$status);

    VAR
      ignore_byte_address: amt$file_byte_address,
      size: integer,
      transfer_count: amt$transfer_count;

    status.normal := TRUE;
    got_line := FALSE;

  /get_line/
    WHILE NOT got_line DO
      amp$get_next (input_file_id, line_ptr, clc$max_command_line_size, transfer_count, ignore_byte_address,
            clv$file_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      size := transfer_count;
      got_line := clv$file_position <= amc$eor;
      IF NOT got_line THEN
        line_size := 0;
        RETURN;
      IFEND;
      line_size := clp$trimmed_string_size (line_ptr^ (1, size));
      IF line_size = 0 THEN
        IF clv$processing_crev THEN
          clv$saved_blank_lines := clv$saved_blank_lines + 1;
        ELSE
          put_line ('', status);
        IFEND;
        got_line := FALSE;
      ELSEIF (line_ptr^ (1) = clv$key_character) AND (NOT clv$collecting_text) THEN

{ensure processing of line if collecting_text
{back when collect_text

        IF clv$processing_crev THEN
          windup_translate_crev (clv$current_indent_column, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        put_line (line_ptr^ (1, line_size), status);
        got_line := FALSE;
      IFEND;

    WHILEND /get_line/;

  PROCEND get_data_line;
?? TITLE := 'initialize', EJECT ??

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

{ PROCEDURE (osm$forsp) format_scl_procedure, format_scl_procedures, ..
{       format_scl_proc, format_scl_procs, forsclp, forsp (
{   input, i: file = $required
{   output, o: file = $required
{   page_width, pw: integer min_page_width..amc$max_page_width = 110
{   initial_indent_column, iic: integer 1..amc$max_page_width = 1
{   key_character, kc: string 1..1 = '*'
{   utility_definition_file, udf: file = $optional
{   process_collect_text, pct: boolean = false
{   translate, t: boolean = false
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 17] of clt$pdt_parameter_name,
        parameters: array [1 .. 9] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
          default_value: string (3),
        recend,
        type4: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
          default_value: string (1),
        recend,
        type5: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
          default_value: string (3),
        recend,
        type6: record
          header: clt$type_specification_header,
        recend,
        type7: record
          header: clt$type_specification_header,
          default_value: string (5),
        recend,
        type8: record
          header: clt$type_specification_header,
          default_value: string (5),
        recend,
        type9: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 9, 27, 14, 25, 38, 961], clc$command, 17, 9, 2, 0, 0, 0, 9, 'OSM$FORSP'],
            [['I                              ', clc$abbreviation_entry, 1],
            ['IIC                            ', clc$abbreviation_entry, 4],
            ['INITIAL_INDENT_COLUMN          ', clc$nominal_entry, 4],
            ['INPUT                          ', clc$nominal_entry, 1],
            ['KC                             ', clc$abbreviation_entry, 5],
            ['KEY_CHARACTER                  ', clc$nominal_entry, 5],
            ['O                              ', clc$abbreviation_entry, 2],
            ['OUTPUT                         ', clc$nominal_entry, 2],
            ['PAGE_WIDTH                     ', clc$nominal_entry, 3],
            ['PCT                            ', clc$abbreviation_entry, 7],
            ['PROCESS_COLLECT_TEXT           ', clc$nominal_entry, 7],
            ['PW                             ', clc$abbreviation_entry, 3],
            ['STATUS                         ', clc$nominal_entry, 9],
            ['T                              ', clc$abbreviation_entry, 8],
            ['TRANSLATE                      ', clc$nominal_entry, 8],
            ['UDF                            ', clc$abbreviation_entry, 6],
            ['UTILITY_DEFINITION_FILE        ', clc$nominal_entry, 6]], [

{ PARAMETER 1

      [4, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],

{ PARAMETER 2

      [8, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],

{ PARAMETER 3

      [9, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 20, clc$optional_default_parameter, 0, 3],

{ PARAMETER 4

      [3, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 20, clc$optional_default_parameter, 0, 1],

{ PARAMETER 5

      [6, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 8, clc$optional_default_parameter, 0, 3],

{ PARAMETER 6

      [17, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0],

{ PARAMETER 7

      [11, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 5],

{ PARAMETER 8

      [15, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 5],

{ PARAMETER 9

      [13, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name], clc$pass_by_reference, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],

{ PARAMETER 1

      [[1, 0, clc$file_type]],

{ PARAMETER 2

      [[1, 0, clc$file_type]],

{ PARAMETER 3

      [[1, 0, clc$integer_type], [min_page_width, amc$max_page_width, 10], '110'],

{ PARAMETER 4

      [[1, 0, clc$integer_type], [1, amc$max_page_width, 10], '1'],

{ PARAMETER 5

      [[1, 0, clc$string_type], [1, 1, FALSE], '''*'''],

{ PARAMETER 6

      [[1, 0, clc$file_type]],

{ PARAMETER 7

      [[1, 0, clc$boolean_type], 'false'],

{ PARAMETER 8

      [[1, 0, clc$boolean_type], 'false'],

{ PARAMETER 9

      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$input = 1,
      p$output = 2,
      p$page_width = 3,
      p$initial_indent_column = 4,
      p$key_character = 5,
      p$utility_definition_file = 6,
      p$process_collect_text = 7,
      p$translate = 8,
      p$status = 9;

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

    VAR
      attachment_options: array [1 .. 3] of fst$attachment_option,
      default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
      ignore_user_attribute_size: fst$user_defined_attribute_size,
      ignore_status: ost$status,
      input_attributes: fst$cycle_attribute_values,
      validation_attributes: array [1 .. 7] of fst$file_cycle_attribute;


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

    clv$key_character := pvt [p$key_character].value^.string_value^ (1);

    clv$current_indent_column := pvt [p$initial_indent_column].value^.integer_value.value;

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

    clv$output_line_number := 1;
    clv$current_line_size := 0;
    clv$error_count := 0;
    clv$warning_count := 0;

    validation_attributes [1].selector := fsc$file_contents_and_processor;
    validation_attributes [1].file_contents := fsc$legible_scl_procedure;
    validation_attributes [1].file_processor := osc$null_name;
    validation_attributes [2].selector := fsc$file_contents_and_processor;
    validation_attributes [2].file_contents := fsc$legible_scl_include;
    validation_attributes [2].file_processor := osc$null_name;
    validation_attributes [3].selector := fsc$file_contents_and_processor;
    validation_attributes [3].file_contents := fsc$legible_scl_job;
    validation_attributes [3].file_processor := osc$null_name;
    validation_attributes [4].selector := fsc$file_contents_and_processor;
    validation_attributes [4].file_contents := fsc$legible_data;
    validation_attributes [4].file_processor := osc$null_name;
    validation_attributes [5].selector := fsc$file_contents_and_processor;
    validation_attributes [5].file_contents := amc$legible;
    validation_attributes [5].file_processor := osc$null_name;
    validation_attributes [6].selector := fsc$file_contents_and_processor;
    validation_attributes [6].file_contents := fsc$data;
    validation_attributes [6].file_processor := osc$null_name;
    validation_attributes [7].selector := fsc$file_contents_and_processor;
    validation_attributes [7].file_contents := fsc$unknown_contents;
    validation_attributes [7].file_processor := osc$null_name;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [2].selector := fsc$open_share_modes;
    attachment_options [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [3].selector := fsc$create_file;
    attachment_options [3].create_file := FALSE;
    fsp$open_file (pvt [p$input].value^.file_value^, amc$record, ^attachment_options, NIL, NIL,
          ^validation_attributes, NIL, input_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    fsp$get_open_information (input_file_id, NIL, NIL, NIL, ^input_attributes, NIL, NIL, NIL,
          ignore_user_attribute_size, status);
    IF NOT status.normal THEN
      fsp$close_file (input_file_id, ignore_status);
      RETURN;
    IFEND;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$append, fsc$shorten];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [];
    attachment_options [2].selector := fsc$access_and_share_modes;
    attachment_options [2].access_modes.selector := fsc$specific_access_modes;
    attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
    attachment_options [2].share_modes.selector := fsc$specific_share_modes;
    attachment_options [2].share_modes.value := $fst$file_access_options [];
    attachment_options [3].selector := fsc$open_share_modes;
    attachment_options [3].open_share_modes := -$fst$file_access_options [];
    default_creation_attributes [1].selector := fsc$file_contents_and_processor;
    default_creation_attributes [1].file_contents := input_attributes.file_contents;
    default_creation_attributes [1].file_processor := osc$null_name;
    default_creation_attributes [2].selector := fsc$page_format;
    default_creation_attributes [2].page_format := amc$untitled_form;
    fsp$open_file (pvt [p$output].value^.file_value^, amc$record, ^attachment_options,
          ^default_creation_attributes, NIL, ^validation_attributes, NIL, output_file_id, status);
    IF NOT status.normal THEN
      fsp$close_file (input_file_id, ignore_status);
      RETURN;
    IFEND;

    clv$page_width := pvt [p$page_width].value^.integer_value.value;
    IF (clv$page_width - clv$current_indent_column + 1) < min_usable_space THEN
      osp$set_status_abnormal ('CL', cle$page_width_too_small, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, min_usable_space - 1, 10, FALSE, status);
      RETURN;
    IFEND;

    clv$process_collect_text := pvt [p$process_collect_text].value^.boolean_value.value;

    clv$translate := pvt [p$translate].value^.boolean_value.value;

  PROCEND initialize;
?? TITLE := 'initialize_command_header', EJECT ??

  PROCEDURE initialize_command_header
    (VAR command_header_pointer: ^clt$command_header);


    clv$command_header.labeled := FALSE;
    clv$command_header.command_type := clc$unknown_command;
    clv$command_header.command_line_size := 0;

    command_header_pointer := ^clv$command_header;
    clv$current_array_ptr := ^clv$format_token_array;
    clv$current_line_ptr := ^clv$format_line;
    clv$format_token_array_index := 0;
    clv$current_array_ptr^ [1].clt_kind := clc$lex_end_of_line;
    clv$current_array_ptr^ [1].token_size := 0;
    clv$current_line_size := 0;

  PROCEND initialize_command_header;
?? TITLE := 'get_string_from_array', EJECT ??

  PROCEDURE get_string_from_array
    (    begin_index: clt$token_array_index;
         end_index: clt$token_array_index;
         array_ptr: ^clt$format_token_array;
         string_ptr: ^string ( * );
     VAR status: ost$status);

    VAR
      current_string_size: clt$command_line_size,
      index: clt$token_array_index,
      token_size: clt$string_size;

    current_string_size := 0;

    FOR index := begin_index TO end_index DO
      token_size := array_ptr^ [index].token_size;
      IF token_size > 0 THEN
        IF current_string_size + token_size >= STRLENGTH (string_ptr^) THEN
          token_size := STRLENGTH (string_ptr^) - current_string_size;
        IFEND;
        string_ptr^ (current_string_size + 1, token_size) := array_ptr^ [index].string_ptr^;
        current_string_size := current_string_size + token_size;
        IF current_string_size >= STRLENGTH (string_ptr^) THEN
          RETURN;
        IFEND;
      IFEND;
    FOREND;

  PROCEND get_string_from_array;
?? TITLE := 'process_leading_comments', EJECT ??

{ PURPOSE:
{   To process the leading comments of a line. Identation will be the
{   current indentation unless no space precede the first comment, in which
{   case the output comment(s) will start in column 1. If more than one comment
{   is encountered (spaces are ignored), the comments will abut each other
{   on output. If a comment will not fit on the current line but will fit on the
{   next line, it will be placed on the next line.

    PROCEDURE process_leading_comments
      (    array_ptr: ^clt$format_token_array;
           max_array_index: clt$token_array_index;
           current_indent: clt$command_line_index;
       VAR format_index {input, output} : clt$token_array_index;
       VAR status: ost$status);

      VAR
        comment_index: clt$command_line_index,
        remaining_size: clt$command_line_size,
        transfer_size: clt$command_line_size,
        temp_index: clt$command_line_index,
        indent_column: clt$command_line_size,
        output_ptr: ^clt$command_line,
        output_size: clt$command_line_size,
        current_token: clt$format_token;

      status.normal := TRUE;
      output_ptr := NIL;
      output_size := 0;

      current_token := array_ptr^ [format_index];
      WHILE current_token.clt_kind <> clc$lex_end_of_line DO
        CASE current_token.clt_kind OF
        = clc$lex_space =
          ;
        = clc$lex_comment, clc$lex_unterminated_comment =
          IF output_size = 0 THEN
            IF format_index = 1 THEN
              indent_column := 1;
            ELSE
              indent_column := current_indent;
            IFEND;
            output_size := indent_column - 1;
            IF output_ptr = NIL THEN
              PUSH output_ptr: [clv$page_width];
            IFEND;
            output_ptr^ := '';
          IFEND;
          IF (output_size + current_token.token_size) <= clv$page_width THEN
            output_ptr^ (output_size + 1, current_token.token_size) := current_token.string_ptr^;
            output_size := output_size + current_token.token_size;
          ELSEIF current_token.token_size + indent_column - 1 <= clv$page_width THEN

{Fits on new line

            put_line (output_ptr^ (1, output_size), status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            output_ptr^ := '';
            output_ptr^ (indent_column, current_token.token_size) := current_token.string_ptr^;
            output_size := indent_column + current_token.token_size - 1;
            put_line (output_ptr^ (1, output_size), status);
            output_size := indent_column - 1;
          ELSE {Must be broken across lines
            IF output_size >= indent_column THEN {Flush previous
              put_line (output_ptr^ (1, output_size), status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;
            remaining_size := current_token.token_size;
            comment_index := 1;
            output_ptr^ := '';
            output_size := indent_column - 1;
            WHILE remaining_size > 0 DO
              transfer_size := clv$page_width - output_size;
              IF transfer_size > remaining_size THEN
                transfer_size := remaining_size;
              ELSE

              /find_separator/
                FOR temp_index := comment_index + transfer_size - 1 DOWNTO comment_index DO
                  CASE current_token.string_ptr^ (temp_index) OF
                  = ' ', ',', ')', ';' =
                    EXIT /find_separator/;
                  ELSE
                    ;
                  CASEND;
                FOREND /find_separator/;
                IF temp_index - comment_index > 20 {an arbitrary value} THEN
                  transfer_size := temp_index - comment_index + 1;
                IFEND;
              IFEND;
              output_ptr^ (output_size + 1, transfer_size) := current_token.
                    string_ptr^ (comment_index, transfer_size);
              output_size := output_size + transfer_size;
              put_line (output_ptr^ (1, output_size), status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              output_ptr^ := '';
              output_size := indent_column - 1;
              remaining_size := remaining_size - transfer_size;
              IF remaining_size > 0 THEN
                output_ptr^ (indent_column) := '"';
                output_size := indent_column;
                comment_index := comment_index + transfer_size;
              IFEND;
            WHILEND;
          IFEND;
        ELSE {Not space or comment
          RETURN;
        CASEND;
        format_index := format_index + 1;
        current_token := array_ptr^ [format_index];
      WHILEND;
      IF output_size >= indent_column THEN
        put_line (output_ptr^ (1, output_size), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

    PROCEND process_leading_comments;
?? TITLE := 'process_pragmat', EJECT ??

  PROCEDURE process_pragmat
    (    line: string ( * );
     VAR status: ost$status);

{ PROCEDURE formatter_pragmat (
{   command, c: name = $optional
{   format, fmt, f: boolean = $optional
{   page_width, pw: integer min_page_width..amc$max_page_width = $optional
{   mode, m: key
{       push, pop
{     keyend = $optional
{   )

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
      recend,
    recend := [
    [1,
    [103, 4, 9, 9, 21, 39, 534],
    clc$command, 9, 4, 0, 0, 0, 0, 0, ''], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['COMMAND                        ',clc$nominal_entry, 1],
    ['F                              ',clc$abbreviation_entry, 2],
    ['FMT                            ',clc$alias_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['M                              ',clc$abbreviation_entry, 4],
    ['MODE                           ',clc$nominal_entry, 4],
    ['PAGE_WIDTH                     ',clc$nominal_entry, 3],
    ['PW                             ',clc$abbreviation_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81, clc$optional_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$boolean_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [min_page_width, amc$max_page_width, 10]],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [2], [
    ['POP                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['PUSH                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ]];

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

    CONST
      p$command = 1,
      p$format = 2,
      p$page_width = 3,
      p$mode = 4;

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

    VAR
      command_name: clt$name,
      control_statement_descriptor: ^clt$f_control_statement_desc,
      found_char: boolean,
      parameter_list_size: clt$parameter_list_size,
      pushed_objects_p: ^t$pushed_objects,
      scan_index: integer,
      work_area: ^clt$work_area;


    status.normal := TRUE;
    #SCAN (clv$comment_delimiter, line (3, * ), scan_index, found_char);
    IF (scan_index - 1) < 2 THEN
      RETURN;
    IFEND;

    IF work_area_segment.sequence_pointer = NIL THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, work_area_segment, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      RESET work_area_segment.sequence_pointer;
    IFEND;
    work_area := work_area_segment.sequence_pointer;

    clp$evaluate_sub_parameters (line (3, * ), #SEQ (pdt), work_area, ^pvt, status);
    IF NOT status.normal THEN
      status.normal := TRUE;
      RETURN;
    IFEND;

    IF pvt [p$mode].specified THEN
      IF pvt [p$mode].value^.keyword_value = 'PUSH' THEN
        ALLOCATE pushed_objects_p;
        pushed_objects_p^.next_p := v$pushed_objects_p;
        pushed_objects_p^.formatting_in_effect := clv$formatting_in_effect;
        pushed_objects_p^.page_width := clv$page_width;
        v$pushed_objects_p := pushed_objects_p;
      ELSEIF pvt [p$mode].value^.keyword_value = 'POP' THEN
        IF v$pushed_objects_p <> NIL THEN
          pushed_objects_p := v$pushed_objects_p;
          v$pushed_objects_p := v$pushed_objects_p^.next_p;
          clv$formatting_in_effect := pushed_objects_p^.formatting_in_effect;
          clv$page_width := pushed_objects_p^.page_width;
        IFEND;
      IFEND;
    IFEND;

    IF pvt [p$format].specified THEN
      clv$formatting_in_effect := pvt [p$format].value^.boolean_value.value;
    IFEND;

    IF pvt [p$command].specified THEN
      command_name.value := pvt [p$command].value^.name_value;
      command_name.size := clp$trimmed_string_size (command_name.value);
      clp$search_format_utilities (command_name, control_statement_descriptor);
      IF control_statement_descriptor <> NIL THEN

{ NOTE: The format utilities involved serve only to initialize or terminate the formattting
{    of recognized utilities and require no parameters.

        parameter_list_size := 0;
        control_statement_descriptor^.command^ (#SEQ (parameter_list_size) ^, status);
      IFEND;
    IFEND;

    IF pvt [p$page_width].specified THEN
      IF (clv$page_width - clv$current_indent_column + 1) < min_usable_space THEN
        osp$set_status_abnormal ('CL', cle$page_width_too_small, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, min_usable_space - 1, 10, FALSE, status);
        RETURN;
      IFEND;
      clv$page_width := pvt [p$page_width].value^.integer_value.value;
    IFEND

  PROCEND process_pragmat;
?? TITLE := 'put_line', EJECT ??

  PROCEDURE put_line
    (    line: string ( * );
     VAR status: ost$status);

    VAR
      ignore_byte_address: amt$file_byte_address;

    amp$put_next (output_file_id, ^line, STRLENGTH (line), ignore_byte_address, status);
    clv$output_line_number := clv$output_line_number + 1;
    clv$last_command_blank := line = '  ';

  PROCEND put_line;
?? TITLE := 'report_status', EJECT ??

  PROCEDURE report_status
    (    msg_status: ost$status;
         command_line_ptr: clt$command_line;
     VAR status: ost$status);

    VAR
      line_count: ost$status_message_line_count,
      line_count_ptr: ^ost$status_message_line_count,
      line_ptr: ^ost$status_message_line,
      line_size_ptr: ^ost$status_message_line_size,
      message_sequence: ost$status_message,
      mes_seq_ptr: ^ost$status_message,
      error_line: string (100),
      j: integer;

    put_line (command_line_ptr, status);
    IF status.normal THEN
      put_line (' " ^^ Problem with preceding line(s) due to -', status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF msg_status.condition = cle$internal_formatter_error THEN
      clv$warning_count := clv$warning_count + 1;
      STRINGREP (error_line, j, '" --WARNING-- ', msg_status.text.value (2, msg_status.text.size - 1));
      put_line (error_line (1, j), status);
    ELSE
      clv$error_count := clv$error_count + 1;
      osp$format_message (msg_status, osc$current_message_level, clv$page_width, message_sequence, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      mes_seq_ptr := ^message_sequence;
      RESET mes_seq_ptr;
      NEXT line_count_ptr IN mes_seq_ptr;
      FOR line_count := 1 TO line_count_ptr^ DO
        NEXT line_size_ptr IN mes_seq_ptr;
        NEXT line_ptr: [line_size_ptr^] IN mes_seq_ptr;
        put_line (line_ptr^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
    IFEND;

  PROCEND report_status;
?? TITLE := 'translate_function', EJECT ??

  PROCEDURE translate_function
    (    begin_index: clt$token_array_index;
         array_ptr: ^clt$format_token_array;
         translate_line_ptr: ^clt$command_line;
     VAR max_array_index: clt$token_array_index;
     VAR translate_line_size: clt$command_line_size;
     VAR status: ost$status);


    VAR
      any_value_kind: [STATIC, READ] clt$value_kind_specifier := [NIL, clc$any_value],
      string_size: clt$command_line_size,
      token: clt$format_token,
      end_index: clt$token_array_index,
      function_begin_count: clt$command_line_size,
      index: clt$token_array_index,
      input_line_ptr: ^clt$command_line,
      output_line_size: clt$command_line_size,
      name_only_translated: boolean,
      name_to_flag: ost$name,
      value: clt$value,
      save_array_ptr: ^clt$format_token_array,
      save_clv_line_ptr: ^clt$command_line,
      save_clv_line_size: clt$command_line_size,
      temp_name: ost$name,
      new_array_ptr: ^clt$format_token_array;


    status.normal := TRUE;
    PUSH input_line_ptr: [clc$max_command_line_size];
    string_size := 0;
    function_begin_count := 1;

  /find_function_end/
    FOR end_index := begin_index + 1 TO max_array_index DO
      token := array_ptr^ [end_index];
      CASE token.format_type OF
      = clc$function_begin, clc$translated_function =
        function_begin_count := function_begin_count + 1;
      = clc$function_end =
        function_begin_count := function_begin_count - 1;
        IF function_begin_count = 0 THEN
          EXIT /find_function_end/;
        IFEND;
      ELSE
        IF token.token_size > 0 THEN
          input_line_ptr^ (string_size + 1, token.token_size) := token.string_ptr^;
          string_size := string_size + token.token_size;
        IFEND;
      CASEND;
    FOREND /find_function_end/;

    IF function_begin_count > 0 THEN
      osp$set_status_abnormal ('CL', cle$internal_formatter_error, ' Cant find function_end', status);
      RETURN;
    IFEND;

    clp$translate_function (^input_line_ptr^ (1, string_size), ^translate_line_ptr^
          (translate_line_size + 1, * ), begin_index, end_index, array_ptr, max_array_index, output_line_size,
          name_only_translated, name_to_flag, status);
    IF (output_line_size = 0) OR (NOT status.normal) THEN
      RETURN;
    IFEND;

    IF name_only_translated THEN
      array_ptr^ [begin_index + 1].token_size := output_line_size;
      array_ptr^ [begin_index + 1].string_ptr := ^translate_line_ptr^
            (translate_line_size + 1, output_line_size);
      translate_line_size := translate_line_size + output_line_size;
      RETURN;
    IFEND;

    save_array_ptr := clv$current_array_ptr;
    save_clv_line_ptr := clv$current_line_ptr;
    save_clv_line_size := clv$current_line_size;
    PUSH new_array_ptr;
    clv$current_array_ptr := new_array_ptr;
    clv$format_token_array_index := 0;
    clv$current_line_ptr := translate_line_ptr;
    clv$current_line_size := translate_line_size + output_line_size;

    clp$f_scan_expression (translate_line_ptr^ (translate_line_size + 1, output_line_size), any_value_kind,
          value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF name_to_flag <> '' THEN

    /flag_translated/
      FOR index := 1 TO clv$format_token_array_index DO
        IF (new_array_ptr^ [index].format_type = clc$function_begin) AND
              (new_array_ptr^ [index + 1].clt_kind = clc$lex_name) THEN
          #TRANSLATE (osv$lower_to_upper, new_array_ptr^ [index + 1].string_ptr^, temp_name);
          IF temp_name = name_to_flag THEN
            new_array_ptr^ [index].format_type := clc$translated_function;
            EXIT /flag_translated/;
          IFEND;
        IFEND;
      FOREND /flag_translated/;
    IFEND;

    delete_from_array (begin_index, end_index, array_ptr, max_array_index);
    insert_into_array (begin_index - 1, new_array_ptr^, clv$format_token_array_index, array_ptr,
          max_array_index);

    array_ptr^ [max_array_index + 1].clt_kind := clc$lex_end_of_line;
    array_ptr^ [max_array_index + 1].token_size := 0;

    clv$current_array_ptr := save_array_ptr;
    clv$current_line_ptr := save_clv_line_ptr;
    translate_line_size := clv$current_line_size;
    clv$current_line_size := save_clv_line_size;
    clv$format_token_array_index := begin_index;

  PROCEND translate_function;
?? TITLE := 'delete_from_array', EJECT ??

  PROCEDURE delete_from_array
    (    first_index: clt$token_array_index;
         last_index: clt$token_array_index,
         array_ptr: ^array [1 .. clc$max_array_tokens] of clt$format_token;
     VAR entry_count: clt$token_array_index);

    VAR
      current_token: clt$format_token,
      get_index: 1 .. clc$max_array_tokens,
      put_index: 1 .. clc$max_array_tokens;

    get_index := last_index + 1;
    put_index := first_index;

    REPEAT
      current_token := array_ptr^ [get_index];
      array_ptr^ [put_index] := current_token;
      get_index := get_index + 1;
      put_index := put_index + 1;
    UNTIL current_token.clt_kind = clc$lex_end_of_line; {?????????
    entry_count := entry_count - (last_index - first_index + 1);

  PROCEND delete_from_array;
?? TITLE := 'insert_into_array', EJECT ??

  PROCEDURE insert_into_array
    (    insert_after_index: clt$token_array_index;
         new_array_entries: array [1 .. clc$max_array_tokens] of clt$format_token;
         new_entry_count: 1 .. clc$max_array_tokens;
         array_ptr: ^array [1 .. clc$max_array_tokens] of clt$format_token;
     VAR total_entry_count {input, output} : clt$token_array_index);

    VAR
      index: 1 .. clc$max_array_tokens;

    FOR index := 1 TO (total_entry_count - insert_after_index) DO
      array_ptr^ [total_entry_count + new_entry_count - index + 1] :=
            array_ptr^ [total_entry_count - index + 1];
    FOREND;

    FOR index := 1 TO new_entry_count DO
      array_ptr^ [insert_after_index + index] := new_array_entries [index];
    FOREND;

    total_entry_count := total_entry_count + new_entry_count;

  PROCEND insert_into_array;
?? TITLE := 'isolate_parameter', EJECT ??

  PROCEDURE isolate_parameter
    (    begin_index: clt$token_array_index;
         end_index: clt$token_array_index;
         array_ptr: ^array [1 .. clc$max_array_tokens] of clt$format_token;
         count_list_elements: boolean;
     VAR comment_index: clt$token_array_index;
     VAR comment_size: clt$command_line_size;
     VAR parameter_name: ost$name;
     VAR parameter_name_size: 0 .. osc$max_name_size;
     VAR prelude_size: clt$command_line_size;
     VAR prelude_begin: clt$token_array_index;
     VAR prelude_end: clt$token_array_index;
     VAR parameter_size: clt$command_line_size;
     VAR parameter_begin: clt$token_array_index;
     VAR parameter_end: clt$token_array_index;
     VAR postlude_size: clt$command_line_size;
     VAR postlude_begin: clt$token_array_index;
     VAR postlude_end: clt$token_array_index;
     VAR value_set_count: clt$list_size;
     VAR status: ost$status);

    VAR
      function_begin_count: 0 .. osc$max_string_size,
      index: clt$token_array_index,
      token: clt$format_token;

    status.normal := TRUE;
    comment_index := 0;
    comment_size := 0;
    parameter_name := '';
    parameter_name_size := 0;
    prelude_size := 0;
    parameter_size := 0;
    postlude_size := 0;
    value_set_count := 0;

    index := begin_index;

    IF array_ptr^ [index].format_type <> clc$parameter_begin THEN
      osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find parameter begin to isolate.',
            status);
      RETURN;
    IFEND;

    index := index + 1;
    token := array_ptr^ [index];

    IF token.format_type = clc$parameter_name THEN
      prelude_begin := index;
      parameter_name := token.string_ptr^;
      parameter_name_size := token.token_size;
      prelude_size := prelude_size + parameter_name_size;
      index := index + 1;
      token := array_ptr^ [index];
      WHILE token.clt_kind = clc$lex_space DO
        IF token.token_size > 0 THEN
          prelude_size := prelude_size + token.token_size;
        IFEND;
        index := index + 1;
        token := array_ptr^ [index];
      WHILEND;
      IF token.clt_kind <> clc$lex_equal THEN
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find eq_token for parameter.',
              status);
        RETURN;
      IFEND;
      prelude_size := prelude_size + token.token_size;
      index := index + 1;
      token := array_ptr^ [index];
      WHILE token.clt_kind = clc$lex_space DO
        prelude_size := prelude_size + token.token_size;
        index := index + 1;
        token := array_ptr^ [index];
      WHILEND;
    IFEND;

    IF token.clt_kind = clc$lex_left_parenthesis THEN
      IF parameter_name_size = 0 THEN
        prelude_begin := index;
      IFEND;
      prelude_size := prelude_size + token.token_size;
      index := index + 1;
      token := array_ptr^ [index];
      WHILE token.clt_kind = clc$lex_space DO
        prelude_size := prelude_size + token.token_size;
        index := index + 1;
        token := array_ptr^ [index];
      WHILEND;
    IFEND;

    IF prelude_size > 0 THEN
      prelude_end := index - 1;
    ELSE
      prelude_begin := index;
      prelude_end := index;
    IFEND;

    parameter_begin := index;
    function_begin_count := 0;

  /isolate/
    WHILE index <= end_index DO
      token := array_ptr^ [index];
      CASE token.format_type OF
      = clc$parameter_end =
        IF function_begin_count = 0 THEN
          EXIT /isolate/;
        IFEND;
      = clc$function_begin, clc$translated_function =
        function_begin_count := function_begin_count + 1;
      = clc$function_end =
        function_begin_count := function_begin_count - 1;
      = clc$value_begin =
        IF count_list_elements AND (function_begin_count <= 0) THEN
          value_set_count := value_set_count + 1;
        IFEND;
      = clc$value_set_begin =
        IF NOT count_list_elements THEN
          value_set_count := value_set_count + 1;
        IFEND;
      ELSE
        IF token.clt_kind = clc$lex_end_of_line THEN
          osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find end of parameter.', status);
          RETURN;
        IFEND;
        IF (token.clt_kind = clc$lex_right_parenthesis) AND
              (array_ptr^ [index + 1].format_type = clc$parameter_end) AND (function_begin_count = 0) THEN
          index := index - 1;
          EXIT /isolate/;
        IFEND;
        IF token.token_size > 0 THEN
          IF (token.clt_kind = clc$lex_comment) OR (token.clt_kind = clc$lex_unterminated_comment) THEN
            comment_index := index;
            comment_size := token.token_size;
          ELSE
            parameter_size := parameter_size + token.token_size;
          IFEND;
        IFEND;
      CASEND;
      index := index + 1;
    WHILEND /isolate/;

    parameter_end := index;
    IF (index + 1 >= end_index) OR (array_ptr^ [index + 1].clt_kind = clc$lex_end_of_line) THEN
      postlude_begin := index;
      postlude_end := index;
      RETURN;
    IFEND;
    index := index + 1;
    postlude_begin := index;
    token := array_ptr^ [index];

    IF token.clt_kind = clc$lex_right_parenthesis THEN
      postlude_size := postlude_size + token.token_size;
      index := index + 1;
      token := array_ptr^ [index];
      IF token.format_type = clc$parameter_end THEN
        index := index + 1;
        token := array_ptr^ [index];
      IFEND;
    IFEND;

    WHILE (token.clt_kind = clc$lex_space) OR (token.clt_kind = clc$lex_comma) DO
      postlude_size := postlude_size + token.token_size;
      index := index + 1;
      token := array_ptr^ [index];
    WHILEND;

    IF postlude_size > 0 THEN
      postlude_end := index - 1;
    ELSE
      postlude_end := index;
    IFEND;

  PROCEND isolate_parameter;
?? TITLE := 'translate_create_variable', EJECT ??

  PROCEDURE translate_create_variable
    (    begin_index: clt$token_array_index;
         end_index: clt$token_array_index;
         array_ptr: ^array [1 .. clc$max_array_tokens] of clt$format_token;
         external_indent_column: amt$page_width;
     VAR status: ost$status);

    TYPE
      params = record
        name: ost$name,
        number: 1 .. clc$max_parameters,
      recend;

    CONST
      parameter_name_count = 12;

    VAR
      parameter_names: [STATIC, READ, oss$job_paged_literal] array [1 .. parameter_name_count] of params := [
            {} ['names', 1], ['name', 1], ['n', 1],
            {} ['kind', 2], ['k', 2],
            {} ['dimension', 3], ['d', 3],
            {} ['value', 4], ['v', 4],
            {} ['scope', 5], ['s', 5],
            {} ['status', 6]];

    VAR
      bound_ptr: ^ost$string,
      comment_index: clt$token_array_index,
      comment_size: clt$command_line_size,
      comment_string: ^clt$string_value,
      continued_value_string: ^clt$string_value,
      current_string: string (100), {???? what if indent is LARGE???
      ellipsis_found: boolean,
      indent_size: clt$string_size,
      index: clt$token_array_index,
      j: integer,
      kind_name: ost$name,
      line: ost$string,
      lower_bound: ost$string,
      name: ost$name,
      names_begin_index: clt$token_array_index,
      names_end_index: clt$token_array_index,
      name_index: 1 .. parameter_name_count,
      name_indent_column: amt$page_width,
      name_set_count: clt$list_size,
      name_size: 0 .. osc$max_string_size,
      name_specified: boolean,
      parameter_begin: clt$token_array_index,
      parameter_end: clt$token_array_index,
      parameter_size: clt$command_line_size,
      parameter: ^clt$string_value,
      parameter_name: ost$name,
      parameter_name_size: 0 .. osc$max_name_size,
      parameter_number: 1 .. clc$max_parameters,
      postlude_size: clt$command_line_size,
      postlude: ost$string,
      postlude_begin: clt$token_array_index,
      postlude_end: clt$token_array_index,
      prelude_size: clt$command_line_size,
      prelude: ost$string,
      prelude_begin: clt$token_array_index,
      prelude_end: clt$token_array_index,
      previous_token: clt$format_token,
      scope_name: ost$name,
      start: 0 .. osc$max_string_size,
      string_end: 0 .. osc$max_string_size,
      string_qualifier: ost$string,
      temp_index: clt$token_array_index,
      temp_name: ost$name,
      temp_string: string (osc$max_string_size),
      token: clt$format_token,
      upper_bound: ost$string,
      value_set_count: clt$list_size,
      value_size: clt$string_size,
      value_string: ^clt$string_value;

    status.normal := TRUE;

    IF (clv$command_header.command_type <> clc$to_be_translated_command) AND clv$processing_crev THEN
      windup_translate_crev (external_indent_column, status);
      RETURN;
    IFEND;

    name_set_count := 0;
    kind_name := '';
    string_qualifier.size := 0;
    lower_bound.size := 0;
    upper_bound.size := 0;
    value_size := 0;
    scope_name := '';

    index := begin_index;
    parameter_number := 1;

  /find_parameters/
    WHILE index <= end_index DO
      token := array_ptr^ [index];
      IF token.clt_kind = clc$lex_end_of_line THEN
        EXIT /find_parameters/;
      IFEND;

      WHILE (token.format_type <> clc$parameter_begin) AND (index < end_index) DO
        index := index + 1;
        token := array_ptr^ [index];
      WHILEND;

      IF token.format_type <> clc$parameter_begin THEN
        osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find parameter_begin.', status);
        RETURN;
      IFEND;

      isolate_parameter (index, end_index, array_ptr, TRUE, comment_index, comment_size, parameter_name,
            parameter_name_size, prelude_size, prelude_begin, prelude_end, parameter_size, parameter_begin,
            parameter_end, postlude_size, postlude_begin, postlude_end, value_set_count, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter_size = 0 THEN
        parameter_number := parameter_number + 1;
        index := postlude_end + 1;
        CYCLE /find_parameters/;
      IFEND;

      PUSH parameter: [parameter_size];
      name_specified := parameter_name_size > 0;
      get_string_from_array (parameter_begin, parameter_end, array_ptr, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter_name_size > 0 THEN

      /search_for_name/
        FOR name_index := 1 TO parameter_name_count DO
          IF parameter_names [name_index].name = parameter_name THEN
            EXIT /search_for_name/;
          IFEND;
        FOREND /search_for_name/;

        IF parameter_names [name_index].name <> parameter_name THEN
          osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name (1, parameter_name_size),
                status);
          RETURN;
        IFEND;

        parameter_number := parameter_names [name_index].number;
      ELSE

      /search_for_number/
        FOR name_index := 1 TO parameter_name_count DO
          IF parameter_names [name_index].number = parameter_number THEN
            parameter_name := parameter_names [name_index].name;
            parameter_name_size := clp$trimmed_string_size (parameter_name);
            EXIT /search_for_number/;
          IFEND;
        FOREND /search_for_number/;
      IFEND;

      CASE parameter_number OF
      = 1 = {name
        IF name_set_count > 0 THEN
          osp$set_status_abnormal ('CL', cle$doubly_defined_parameter,
                parameter_name (1, parameter_name_size), status);
          RETURN;
        IFEND;

        names_begin_index := parameter_begin;
        names_end_index := parameter_end;
        name_set_count := value_set_count;
        IF name_set_count = 0 THEN
          name_set_count := 1;
        IFEND;

      = 2 = {kind
        IF kind_name <> '' THEN
          osp$set_status_abnormal ('CL', cle$doubly_defined_parameter,
                parameter_name (1, parameter_name_size), status);
          RETURN;
        IFEND;

        CASE value_set_count OF
        = 1 =
          get_string_from_array (parameter_begin, parameter_end, array_ptr, ^kind_name, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          kind_name := parameter^;
          IF (kind_name <> 'integer') AND (kind_name <> 'boolean') AND (kind_name <> 'string') AND
                (kind_name <> 'status') THEN
            osp$set_status_abnormal ('CL', cle$expecting_var_kind_name, parameter^, status);
            RETURN;
          IFEND;
        = 2 =
          index := parameter_begin + 2;
          IF (array_ptr^ [index].clt_kind = clc$lex_name) AND (array_ptr^ [index].string_ptr^ = 'string') THEN
            kind_name := 'string';
          ELSE
            osp$set_status_abnormal ('CL', cle$only_qualify_string_var, '', status);
            RETURN;
          IFEND;

        /find_qualifier_begin/
          FOR temp_index := parameter_begin + 2 TO parameter_end DO
            token := array_ptr^ [temp_index];
            IF token.format_type = clc$value_begin THEN
              EXIT /find_qualifier_begin/;
            IFEND;
          FOREND /find_qualifier_begin/;

          IF token.format_type <> clc$value_begin THEN
            osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant find string qualifier.',
                  status);
            RETURN;
          IFEND;

          string_qualifier.size := 0;
          string_qualifier.value := '';

        /build_qualifier/
          FOR index := temp_index + 1 TO parameter_end DO
            token := array_ptr^ [index];
            IF token.format_type = clc$value_end THEN
              EXIT /build_qualifier/;
            IFEND;
            IF token.token_size > 0 THEN
              string_qualifier.value (string_qualifier.size + 1, token.token_size) := token.string_ptr^;
              string_qualifier.size := string_qualifier.size + token.token_size;
            IFEND;
          FOREND /build_qualifier/;
        ELSE
          osp$set_status_abnormal ('CL', cle$too_few_or_many_list_elems, parameter^, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '0', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '2', status);
          RETURN;
        CASEND;

      = 3 = {dimension
        IF lower_bound.size <> 0 THEN
          osp$set_status_abnormal ('CL', cle$doubly_defined_parameter,
                parameter_name (1, parameter_name_size), status);
          RETURN;
        IFEND;
        IF value_size > 0 THEN
          IF clv$processing_crev THEN {Windup
            windup_translate_crev (external_indent_column, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
          put_line (clv$input_line_ptr^ (1, clv$input_line_size), status);
          RETURN;
        IFEND;

        bound_ptr := ^lower_bound;
        ellipsis_found := FALSE;
        previous_token.clt_kind := clc$lex_unknown;
        index := parameter_begin;

        WHILE index <= parameter_end DO
          token := array_ptr^ [index];
          IF NOT ellipsis_found THEN
            IF token.clt_kind = clc$lex_ellipsis THEN
              ellipsis_found := TRUE;
              IF previous_token.clt_kind = clc$lex_space THEN
                bound_ptr^.size := bound_ptr^.size - previous_token.token_size;
              IFEND;
              bound_ptr := ^upper_bound;
              index := index + 1;
              IF index <= parameter_end THEN
                token := array_ptr^ [index];
                IF token.clt_kind = clc$lex_space THEN
                  index := index + 1;
                  IF index <= parameter_end THEN
                    token := array_ptr^ [index];
                  IFEND;
                IFEND;
              IFEND;
              IF index > parameter_end THEN
                osp$set_status_abnormal ('CL', cle$internal_formatter_error, 'Cant process dimension value.',
                      status);
                RETURN;
              IFEND;
            ELSE
              previous_token := token;
            IFEND;
          IFEND;

          IF token.token_size > 0 THEN
            bound_ptr^.value (bound_ptr^.size + 1, token.token_size) := token.string_ptr^;
            bound_ptr^.size := bound_ptr^.size + token.token_size;
          IFEND;
          index := index + 1;
        WHILEND;
      = 4 = {value
        IF value_size > 0 THEN
          osp$set_status_abnormal ('CL', cle$doubly_defined_parameter,
                parameter_name (1, parameter_name_size), status);
          RETURN;
        IFEND;

        IF lower_bound.size <> 0 THEN
          IF clv$processing_crev THEN {Windup
            windup_translate_crev (external_indent_column, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
          put_line (clv$input_line_ptr^ (1, clv$input_line_size), status);
          RETURN;
        IFEND;

        value_string := parameter;
        value_size := parameter_size;

      = 5 = {scope
        IF (value_set_count > 1) THEN
          osp$set_status_abnormal ('CL', cle$too_few_or_many_list_elems,
                parameter_name (1, parameter_name_size), status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '0', status);
          RETURN;
        IFEND;
        IF scope_name <> '' THEN
          osp$set_status_abnormal ('CL', cle$doubly_defined_parameter,
                parameter_name (1, parameter_name_size), status);
          RETURN;
        IFEND;

        temp_name := parameter^;
        IF (temp_name = 'xdcl') OR (temp_name = 'xref') OR (temp_name = 'job') OR (temp_name = 'local') THEN
          #TRANSLATE (osv$lower_to_upper, temp_name, scope_name);
        ELSE
          scope_name := 'UTILITY';
        IFEND;
      = 6 = {status
        IF clv$processing_crev THEN {Windup
          windup_translate_crev (external_indent_column, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        put_line (clv$input_line_ptr^ (1, clv$input_line_size), status);
        RETURN;
      CASEND;
      parameter_number := parameter_number + 1;
      index := postlude_end + 1;
    WHILEND /find_parameters/;

    IF name_set_count = 0 THEN
      osp$set_status_abnormal ('CL', cle$required_parameter_omitted, 'NAMES', status);
      RETURN;
    IFEND;

    IF clv$command_header.command_type = clc$to_be_translated_command THEN
      IF clv$processing_crev THEN
        WHILE clv$saved_blank_lines > 0 DO
          put_line ('', status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          clv$saved_blank_lines := clv$saved_blank_lines - 1;
        WHILEND;
      ELSE
        clv$processing_crev := TRUE;
        clv$saved_blank_lines := 0;
        current_string := '';
        current_string (external_indent_column, 3) := 'VAR';
        put_line (current_string (1, clv$current_indent_column + 2), status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    index := 1;
    process_leading_comments (clv$current_array_ptr, clv$format_token_array_index, clv$current_indent_column,
          index, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    name_indent_column := external_indent_column + 2;
    index := names_begin_index - 1;

  /process_names/
    WHILE name_set_count > 0 DO
      name := '';
      start := 0;
      string_end := 0;

    /find_name/
      WHILE index < names_end_index DO
        index := index + 1;
        token := array_ptr^ [index];

{      ((token.clt_kind = clc$lex_name) OR (token.clt_kind = clc$lex_left_parenthesis))

        IF (token.format_type = clc$unassigned) THEN
          IF (token.clt_kind = clc$lex_comma) AND (array_ptr^ [index - 1].format_type = clc$value_end) THEN
            CYCLE /find_name/;
          IFEND;

{         name := token.string_ptr^;

          j := clp$trimmed_string_size (token.string_ptr^);
          temp_string (start + 1, string_end + j) := token.string_ptr^;
          start := start + j;
          string_end := start;
          IF array_ptr^ [index + 1].format_type = clc$value_end THEN
            EXIT /find_name/;
          IFEND;
        IFEND;
      WHILEND /find_name/;
      IF temp_string = '' THEN
        EXIT /process_names/;
      IFEND;

{   name_size := clp$trimmed_string_size (name);

      name_size := string_end;
      line.value := '';
      line.size := name_indent_column - 1;
      line.value (name_indent_column, name_size) := temp_string (1, name_size);
      line.size := line.size + name_size;
      line.value (line.size + 1) := ':';
      line.size := line.size + 1;
      IF scope_name <> '' THEN
        line.value (line.size + 1, 2) := ' (';
        line.size := line.size + 2;
        name_size := clp$trimmed_string_size (scope_name);
        line.value (line.size + 1, name_size) := scope_name (1, name_size);
        line.size := line.size + name_size;
        line.value (line.size + 1) := ')';
        line.size := line.size + 1;
      IFEND;

      IF lower_bound.size <> 0 THEN
        IF upper_bound.size = 0 THEN
          upper_bound := lower_bound;
          lower_bound.value := '1';
          lower_bound.size := 1;
        IFEND;
        STRINGREP (temp_string, j, ' array ', lower_bound.value (1, lower_bound.size), ' .. ',
              upper_bound.value (1, upper_bound.size), ' of');
        line.value (line.size + 1, j) := temp_string (1, j);
        line.size := line.size + j;
      IFEND;

      IF kind_name = '' THEN
        kind_name := 'integer'
      IFEND;
      name_size := clp$trimmed_string_size (kind_name);
      line.value (line.size + 2, name_size) := kind_name (1, name_size);
      line.size := line.size + name_size + 1;

      IF string_qualifier.size > 0 THEN
        STRINGREP (temp_string, j, ' 0 .. ', string_qualifier.value (1, string_qualifier.size));
        line.value (line.size + 1, j) := temp_string (1, j);
        line.size := line.size + j;
      IFEND;

      IF value_size > 0 THEN
        line.value (line.size + 1, 3) := ' = ';
        line.size := line.size + 3;
        IF comment_size > 0 THEN
          continued_value_string := value_string;
          PUSH value_string: [value_size + comment_size + 1];
          value_string^ := '';
          value_string^ (1, value_size) := continued_value_string^;
          PUSH comment_string: [comment_size];
          get_string_from_array (comment_index, comment_index+1, array_ptr, comment_string, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          value_string^ (value_size + 2, comment_size) := comment_string^;
          value_size := value_size + comment_size + 1;
        IFEND;
        IF line.size + value_size > clv$page_width THEN
          put_line (line.value (1, line.size), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          indent_size := name_indent_column - 1 + clc$continuation_increment;
          PUSH continued_value_string: [indent_size + value_size];
          continued_value_string^ := '';
          continued_value_string^ (indent_size + 1, value_size) := value_string^;
          put_line (continued_value_string^, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          name_set_count := name_set_count - 1;
          CYCLE /process_names/;
        IFEND;
        line.value (line.size + 1, value_size) := value_string^;
        line.size := line.size + value_size;
      ELSEIF comment_size > 0 THEN
        PUSH comment_string: [comment_size];
        get_string_from_array (comment_index, comment_index+1, array_ptr, comment_string, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        line.value (line.size + 2, comment_size) := comment_string^;
        line.size := line.size + comment_size + 1;
      IFEND;

      put_line (line.value (1, line.size), status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      name_set_count := name_set_count - 1;

    WHILEND /process_names/;

  PROCEND translate_create_variable;
?? TITLE := 'windup_translate_crev', EJECT ??

  PROCEDURE [INLINE] windup_translate_crev
    (    external_indent_column: amt$page_width;
     VAR status: ost$status);

    VAR
      current_string: string (100);

    clv$processing_crev := FALSE;
    current_string := '';
    current_string (external_indent_column, 6) := 'VAREND';
    put_line (current_string (1, external_indent_column + 5), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    WHILE clv$saved_blank_lines > 0 DO
      put_line ('', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clv$saved_blank_lines := clv$saved_blank_lines - 1;
    WHILEND;

  PROCEND windup_translate_crev;
MODEND clm$format_scl_proc;
